# # POP2VMSMAIL fetches mail from a POP-server and distributes it via the OpenVMS # MAIL-system. # # For a somewhat longer description cf. # http://www.vaxman.de/openvms/pop2vmsmail/pop2vmsmail.html # # 19-NOV-2001, 21-APR-2004, # Thomas Kratz, Bernd Ulmann (ulmann@vaxman.de) # use strict; use Net::POP3; use IO::File; use POSIX qw(tmpnam); use VMS::Mail; ## INIT $| = 1; my($vms_user, $pop_srv, $pop_user, $pop_pwd) = @ARGV; ## SUBS sub SendVMSMail { my %arg = @_; my $send = new VMS::Mail(); return unless $send->send_begin( {}, []); return unless $send->add_address( { USERNAME => $arg{to}, }, [], ); return unless $send->add_attribute( { CC_LINE => $arg{cc}, FROM_LINE => $arg{from}, SUBJECT => $arg{subject}, TO_LINE => $arg{to}, }, [], ); return unless $send->add_bodypart( { FILENAME => $arg{file}, }, [], ); return unless $send->message({}, []); $send->end(); return(1); } ## MAIN my $pop = Net::POP3->new($pop_srv, Timeout => 20); unless ( $pop ) { print "couldn't open POP3-Server $pop_srv\n"; exit(-1); } unless ( $pop->login($pop_user, $pop_pwd) ) { print "login failed for user $pop_user\n"; exit(-2); } my($count, $size) = $pop->popstat(); print "count:$count size:$size\n"; for my $i ( 1 .. $count ) { my $msg = $pop->get($i); unless ( $msg ) { print "error getting message $i\n"; exit(-3); } my $from; foreach my $l (@$msg) { if ($l =~ /^Reply-To:\s+(.+)$/) { $from = $1; last; } } unless ( $from ) { foreach my $l (@$msg) { if ($l =~ /^From:\s+(.+)$/) { $from = $1; last; } } } if ( $from ) { my($addr) = $from =~ /<(.+)>/; $from = $addr if $addr; } else { $from = 'system@localhost'; } my $subject = "Undetermined"; foreach my $l (@$msg) { if ($l =~ /^Subject:\s+(.*)/i) { $subject = $1; last; } } my $cc = ''; foreach my $l (@$msg) { if ($l =~ /^Cc:\s+(.*)/i) { $subject = $1; last; } } print "FROM: $from\nTO: $vms_user\nSubject: $subject\n"; my ($tmpfile_name, $fh); do { $tmpfile_name = tmpnam (); } until $fh = IO::File -> new ($tmpfile_name, O_RDWR | O_CREAT | O_EXCL); print "Storing message into temporary file $tmpfile_name\n"; print $fh @$msg; close $fh; unless ( SendVMSMail( from => $from, to => $vms_user, subject => $subject, file => $tmpfile_name, cc => $cc, ) ) { print "error sending mail to $vms_user from $from, file $tmpfile_name"; } else { unlink ($tmpfile_name) or die "Could not unlink $tmpfile_name: $!\n"; } $pop->delete($i); } $pop->quit if $pop;