anyparm args= 2>/dev/null
if hpacctcap=hpcidepth
then
  # This is for running it from the shell; it is skipped by CI
  eval 'exec /PERL/PUB/perl -x -wS $0 ${1+"$@"}'
  echo ERROR: Cannot execute Perl
  exit 1
fi
ENDIF

SETVAR _MARGS ANYPARM(!ARGS)
# escape any quotes
SETVAR _MARGS REPL(REPL(_MARGS, '"', '""'), "'", "''")
SETVAR _MAILSCRIPT FINFO(HPFILE, "POSIXFULLFNAME")
/bin/sh "-c '/PERL/PUB/perl -x -w !_MAILSCRIPT !_MARGS '"
DELETEVAR _MAILSCRIPT
DELETEVAR _MARGS
RETURN

#================================================================
# $Id:$
# Ken Hirsch <kenhirsch@myself.com>
# Jan 2002
#
mailto
  Perl program to E-mail a file from the HP3000

usage:
MAILTO [-p] [-u user:pass] [-f from] [-t to] [-s subject]
                     [-a afile] [-b bfile] textfile ...
   Also: [-m mfile] [-h header] [-e keyfile]
         [-sign signkeyfile] [-passin pass:password|file:filename]
  Flags:
     -a  afile
         The name of an ASCII file to send as an attachment.
         The parameter 'afile' has the form
           sendname=HFSNAME
         or
           HFSNAME
         Where 'sendname' is the name of the file as it will
         appear to the mail recipient, and 'HFSNAME' is the name
         of a file on the HP3000, preferably in HFS syntax,
           i.e.  /ACCOUNT/GROUP/FILE
         However, the script will try to convert the name if
         you use MPE syntax.
         If you do not include 'sendname=', the last component
         of HFSNAME will be used.
         You may use several -a options to attach multiple files.

     -b  bfile
         The name of an BINARY file to send as an attachment.
         The parameter 'bfile' has the same form as 'afile', above.
         You may use several -b options to attach multiple files.

     -e keyfile
         Encrypt mail using the recipient key in this file

     -f from
         Set the 'From' address of the e-mail
         You may also use SETVAR FROM "address"

     -h header
       Extra MIME/RFC822 headers
       You may use several -h options to include multiple headers

     -m  mfile
         The name of an already MIME-encoded file with MIME headers
         The file is inserted as an attachment without adding
         "Content-type", "Content-Disposition", or
         "Content-Transfer-Encoding" headers. (I.e. you should
         include those in your file).  A boundary separator is
         included, however.
         (This option for advanced users!)
         You may use several -m options to attach multiple files.

     -p  Use SMTP instead of Sendmail

     -s  subject
         You may also use SETVAR SUBJECT "subject"

     -t to
         You may also use SETVAR TO "address"
         You may use several -t options for multiple addressess
         or separate them by commas.
         (For encrypted mail, at most one TO address is allowed;
          see notes below.)

     -u user:pass
         User name and password for authenticated SMTP
         (Implies -p)
         You must have the Authen::SASL module installed
         to use (which may, in turn, require various other modules).

     textfile - the body of the message, textfile can be specified
                in either HFS syntax or MPE syntax

                You can use the "<" operator to read the text from
                any file, including a temporary file, in MPE syntax.

               If there is no body to the message, you can
               MAILTO ... <$NULL
               (or  </dev/null from the shell)


  Check the jcw CJCW for exit status: 0 means success

  example:
    SETVAR SUBJECT "This is a message from me"
    setvar FROM "Ken Hirsch <kenhirsch@myself.com>"
    ECHO Here is that spreadsheet you wanted >M1
    MAILTO -t "Mark <mark@bixby.org>" -b btu.xls=BTUXLS.PUB <M1

  (By the way, you can create Excel spreadsheets on MPE/iX
   using the Perl module Spreadsheet::WriteExcel)

Notes:
   This program may be called from either the CI or the shell
   without any changes.

--------------------------------------------------------------------
  See also the comments below marked with "CONFIG"
