1# mail-test.pl - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sf.net> 2# 3# Send some mail from Perl. 4# 5# This sends two messages, one valid and one without a recipient using the 6# SMTP protocol. 7# 8# usage: ./mail-test.pl smtpd-host ?smtpd-port? 9# 10# ------------------------------------------------------------------------- 11 12use diagnostics; 13use strict; 14 15use Net::SMTP; 16use Sys::Hostname; 17 18my ($smtp_smart_host, $smtp_smart_port) = (shift, shift); 19 20$smtp_smart_host = 'localhost' if (!$smtp_smart_host); 21$smtp_smart_port = 25 if (!$smtp_smart_port); 22 23my $smtp_default_from = 'postmaster@' . hostname(); 24my $smtp_timeout = 120; 25my $smtp_log_mail = 0; 26my $smtp_debug = 1; 27 28my $sender_address = 'perl-test-script@' . hostname() . ''; 29my $recipient_address = 'tcl-smtpd@' . $smtp_smart_host . ''; 30my $from_address = 'Perl Test Script <perl-test-script@' . hostname() . '>'; 31my $ro_address = 'Tcl Server <tcl-smtpd@' . $smtp_smart_host . '>'; 32 33print "Sending valid message\n"; 34test_ok(); 35print "Sending invalid message\n"; 36test_no_rcpt(); 37 38sub test_no_rcpt { 39 my $header = 'From: ' . $sender_address . "\n"; 40 $header .= 'Subject: perl test' . "\n"; 41 my $message = <<EOF; 42This is a sample message in no particular format, sent by Perl's 43Net::SMTP package. 44Let's check the transparency code with a sentance ending on the next line 45. Like this! 46EOF 47 48 Sendmail($header . "\n" . $message . "\n"); 49} 50 51sub test_ok { 52 my $header = 'From: ' . $sender_address . "\n"; 53 $header .= 'To: ' . $recipient_address . "\n"; 54 $header .= 'Subject: perl test' . "\n"; 55 my $message = <<EOF; 56This is a sample message in no particular format, sent by Perl's 57Net::SMTP package. 58Let's check the transparency code with a sentance ending on the next line 59. Like this! 60EOF 61 62 Sendmail($header . "\n" . $message . "\n"); 63} 64 65# ------------------------------------------------------------------------- 66# Sendmail replacement (replaces exec'ing /usr/lib/sendmail...) 67# 68# Just call this function with the entire mail (headers and body together). 69# The recipient and sender addresses are extracted from the mail text. 70# ------------------------------------------------------------------------- 71 72sub Sendmail { 73 my ($msg) = (@_); 74 my @rcpts = (); 75 my $from = $smtp_default_from; 76 77 # Process the message headers to identify the recipient list. 78 my @msg = split(/^$/m, $msg); 79 my $header = $msg[0]; 80 $header =~ s/\n\s+/ /g; # fix continuation lines 81 82 my @lines = split(/^/m, $header); 83 chomp(@lines); 84 foreach my $line (@lines) { 85 my ($key, $value) = split(/:\s*/, $line, 2); 86 if ($key =~ /To|CC|BCC/i ) { 87 push(@rcpts, $value); 88 } 89 if ($key =~ /From/i) { 90 $from = $value; 91 } 92 } 93 94 my $smtp = Net::SMTP->new($smtp_smart_host, 95 Hello => hostname(), 96 Port => $smtp_smart_port, 97 Timeout => $smtp_timeout, 98 Debug => $smtp_debug) 99 || die "SMTP failed to connect: $!"; 100 101 $smtp->mail($from, (Size=>length($msg), Bits=>'8')); 102 $smtp->to(@rcpts); 103 if ($smtp->data()) { # start sending data; 104 $smtp->datasend($msg); # send the message 105 $smtp->dataend(); # finished sending data 106 } else { 107 $smtp->reset(); 108 } 109 $smtp->quit; # end of session 110 111 if ( $smtp_log_mail ) { 112 if ( open(MAILLOG, ">> data/maillog") ) { 113 print MAILLOG "From $from at ", localtime() . "\n"; 114 print MAILLOG "To: " . join(@rcpts, ',') . "\n"; 115 print MAILLOG $msg . "\n\n"; 116 close(MAILLOG); 117 } 118 } 119} 120 121# ------------------------------------------------------------------------- 122