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