Here's a Perl script that can send mail, with attachments, from an HP3000.
You can use it with the HP3000 as your mail server if you have Sendmail
running. Or, you can use another computer as the SMTP server if the HP3000
is connected to it at the time the script is run.
I hope the internal comments are sufficient to explain it. If you have
questions, comments, bug reports, please send them to me.
Ken
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)
setvar _margs repl(repl(_margs, '"', '""'), "'", "''")
setvar _mailscript finfo(hpfile, "POSIXFULLFNAME")
/bin/sh "-c '/PERL/PUB/perl -x -w !_mailscript !_margs '"
deletevar _mailscript
return
#================================================================
# Ken Hirsch <[log in to unmask]>
# Oct 2001
#
mailto
Perl program to E-mail a file from the HP3000
usage:
MAILTO [-f from] [-t to] [-s subject] [-a afile] [-b bfile] textfile
Flags:
-f from Set the 'From' address of the e-mail
You may also use SETVAR FROM "address"
-t to
You may also use SETVAR TO "address"
You may use several -t options for multiple addressess
or separate them by commas.
-s subject
You may also use SETVAR SUBJECT "subject"
-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 don't 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.
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 <[log in to unmask]>"
ECHO Here's that spreadsheet you wanted >M1
MAILTO -t "Mark <[log in to unmask]>" -b btu.xls=BTUXLS.PUB <M1
Notes:
This program may be called from either the CI or the shell
without any changes.
The modules it uses should all come with Perl/iX except for
MPE::CIvar, which you can get from
http://invent3k.external.hp.com/~KEN.HIRSCH/
or, if I get my act together, from CPAN
DNS address resolution must be working, so you may need to
edit RESOLVCNF.NET.SYS
The service name 'smtp' is looked up in SERVICES.NET.SYS, so
you may need to add this line if it's not already there:
smtp 25/tcp #Simple Mail Transfer Protocol
See also the comments below marked with "CONFIG"
=cut
#!perl -w
use Net::SMTP;
use MPE::CIvar ':all';
use Net::hostent;
# CONFIG: You can replace 'localhost' with the name
# of your SMTP server, if it's different.
# Or
my $server = $CIVAR{'MAILSERVER'} || 'localhost';
# CONFIG: You should put your address here
my $from = $CIVAR{'FROM'} || 'Your address goes here';
my $subject = $CIVAR{'SUBJECT'} || "No Subject";
my $now = localtime();
my $boundary = "";
my $mime = 0;
my $to;
my $hostname = gethost($CIVAR{HPLOCIPADDR})->name || 'localhost';
my @tolist;
my @afiles;
my @bfiles;
my $usage=
"usage: $0 [-f from] [-t to] "
. "[-s subject] [-a afile] [-b bfile] textfile\n"
;
if (defined($to = $CIVAR{'TO'})) {
push @tolist, $to;
}
while (defined($opt = shift)) {
if ($opt =~ /^-([abfts])/) {
my $flag = $1;
my $arg = shift or die $usage;
if ($flag eq 's') {
$subject = $arg;
} elsif ($flag eq 'f') {
$from = $arg;
} elsif ($flag eq 't') {
push @tolist, $arg;
} elsif ($flag eq 'a') {
push @afiles, $arg;
} elsif ($flag eq 'b') {
push @bfiles, $arg;
}
} elsif ($opt =~ /^-/ && $opt !~ /^--?$/) {
die $usage;
} else {
unshift(@ARGV, $opt) if $opt ne "--";
last;
}
}
if (0 == scalar(@tolist)) {
die "$0: No recipients specified\n";
}
$to = join(', ', @tolist);
my $smtp = Net::SMTP->new($server) or
die "Cannot connect to $server: $!\n";
my $smtp_from = smtpaddr($from);
$smtp->hello("$hostname\n") or mystat($smtp, "Hello");
$smtp->mail("<$smtp_from>\n") or mystat($smtp, "mail");
for (@tolist) {
for (split /,/) {
my $smtp_to = smtpaddr($_);
# print STDERR "RCPT TO:<$smtp_to>\n";
$smtp->recipient("<$smtp_to>\n")
or mystat($smtp, "recipient");
}
}
$smtp->data() or mystat($smtp, "data");
$smtp->datasend("From: $from\n");
$smtp->datasend("To: $to\n");
$smtp->datasend("Date: $now\n");
$smtp->datasend("Subject: $subject\n");
if (scalar(@afiles) || scalar(@bfiles)) {
$mime = 1;
$boundary = sprintf("=_%04x%04x.%04x%04x:%04x%04x",
rand(65535), rand(65535),
rand(65535), rand(65535),
rand(65535), rand(65535));
$smtp->datasend("Mime-Version: 1.0\n");
$smtp->datasend("Content-Type: multipart/mixed;" .
"boundary=\"$boundary\"\n");
}
$smtp->datasend("\n");
$firstline = 1;
unshift(@ARGV, '-') unless @ARGV;
while ($ARGV = shift) {
if ($ARGV ne "-") {
$ARGV = convertname($ARGV);
}
open(ARGVF, $ARGV);
while (<ARGVF>) {
if ($mime && $firstline) {
$firstline = 0;
$smtp->datasend("\n--$boundary\n");
$smtp->datasend("Content-Type: text/plain\n");
$smtp->datasend("Content-Disposition: Inline\n\n");
}
$smtp->datasend($_);
}
}
if ($mime) {
my $file;
my $fname;
my $binary = 0;
for (@afiles) {
($file, $fname) = getfilenames($_);
open FILE, "<$file" or die "Cannot open $file: $!\n";
$smtp->datasend("\n--$boundary\n");
$smtp->datasend("Content-Type: text/plain\n");
$smtp->datasend("Content-Transfer-Encoding: "
."Quoted-printable\n");
$smtp->datasend("Content-Disposition: attachment;\n");
$smtp->datasend(" filename=$fname\n\n");
use MIME::QuotedPrint qw(encode_qp);
while (<FILE>) {
$_ = encode_qp($_);
$smtp->datasend($_);
}
}
for (@bfiles) {
($file, $fname) = getfilenames($_);
open FILE, "<$file" or die "Cannot open $file: $!\n";
binmode FILE;
$smtp->datasend("\n--$boundary\n");
$smtp->datasend("Content-Type: application/octet-stream\n");
$smtp->datasend("Content-Transfer-Encoding: base64\n");
$smtp->datasend("Content-Disposition: attachment;\n");
$smtp->datasend(" filename=$fname\n\n");
use MIME::Base64 qw(encode_base64);
hpcicommand("SETVAR MAILTORECLEN FINFO('$file', 30)");
my $reclen = $CIVAR{MAILTORECLEN};
my $buf = "";
while (read(FILE, $rec, $reclen)) {
$buf .= $rec;
while (length($buf) >= 57) {
$rec = substr($buf, 0, 57);
$smtp->datasend(encode_base64($rec));
$buf = substr($buf, 57);
}
}
if (length($buf)) {
$smtp->datasend(encode_base64($buf));
}
}
$smtp->datasend("\n--$boundary--\n");
}
$smtp->dataend() or mystat("dataend", $smtp);
print "Mail was sent to $to\n";
$smtp->quit() or mystat("quit", $smtp);
sub mystat {
my ($smtp, $c) = @_;
print "Error on SMTP command $c: return code = ",
$smtp->code(), "\n";
print " message = ", $smtp->message(), "\n";
die "ERROR: Mail was not sent\n";
}
sub smtpaddr {
my $addr = shift;
if ($addr =~ m/<(.*)>/) {
$addr = $1;
} elsif ($addr =~ m/[ "']/ &&
$addr =~ m/([.-a-z0-9_]+\@[.-a-z0-9]+)/) {
$addr = $1;
}
return $addr;
}
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;
my $filenew;
if (! -f $file) {
hpcicommand("SETVAR MAILPXFNAME ':BADFILENAME'");
hpcicommand("SETVAR MAILPXFNAME FINFO('$file', 38)");
$filenew = $CIVAR{MAILPXFNAME};
$file = $filenew if $filenew ne ':BADFILENAME';
}
return $file;
}
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
|