--------------------------------------------------------------------
  Encryption:
     -e keyfile
     The file containing the certificate used to encrypt the message.
     It must be in the form used by OpenSSL. The format used is
             "Base-64 encoded X.509 Certificates"
     An email program such as Outlook Express can extract the
     certificate from a signed message or it can be sent as an
     attachment.  Mail programs can usually export in that format.
     If you have it in "X.509 DER Format", you can convert it like
     this:
       openssl x509 -in infile.cer -inform DER -out newfile.pem
     Where "infile.cer" is the name of the file you have
     and "newfile.pem" is the name of the output file

    If you have it in "PKCS #7 format" (.p7b, .p7c, or .p7s extensions),
    you can convert it like this:
     openssl pkcs7 -in infile.p7b -inform DER -out newfile.pem -print_certs

    IMPORTANT: The file may include a "chain" of certificates.  You
    should edit the file to remove all the certificates except the
    end-user certificate.  I do not think that OpenSSL is smart
    enough to ignore the CA certificates in the file.

==>>**THE MESSAGE MUST BE ENCRYPTED SEPARATELY FOR EACH RECIPIENT**
    You may not specify more than one recipient for an encrypted
    message.  If you do not specify any recipients with "-t" or
    the "TO" environment variable, then my program will look in the
    key file for a line
      sendto = recipient
    e.g.
      sendto = "Ken Hirsch" <kenhirsch@myself.com>
    (The key files are ASCII; put the sendto line at the end.)
  ==>> I recommend specifying the recipient this way.

    To send encrypted mail to multiple recipients, run this program
    once for each recipient.


    For encryption, OpenSSL  is called as follows:

          openssl smime -encrypt -des3 $keyfile
    (Encryption type can be selected; see OPENSSLENC below)

  See the OpenSSL documentation (such as it is) for more details.
--------------------------------------------------------------------
  RANDFILE:
    In order to encrypt, OpenSSL needs a file (that is readable and
    writable by the user running OpenSSL) containing random bits.
    To initialize it, do something like this:

    BUILD MYRAND;REC=,,B;DISC=2048
    FILE MYRAND,OLD
    PRINT ,*MYRAND
    sd*(9f0924t8uywre-gb87bv 2387r 2829 u23` jdfaoisdfoijjoi32-987b1`98fd^)
    809*bb0[sd0-28t5-9r gj;lkearj
    a dozen more lines of random keyboard mashing...
    :EOD to end it

    Or in the shell
    cat >MYRAND
    random garbage
    :EOD


    Then, SETVAR RANDFILE "/ACCOUNT/GROUP/MYRAND"
    (or, in the shell export RANDFILE=/ACCOUNT/GROUP/MYRAND)

  See the OpenSSL documentation (such as it is) for more details.
--------------------------------------------------------------------

  - DNS address resolution must be working, so you may need to
    edit RESOLVCNF.NET.SYS

   If you use SMTP mail submission instead of Sendmail:
       - The service name 'smtp' is looked up in SERVICES.NET.SYS, so
       you may need to add this line if it is not already there:
    smtp          25/tcp                 #Simple Mail Transfer Protocol


# To get Perl for MPE:
#   http://jazz.external.hp.com/src/hp_freeware/perl/

#!perl -w
use IO::Handle 'autoflush';
use strict;

package Sendmail;

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $mailprog = shift;
  my $from = shift;
  my $self = "|$mailprog -t -f '$from' -- ". join(" ", @_);
  if (open SELF, $self) {
    binmode SELF;
    bless \*SELF, $class;
  } else {
    print STDERR "Cannot open $self: $!\n";
    return undef;
  }
}

sub datasend {
  my $self = shift;
  print $self @_
    or die "Error on print: $!\n";
  1;
}

sub data { 1; }
sub dataend { 1; }
sub recipient { 1; }
sub mail { 1; }
sub hello { 1; }
sub quit { close shift or die "Error closing pipe: $!\n"}

package Maildebug;
sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self = "Debug";
  return bless \$self, $class;
}

sub datasend {
  my $self = shift;
  print @_
    or die "Error on print: $!\n";
  1;
}

sub data { 1; }
sub dataend { 1; }
sub recipient { 1; }
sub mail { 1; }
sub hello { 1; }
sub quit { 1; }

package main;


our $running_in_mpe = ($^O =~ /mpe/i);
my ($atext, $dot_atom, $domain, $quoted_string, $local_part);
my ($addr_spec, $atom, $name_addr, $mailbox);
my $patinitdone=0;


# CONFIG: These two settings are relevant if you are sending
# directly to an SMTP server, and not using Sendmail
# The first is the DNS name of the SMTP server.
# The second is the host you are sending from (not critical).
my $server    = $ENV{'MAILSERVER'} || 'localhost';
my $mysystem = "localhost";

eval {
  use Net::Domain;
  $mysystem=Net::Domain::hostfqdn();
};

# CONFIG: The location of Sendmail
my $mailprog  = $ENV{'SENDMAIL'}   || '/usr/sbin/sendmail';
# http://jazz.external.hp.com/src/sendmail/
# http://sendmail.org

# CONFIG: The location of OpenSSL
my $openssl  = $ENV{'OPENSSL'}    || '/usr/local/ssl/bin/openssl';
my $enc      = $ENV{'OPENSSLENC'} || 'des3';
# Acceptable args are: des, des3, rc2-40, rc2-64, rc2-128

# The version of OpenSSL on jazz only supports DES and DES3
# http://jazz.external.hp.com/src/hp_freeware/openssl/
#
# If you want RC2, you need to download and compile it yourself:
# http://www.openssl.org/
# To compile and install, you need gcc and other GNU tools:
# http://jazz.external.hp.com/src/gnu/gnuframe.html
#

# CONFIG
my $from      = $ENV{'FROM'}       || 'You may put a default "from" here';
my $subject   = $ENV{'SUBJECT'}    || "No Subject";

my $now       = localtime();
my $boundary  = "";
my $mime = 0;
my $to;
my @headers;

my @tolist;
my @cclist;
my @bcclist;
my @afiles;
my @bfiles;
my @mfiles;
my @keyfiles;
my $altargs= "";
my $use_smtp = 0;
my $debug = 0;
my $sign = "";
my $passin = "";
my $userpass = ""; # for SMTP authentication

my $usage=
"usage: $0 [-f from] [-t to] [-s subject] [-a afile] [-b bfile] textfile\n"
;

use Getopt::Long;

GetOptions("p" => \$use_smtp,
           "debug" => \$debug,
           "bcc=s" => \@bcclist,
           "cc=s" => \@cclist,
	   "u=s"  => \$userpass,
           "t=s" => \@tolist,
           "f=s" => \$from,
           "h=s" => \@headers,
           "a=s" => \@afiles,
           "b=s" => \@bfiles,
           "m=s" => \@mfiles,
           "e=s" => \@keyfiles,
           "s=s" => \$subject,
           "sign=s" => \$sign,
           "passin=s" => \$passin);

if (defined($to = $ENV{'TO'})) {
  push @tolist, $to;
}
if ($sign) {
  $sign = convertname($sign);
  if (!-r $sign) {
    die "Cannot read signature key file $sign\n";
  }
}

if ($from =~ / default /) {
    die "You need to include a From address\n";
}

if (0 == scalar(@tolist) && 0 == scalar(@keyfiles)) {
  die "$0: No recipients specified\n";
}
if (scalar(@keyfiles)==1 && scalar(@tolist) > 1) {
  die "$0: can only encrypt file to one recipient\n";
}
if (scalar(@keyfiles)>1 && scalar(@tolist) > 0) {
  die "$0: If encrypting to more than one recipient,\n" .
      "   recipients must be specified in key files\n";
}

my $cryptout="";

# prepare MIME body
my $body = preparebody( forcemime=>($sign||scalar(@keyfiles)),
             inline => \@ARGV,
             afiles => \@afiles,
             bfiles => \@bfiles,
             mfiles => \@mfiles);

# sign if appropriate
if ($sign) {
  my $signedbody = anonfile();
  signbody($openssl, $enc, $sign, $passin, $body, $signedbody);
  close $body;
  $body = $signedbody;
  seek $body, 0, 0 or die "Seek failed: $!\n";
}

if (@keyfiles) {
  for my $thiskey  (@keyfiles) {
    my $recipient;
    my $cryptout = anonfile();
    $thiskey = convertname($thiskey);
    if (!-r $thiskey) {
      die "Cannot read recipient key file $thiskey\n";
    }
    cryptmail($openssl, $enc, $thiskey, $body, $cryptout);
    seek $body, 0, 0 or die "Seek failed: $!\n";
    seek $cryptout, 0, 0 or die "Seek failed: $!\n";
    if (scalar(@keyfiles) == 1 && scalar(@tolist) == 1) {
      $recipient = $tolist[0];
    } else {
      $recipient = recipientfromkeyfile($thiskey) or
        die "Cannot find a recipient for $thiskey\n";
    }
    sendmail(
       smtp => $use_smtp,
       debug => $debug,
       mailhost => $server,
       myname => $mysystem,
       mailprog => $mailprog,
       body => $cryptout,
       from => $from,
       subject => $subject,
       headers => \@headers,
       to => [ $recipient ]);
    close $cryptout;
  }
} else {
  sendmail(
     smtp => $use_smtp,
     debug => $debug,
     mailhost => $server,
     myname => $mysystem,
     mailprog => $mailprog,
     body => $body,
     from => $from,
     subject => $subject,
     headers => \@headers,
     to => \@tolist,
     cc => \@cclist,
     bcc => \@bcclist);
}

exit(0);



sub preparebody {
  my %opts = ( forcemime =>0,
               afiles=> [],
               bfiles=> [],
               mfiles=> [],
               inline=> [], @_);
  my $multipart = scalar(@{$opts{afiles}}) || scalar(@{$opts{bfiles}}) ||
     scalar(@{$opts{mfiles}});
  my $mime = $opts{forcemime} || $multipart;
  my $body = anonfile();

  if ($mime) {
      print $body "Mime-Version: 1.0\n";
      if ($multipart) {
      $boundary = sprintf("=_%04x%04x.%04x%04x:%04x%04x",
                 rand(65535), rand(65535),
                 rand(65535), rand(65535),
                 rand(65535), rand(65535));
        print $body "Content-Type: multipart/mixed;\n";
        print $body "\tboundary=\"$boundary\"\n\n";
        $boundary = "\n--$boundary";
      }
  } else {
   print "\n";
  }

  my $firstline = 1;

  my @inlinefiles = @{$opts{inline}};
  unshift(@inlinefiles, '-') unless @inlinefiles;
  while (my $nextarg = shift @inlinefiles) {
    if ($nextarg ne "-") {
      $nextarg = convertname($nextarg);
    }
    my $count = 0;
    open(ARGVF, $nextarg) or die "Cannot open $nextarg: $!\n";
    while (<ARGVF>) {
      if ($mime && $firstline) {
        $firstline = 0;
        print $body "$boundary\n" if $boundary;
        print $body "Content-Type: text/plain\n";
        print $body "Content-Disposition: Inline\n" if $boundary;
        print $body "\n";
      }
      $count++;
      chomp;
      print $body $_, "\n";
    }
    close ARGVF;
  }

  if ($mime) {
    my $file;
    my $fname;
    my $binary = 0;
    for (@{$opts{mfiles}}) {
      ($file, $fname) = getfilenames($_);
      open FILE, "<", $file or die "Cannot open $file: $!\n";
      print $body "$boundary\n";
      while (<FILE>) {
        chomp;
        print $body $_, "\n";
      }
    }
    for (@{$opts{afiles}}) {
      ($file, $fname) = getfilenames($_);
      open FILE, "<", $file or die "Cannot open $file: $!\n";
      print $body "$boundary\n";
      print $body "Content-Type: text/plain\n";
      print $body "Content-Transfer-Encoding: Quoted-printable\n";
      print $body "Content-Disposition: attachment;\n";
      print $body " filename=$fname\n\n";
      eval "use MIME::QuotedPrint qw(encode_qp); 1"
        or die "Cannot find module MIME::QuotedPrint\n";
      while (<FILE>) {
        $_ = encode_qp($_);
        print $body $_;
      }

    }
    for (@{$opts{bfiles}}) {
      ($file, $fname) = getfilenames($_);
      open FILE, "<", $file or die "Cannot open $file: $!\n";
      binmode FILE;
      print $body "$boundary\n";
      print $body "Content-Type: application/octet-stream\n";
      print $body "Content-Transfer-Encoding: base64\n";
      print $body "Content-Disposition: attachment;\n";
      print $body " filename=$fname\n\n";
      eval "use MIME::Base64 qw(encode_base64); 1"
        or die "Cannot find module MIME::Base64\n";
      my $rec="";
      while (read(FILE, $rec, 57)) {
        print $body &encode_base64($rec);
      }
    }
   print $body "$boundary--\n" if $boundary;
  }

  autoflush $body, 1;
  seek $body, 0, 0 or die "Seek failed: $!\n";
  return $body;
}


sub signbody {
  my ($openssl, $enc, $sign, $passin, $body, $signedbody) = @_;
  if ($passin) {
    $passin = "-passin $passin";
  }
  my $cmd = "$openssl smime -sign -$enc -signer $sign $passin";
  runcmd($cmd, $body, $signedbody);
}

sub cryptmail {
  my ($openssl, $enc, $thiskey, $body, $cryptout) = @_;
  my $cmd = "$openssl smime -encrypt -$enc $thiskey";
  runcmd($cmd, $body, $cryptout);
}
sub runcmd {
  my ($cmd, $in, $out) = @_;
  my $pid = fork();
  if ($pid == -1) {
    die "fork failed ($cmd): $!\n";
  } elsif ($pid == 0) {
    use POSIX;
    dup2(fileno($in), 0)  or die "dup2 (0) failed: $!\n";
    dup2(fileno($out), 1) or die "dup2 (,1) failed: $!\n";
    system($cmd)==0 or die "runcmd($cmd) failed: $!\n";
    exit(0);
  } else {
    my $wait = wait;
    if ($wait != $pid) {
      die "wait failed ($cmd): $!\n";
    }
    if ($? != 0) {
      die "cmd($cmd) failed: $?\n";
    }
  }

}

sub sendmail {
  my %opts = @_;
  my $use_smtp = 0;
  my $mailer;
  my $mailprog = $opts{mailprog};
  my $to = join(", ", @{$opts{to}}) if exists $opts{to};
  my $cc = join(", ", @{$opts{cc}}) if exists $opts{cc};
  my $subject = $opts{subject};
  my $smtp_from = smtpaddr($from);
  my $now = localtime;
  my $body = $opts{body};
  my @bcc = ();
  if (exists $opts{bcclist}) {
    @bcc = map { smtpaddr($_) } @{$opts{bcc}};
  }

  $use_smtp = 1 if $opts{smtp} || $userpass;
  if ($debug) {
    $mailer = Maildebug->new;
  } else {
    if (!$use_smtp) {
        if (-x $mailprog) {
          $mailer = Sendmail->new($mailprog, $smtp_from, @bcc);
        } else {
          print STDERR "Warning: cannot find $mailprog; trying SMTP\n";
          $use_smtp = 1;
        }
        if (not defined($mailer)) {
          $use_smtp = 1;
        }
    }
    if ($use_smtp) {
      eval "use Net::SMTP; 1" or die "Cannot find module Net::SMTP\n";
      $mailer = Net::SMTP->new($server) or
           die "Cannot connect to $server: $!\n";
      $mailer->hello("$mysystem")  or mystat($mailer, "Hello");
      if ($userpass) {
	$mailer->auth(split /:/, $userpass, 2)    or mystat($mailer, "auth");
      }
      $mailer->mail("$smtp_from")    or mystat($mailer, "mail");

      for (@{$opts{to}}, @{$opts{cc}}, @{$opts{bcc}}) {
        for (qcsplit($_)) {
          my $smtp_to = smtpaddr($_);
          $mailer->recipient("<$smtp_to>\n") or mystat($mailer, "recipient");
        }
      }
      $mailer->data()               or mystat($mailer, "data");
    }
  }
  $mailer->datasend("From: $from\n");
  $mailer->datasend("To: $to\n");
  $mailer->datasend("Cc: $cc\n") if $cc;
  $mailer->datasend("Date: $now\n");
  $mailer->datasend("Subject: $subject\n");
  for (@headers) {
    $mailer->datasend("$_\n");
  }

  while (<$body>) {
    $mailer->datasend("$_");
  }

  $mailer->dataend() or mystat("dataend", $mailer);
  print STDERR "Mail was sent to $to\n";
  $mailer->quit() or mystat("quit", $mailer);
}



sub mystat {
  my ($smtp, $c) = @_;
  print STDERR "Error on SMTP command $c: return code = ", $smtp->code(), "\n";
  print STDERR "  message = ", $smtp->message(), "\n";
  die "ERROR: Mail was not sent\n";
}


sub getfilenames {
  my $file = shift;
  my $fname;
  if ($file =~ /(.*)[:=](.*)/) {
    $file = $2;
    $fname = $1;
  } else {
    $fname = lc($file);
    $fname =~ s!.*/!!;
  }
  $file = convertname($file);
  return ($file, $fname);
}

sub convertname {
  my $file = shift;

  if ($running_in_mpe && ! -f $file) {
    my $temp = mpetohfs($file);
    if (-f $temp) {
      $file = $temp;
    }
  }
  return $file;
}

sub mpetohfs {
  my $fin = uc($_[0]);
  my ($fname, $group, $acct) = split /\./, $fin;
  my $result;
  if (not defined($group)) {
    $result = $fname;
  } elsif (not defined($acct)) {
    $result = "/$ENV{HPACCOUNT}/$group/$fname";
  } else {
    $result = "/$acct/$group/$fname";
  }
  return $result;
}

# splits on commas, except when the commas are quoted or
# backslash-escaped
# Only double quotes count
sub qcsplit {
  my $togo = shift;
  my @result;

  while ($togo) {
   my $pos = 0;
   my $len = length($togo);
   my $inquote = 0;
   my $backslash = 0;
   for ($pos = 0; $pos < $len; $pos++) {
     if ($backslash) {
       $backslash = 0;
     } else {
       my $c = substr($togo, $pos, 1);
       if ($c eq '\\') {
         $backslash = 1;
       } elsif ($inquote) {
         if ($c eq '"') {
           $inquote = 0;
          }
       } elsif ($c eq '"') {
         $inquote = 1;
       } elsif ($c eq ',') {
         push @result, substr($togo, 0, $pos);
         $togo = substr($togo, $pos + 1);
         last;
       }
     }
   }
   if ($pos >= $len) {
      push @result, $togo;
      last;
   }
  }
  return @result;
}


sub initpats {
  $atext         = qr/[-!#$%&'*+\/|=?^_`{}~\w]/;
  $dot_atom      = qr/\s*$atext+(?:\.$atext+)*\s*/;
  $domain        = qr/$dot_atom|\s*\[(?:\\.|[^\[\]\\])*\]\s*/;
  $quoted_string = qr/\s*"(?:[^"\\]*|\\.)*"\s*/;
  $local_part    = qr/$dot_atom|$quoted_string/;
  $addr_spec     = qr/$local_part\@$domain/;
  $atom          = qr/\s*[-!#$%&'*+\/|=?^_`{}~\w]+\s*/;
  $name_addr     = qr/\s*(?:$atom|$quoted_string)*\s*<($addr_spec)>\s*/;
  $mailbox       = qr/^$name_addr$|^($addr_spec)$/;
  $patinitdone = 1;
}

sub smtpaddr {
  my $addr = shift;
  initpats() unless $patinitdone;
  if ($addr =~ $mailbox) {
    $addr = $+;
  } else {
    # if you want, you could do this here:
    # die "Bad address: $addr\n";
    # However,
    #  (1) I can't guarantee that my regexes (above) are
    #      perfectly correct -- they certainly don't include old-style
    #      mail addresses
    #  (2) You may want to allow addresses that are just
    #      the local part e.g. "fred" instead of "fred@mycompany.com"
  }
  return $addr;
}

sub anonfile {
  my $tempname;
  local *TEMPFILE;
  do {
    my $rtag = int(rand(1000000));
    $tempname = "/tmp/mz$rtag";
  } while (-e $tempname);
  my $holdumask = umask 077;
  open TEMPFILE, "+>", $tempname or die "Cannot create temporary file: $!\n";
  binmode TEMPFILE;
  unlink $tempname or die "Cannot unlink $tempname: $!\n";
  umask $holdumask;
  return *TEMPFILE;
}

sub recipientfromkeyfile {
  my $keyfile = shift;
  my $retval = "";
  open KEY, "<", $keyfile or die "Cannot open key file $keyfile\n";
  while (!$retval && defined($_ = <KEY>)) {
    $retval = $1 if /^\s*sendto\s*=\s*(\S.*\S)/;
  }
  close KEY;
  die "Cannot find recipient in $keyfile\n" unless $retval;
  return $retval;
}

# vim: syntax=perl et