"Fossies" - the Fresh Open Source Software Archive 
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
1 package Mail::Sendmail;
2 # Mail::Sendmail by Milivoj Ivkovic <mi\x40alma.ch>
3 # see embedded POD documentation after __END__
4 # or http://alma.ch/perl/mail.html
5
6 =head1 NAME
7
8 Mail::Sendmail v. 0.79_16 - Simple platform independent mailer
9
10 =cut
11
12 $VERSION = substr q$Revision: 0.79_16 $, 10;
13
14 # *************** Configuration you may want to change *******************
15 # You probably want to set your SMTP server here (unless you specify it in
16 # every script), and leave the rest as is. See pod documentation for details
17
18 %mailcfg = (
19 # List of SMTP servers:
20 'smtp' => [ qw( localhost ) ],
21 #'smtp' => [ qw( mail.mydomain.com ) ], # example
22
23 'from' => '', # default sender e-mail, used when no From header in mail
24
25 'mime' => 1, # use MIME encoding by default
26
27 'retries' => 1, # number of retries on smtp connect failure
28 'delay' => 1, # delay in seconds between retries
29
30 'tz' => '', # only to override automatic detection
31 'port' => 25, # change it if you always use a non-standard port
32 'debug' => 0 # prints stuff to STDERR
33 );
34
35 # *******************************************************************
36
37 require Exporter;
38 use strict;
39 use vars qw(
40 $VERSION
41 @ISA
42 @EXPORT
43 @EXPORT_OK
44 %mailcfg
45 $address_rx
46 $debug
47 $log
48 $error
49 $retry_delay
50 $connect_retries
51 $auth_support
52 );
53
54 use Socket;
55 use Time::Local; # for automatic time zone detection
56 use Sys::Hostname; # for use of hostname in HELO
57
58 #use Digest::HMAC_MD5 qw(hmac_md5 hmac_md5_hex);
59
60 $auth_support = 'DIGEST-MD5 CRAM-MD5 PLAIN LOGIN';
61
62 # use MIME::QuotedPrint if available and configured in %mailcfg
63 eval("use MIME::QuotedPrint");
64 $mailcfg{'mime'} &&= (!$@);
65
66 @ISA = qw(Exporter);
67 @EXPORT = qw(&sendmail);
68 @EXPORT_OK = qw(
69 %mailcfg
70 time_to_date
71 $address_rx
72 $debug
73 $log
74 $error
75 );
76
77 # regex for e-mail addresses where full=$1, user=$2, domain=$3
78 # see pod documentation about this regex
79
80 my $word_rx = '[\x21\x23-\x27\x2A-\x2B\x2D\x2F\w\x3D\x3F]+';
81 my $user_rx = $word_rx # valid chars
82 .'(?:\.' . $word_rx . ')*' # possibly more words preceded by a dot
83 ;
84 my $dom_rx = '\w[-\w]*(?:\.\w[-\w]*)*'; # less valid chars in domain names
85 my $ip_rx = '\[\d{1,3}(?:\.\d{1,3}){3}\]';
86
87 $address_rx = '((' . $user_rx . ')\@(' . $dom_rx . '|' . $ip_rx . '))';
88 ; # v. 0.61
89
90 sub _require_md5 {
91 eval { require Digest::MD5; Digest::MD5->import(qw(md5 md5_hex)); };
92 $error .= $@ if $@;
93 return ($@ ? undef : 1);
94 }
95
96 sub _require_base64 {
97 eval {
98 require MIME::Base64; MIME::Base64->import(qw(encode_base64 decode_base64));
99 };
100 $error .= $@ if $@;
101 return ($@ ? undef : 1);
102 }
103
104 sub _hmac_md5 {
105 my ($pass, $ckey) = @_;
106 my $size = 64;
107 $pass = md5($pass) if length($pass) > $size;
108 my $ipad = $pass ^ (chr(0x36) x $size);
109 my $opad = $pass ^ (chr(0x5c) x $size);
110 return md5_hex($opad, md5($ipad, $ckey));
111 }
112
113 sub _digest_md5 {
114 my ($user, $pass, $challenge, $realm) = @_;
115
116 my %ckey = map { /^([^=]+)="?(.+?)"?$/ } split(/,/, $challenge);
117 $realm ||= $ckey{realm}; #($user =~ s/\@(.+)$//o) ? $1 : $server;
118 my $nonce = $ckey{nonce};
119 my $cnonce = &make_cnonce;
120 my $uri = join('/', 'smtp', hostname()||'localhost', $ckey{realm});
121 my $qop = 'auth';
122 my $nc = '00000001';
123 my($hv, $a1, $a2);
124 $hv = md5("$user:$realm:$pass");
125 $a1 = md5_hex("$hv:$nonce:$cnonce");
126 $a2 = md5_hex("AUTHENTICATE:$uri");
127 $hv = md5_hex("$a1:$nonce:$nc:$cnonce:$qop:$a2");
128 return qq(username="$user",realm="$ckey{realm}",nonce="$nonce",nc=$nc,cnonce="$cnonce",digest-uri="$uri",response=$hv,qop=$qop);
129 }
130
131 sub make_cnonce {
132 my $s = '' ;
133 for(1..16) { $s .= chr(rand 256) }
134 $s = encode_base64($s, "");
135 $s =~ s/\W/X/go;
136 return substr($s, 0, 16);
137 }
138
139 sub time_to_date {
140 # convert a time() value to a date-time string according to RFC 822
141
142 my $time = $_[0] || time(); # default to now if no argument
143
144 my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
145 my @wdays = qw(Sun Mon Tue Wed Thu Fri Sat);
146
147 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
148 = localtime($time);
149
150 my $TZ = $mailcfg{'tz'};
151 if ( $TZ eq "" ) {
152 # offset in hours
153 my $offset = sprintf "%.1f", (timegm(localtime) - time) / 3600;
154 my $minutes = sprintf "%02d", abs( $offset - int($offset) ) * 60;
155 $TZ = sprintf("%+03d", int($offset)) . $minutes;
156 }
157 return join(" ",
158 ($wdays[$wday] . ','),
159 $mday,
160 $months[$mon],
161 $year+1900,
162 sprintf("%02d:%02d:%02d", $hour, $min, $sec),
163 $TZ
164 );
165 } # end sub time_to_date
166
167 sub sendmail {
168
169 $error = '';
170 $log = "Mail::Sendmail v. $VERSION - " . scalar(localtime()) . "\n";
171
172 my $CRLF = "\015\012";
173 local $/ = $CRLF;
174 local $\ = ''; # to protect us from outside settings
175 local $_;
176
177 my (%mail, $k,
178 $smtp, $server, $port, $connected, $localhost,
179 $fromaddr, $recip, @recipients, $to, $header,
180 %esmtp, @wanted_methods,
181 );
182 use vars qw($server_reply);
183 # -------- a few internal subs ----------
184 sub fail {
185 # things to do before returning a sendmail failure
186 $error .= join(" ", @_) . "\n";
187 if ($server_reply) {
188 $error .= "Server said: $server_reply\n";
189 print STDERR "Server said: $server_reply\n" if $^W;
190 }
191 close S;
192 return 0;
193 }
194
195 sub socket_write {
196 my $i;
197 for $i (0..$#_) {
198 # accept references, so we don't copy potentially big data
199 my $data = ref($_[$i]) ? $_[$i] : \$_[$i];
200 if ($mailcfg{'debug'} > 5) {
201 if (length($$data) < 500) {
202 print ">", $$data;
203 }
204 else {
205 print "> [...", length($$data), " bytes sent ...]\n";
206 }
207 }
208 print(S $$data) || return 0;
209 }
210 1;
211 }
212
213 sub socket_read {
214 $server_reply = "";
215 do {
216 $_ = <S>;
217 $server_reply .= $_;
218 #chomp $_;
219 print "<$_" if $mailcfg{'debug'} > 5;
220 if (/^[45]/ or !$_) {
221 chomp $server_reply;
222 return; # return false
223 }
224 } while (/^[\d]+-/);
225 chomp $server_reply;
226 return $server_reply;
227 }
228 # -------- end of internal subs ----------
229
230 # all config keys to lowercase, to prevent typo errors
231 foreach $k (keys %mailcfg) {
232 if ($k =~ /[A-Z]/) {
233 $mailcfg{lc($k)} = $mailcfg{$k};
234 }
235 }
236
237 # redo mail hash, arranging keys case etc...
238 while (@_) {
239 $k = shift @_;
240 if (!$k and $^W) {
241 warn "Received false mail hash key: \'$k\'. Did you forget to put it in quotes?\n";
242 }
243
244 # arrange keys case
245 $k = ucfirst lc($k);
246
247 $k =~ s/\s*:\s*$//o; # kill colon (and possible spaces) at end, we add it later.
248 # uppercase also after "-", so people don't complain that headers case is different
249 # than in Outlook.
250 $k =~ s/-(.)/"-" . uc($1)/ge;
251 $mail{$k} = shift @_;
252 if ($k !~ /^(Message|Body|Text)$/i) {
253 # normalize possible line endings in headers
254 $mail{$k} =~ s/\015\012?/\012/go;
255 $mail{$k} =~ s/\012/$CRLF/go;
256 }
257 }
258
259 $smtp = $mail{'Smtp'} || $mail{'Server'};
260 unshift @{$mailcfg{'smtp'}}, $smtp if ($smtp and $mailcfg{'smtp'}->[0] ne $smtp);
261
262 # delete non-header keys, so we don't send them later as mail headers
263 # I like this syntax, but it doesn't seem to work with AS port 5.003_07:
264 # delete @mail{'Smtp', 'Server'};
265 # so instead:
266 delete $mail{'Smtp'}; delete $mail{'Server'};
267
268 $mailcfg{'port'} = $mail{'Port'} || $mailcfg{'port'} || 25;
269 delete $mail{'Port'};
270
271 my $auth = $mail{'Auth'};
272 delete $mail{'Auth'};
273
274
275 { # don't warn for undefined values below
276 local $^W = 0;
277 $mail{'Message'} = join("", $mail{'Message'}, $mail{'Body'}, $mail{'Text'});
278 }
279
280 # delete @mail{'Body', 'Text'};
281 delete $mail{'Body'}; delete $mail{'Text'};
282
283 # Extract 'From:' e-mail address to use as envelope sender
284
285 $fromaddr = $mail{'Sender'} || $mail{'From'} || $mailcfg{'from'};
286 #delete $mail{'Sender'};
287 unless ($fromaddr =~ /$address_rx/) {
288 return fail("Bad or missing From address: \'$fromaddr\'");
289 }
290 $fromaddr = $1;
291
292 # add Date header if needed
293 $mail{Date} ||= time_to_date() ;
294 $log .= "Date: $mail{Date}\n";
295
296 # cleanup message, and encode if needed
297 $mail{'Message'} =~ s/\r\n/\n/go; # normalize line endings, step 1 of 2 (next step after MIME encoding)
298
299 $mail{'Mime-Version'} ||= '1.0';
300 $mail{'Content-Type'} ||= 'text/plain; charset="iso-8859-1"';
301
302 unless ( $mail{'Content-Transfer-Encoding'}
303 || $mail{'Content-Type'} =~ /multipart/io )
304 {
305 if ($mailcfg{'mime'}) {
306 $mail{'Content-Transfer-Encoding'} = 'quoted-printable';
307 $mail{'Message'} = encode_qp($mail{'Message'});
308 }
309 else {
310 $mail{'Content-Transfer-Encoding'} = '8bit';
311 if ($mail{'Message'} =~ /[\x80-\xFF]/o) {
312 $error .= "MIME::QuotedPrint not present!\nSending 8bit characters, hoping it will come across OK.\n";
313 warn "MIME::QuotedPrint not present!\n",
314 "Sending 8bit characters without encoding, hoping it will come across OK.\n"
315 if $^W;
316 }
317 }
318 }
319
320 $mail{'Message'} =~ s/^\./\.\./gom; # handle . as first character
321 $mail{'Message'} =~ s/\n/$CRLF/go; # normalize line endings, step 2.
322
323 # Get recipients
324 { # don't warn for undefined values below
325 local $^W = 0;
326 $recip = join(", ", $mail{To}, $mail{Cc}, $mail{Bcc});
327 }
328
329 delete $mail{'Bcc'};
330
331 @recipients = ();
332 while ($recip =~ /$address_rx/go) {
333 push @recipients, $1;
334 }
335 unless (@recipients) {
336 return fail("No recipient!")
337 }
338
339 # get local hostname for polite HELO
340 $localhost = hostname() || 'localhost';
341
342 foreach $server ( @{$mailcfg{'smtp'}} ) {
343 # open socket needs to be inside this foreach loop on Linux,
344 # otherwise all servers fail if 1st one fails !??! why?
345 unless ( socket S, AF_INET, SOCK_STREAM, scalar(getprotobyname 'tcp') ) {
346 return fail("socket failed ($!)")
347 }
348
349 print "- trying $server\n" if $mailcfg{'debug'} > 1;
350
351 $server =~ s/\s+//go; # remove spaces just in case of a typo
352 # extract port if server name like "mail.domain.com:2525"
353 $port = ($server =~ s/:(\d+)$//o) ? $1 : $mailcfg{'port'};
354 $smtp = $server; # save $server for use outside foreach loop
355
356 my $smtpaddr = inet_aton $server;
357 unless ($smtpaddr) {
358 $error .= "$server not found\n";
359 next; # next server
360 }
361
362 my $retried = 0; # reset retries for each server
363 while ( ( not $connected = connect S, pack_sockaddr_in($port, $smtpaddr) )
364 and ( $retried < $mailcfg{'retries'} )
365 ) {
366 $retried++;
367 $error .= "connect to $server failed ($!)\n";
368 print "- connect to $server failed ($!)\n" if $mailcfg{'debug'} > 1;
369 print "retrying in $mailcfg{'delay'} seconds...\n" if $mailcfg{'debug'} > 1;
370 sleep $mailcfg{'delay'};
371 }
372
373 if ( $connected ) {
374 print "- connected to $server\n" if $mailcfg{'debug'} > 3;
375 last;
376 }
377 else {
378 $error .= "connect to $server failed\n";
379 print "- connect to $server failed, next server...\n" if $mailcfg{'debug'} > 1;
380 next; # next server
381 }
382 }
383
384 unless ( $connected ) {
385 return fail("connect to $smtp failed ($!) no (more) retries!")
386 };
387
388 {
389 local $^W = 0; # don't warn on undefined variables
390 # Add info to log variable
391 $log .= "Server: $smtp Port: $port\n"
392 . "From: $fromaddr\n"
393 . "Subject: $mail{Subject}\n"
394 ;
395 }
396
397 my($oldfh) = select(S); $| = 1; select($oldfh);
398
399 socket_read()
400 || return fail("Connection error from $smtp on port $port ($_)");
401 socket_write("EHLO $localhost$CRLF")
402 || return fail("send EHLO error (lost connection?)");
403 my $ehlo = socket_read();
404 if ($ehlo) {
405 # parse EHLO response
406 map {
407 s/^\d+[- ]//;
408 my ($k, $v) = split /\s+/, $_, 2;
409 $esmtp{$k} = $v || 1 if $k;
410 } split(/\n/, $ehlo);
411 }
412 else {
413 # try plain HELO instead
414 socket_write("HELO $localhost$CRLF")
415 || return fail("send HELO error (lost connection?)");
416 }
417
418 if ($auth) {
419 warn "AUTH requested\n" if ($mailcfg{debug} > 4);
420 # reduce wanted methods to those supported
421 my @methods = grep {$esmtp{'AUTH'}=~/(^|\s)$_(\s|$)/i}
422 grep {$auth_support =~ /(^|\s)$_(\s|$)/i}
423 grep /\S/, split(/\s+/, $auth->{method});
424
425 if (@methods) {
426 # try to authenticate
427
428 if (exists $auth->{pass}) {
429 $auth->{password} = $auth->{pass};
430 }
431
432 my $method = uc $methods[0];
433 _require_base64() || fail("Could not use MIME::Base64 module required for authentication");
434 if ($method eq "LOGIN") {
435 print STDERR "Trying AUTH LOGIN\n" if ($mailcfg{debug} > 9);
436 socket_write("AUTH LOGIN$CRLF")
437 || return fail("send AUTH LOGIN failed (lost connection?)");
438 socket_read()
439 || return fail("AUTH LOGIN failed: $server_reply");
440 socket_write(encode_base64($auth->{user},$CRLF))
441 || return fail("send LOGIN username failed (lost connection?)");
442 socket_read()
443 || return fail("LOGIN username failed: $server_reply");
444 socket_write(encode_base64($auth->{password},$CRLF))
445 || return fail("send LOGIN password failed (lost connection?)");
446 socket_read()
447 || return fail("LOGIN password failed: $server_reply");
448 }
449 elsif ($method eq "PLAIN") {
450 warn "Trying AUTH PLAIN\n" if ($mailcfg{debug} > 9);
451 socket_write(
452 "AUTH PLAIN "
453 . encode_base64(join("\0", $auth->{user}, $auth->{user}, $auth->{password}), $CRLF)
454 ) || return fail("send AUTH PLAIN failed (lost connection?)");
455 socket_read()
456 || return fail("AUTH PLAIN failed: $server_reply");
457 }
458 elsif ($method eq "CRAM-MD5") {
459 _require_md5() || fail("Could not use Digest::MD5 module required for authentication");
460 warn "Trying AUTH CRAM-MD5\n" if ($mailcfg{debug} > 9);
461 socket_write("AUTH CRAM-MD5$CRLF")
462 || return fail("send CRAM-MD5 failed (lost connection?)");
463 my $challenge = socket_read()
464 || return fail("AUTH CRAM-MD5 failed: $server_reply");
465 $challenge =~ s/^\d+\s+//;
466 my $response = _hmac_md5($auth->{password}, decode_base64($challenge));
467 socket_write(encode_base64("$auth->{user} $response", $CRLF))
468 || return fail("AUTH CRAM-MD5 failed: $server_reply");
469 socket_read()
470 || return fail("AUTH CRAM-MD5 failed: $server_reply");
471 }
472 elsif ($method eq "DIGEST-MD5") {
473 _require_md5() || fail("Could not use Digest::MD5 module required for authentication");
474 warn "Trying AUTH DIGEST-MD5\n" if ($mailcfg{debug} > 9);
475 socket_write("AUTH DIGEST-MD5$CRLF")
476 || return fail("send CRAM-MD5 failed (lost connection?)");
477 my $challenge = socket_read()
478 || return fail("AUTH DIGEST-MD5 failed: $server_reply");
479 $challenge =~ s/^\d+\s+//; $challenge =~ s/[\r\n]+$//;
480 warn "\nCHALLENGE=", decode_base64($challenge), "\n" if ($mailcfg{debug} > 10);
481 my $response = _digest_md5($auth->{user}, $auth->{password}, decode_base64($challenge), $auth->{realm});
482 warn "\nRESPONSE=$response\n" if ($mailcfg{debug} > 10);
483 socket_write(encode_base64($response, ""), $CRLF)
484 || return fail("AUTH DIGEST-MD5 failed: $server_reply");
485 my $status = socket_read()
486 || return fail("AUTH DIGEST-MD5 failed: $server_reply");
487 if ($status =~ /^3/) {
488 socket_write($CRLF)
489 || return fail("AUTH DIGEST-MD5 failed: $server_reply");
490 socket_read()
491 || return fail("AUTH DIGEST-MD5 failed: $server_reply");
492 }
493 }
494 else {
495 return fail("$method not supported (and wrongly advertised as supported by this silly module)\n");
496 }
497 $log .= "AUTH $method succeeded as user $auth->{user}\n";
498 }
499 else {
500 $esmtp{'AUTH'} =~ s/(^\s+|\s+$)//g; # cleanup for printig it below
501 if ($auth->{required}) {
502 return fail("Required AUTH method '$auth->{method}' not supported. "
503 ."(Server supports '$esmtp{'AUTH'}'. Module supports: '$auth_support')");
504 }
505 else {
506 warn "No common authentication method! Requested: '$auth->{method}'. Server supports '$esmtp{'AUTH'}'. Module supports: '$auth_support'. Skipping authentication\n";
507 }
508 }
509 }
510 socket_write("MAIL FROM:<$fromaddr>$CRLF")
511 || return fail("send MAIL FROM: error");
512 socket_read()
513 || return fail("MAIL FROM: error ($_)");
514
515 my $to_ok = 0;
516 foreach $to (@recipients) {
517 socket_write("RCPT TO:<$to>$CRLF")
518 || return fail("send RCPT TO: error");
519 if (socket_read()) {
520 $log .= "To: $to\n";
521 $to_ok++;
522 } else {
523 $log .= "FAILED To: $to ($server_reply)";
524 $error .= "Bad recipient <$to>: $server_reply\n";
525 }
526 }
527 unless ($to_ok) {
528 return fail("No valid recipient");
529 }
530
531 # start data part
532
533 socket_write("DATA$CRLF")
534 || return fail("send DATA error");
535 socket_read()
536 || return fail("DATA error ($_)");
537
538 # print headers
539 foreach $header (keys %mail) {
540 next if $header eq "Message";
541 $mail{$header} =~ s/\s+$//o; # kill possible trailing garbage
542 socket_write("$header: $mail{$header}$CRLF")
543 || return fail("send $header: error");
544 };
545
546 #- test diconnecting from network here, to see what happens
547 #- print STDERR "DISCONNECT NOW!\n";
548 #- sleep 4;
549 #- print STDERR "trying to continue, expecting an error... \n";
550
551 # send message body (passed as a reference, in case it's big)
552 socket_write($CRLF, \$mail{'Message'}, "$CRLF.$CRLF")
553 || return fail("send message error");
554 socket_read()
555 || return fail("message transmission error ($_)");
556 $log .= "\nResult: $_";
557
558 # finish
559 socket_write("QUIT$CRLF")
560 || return fail("send QUIT error");
561 socket_read();
562 close S;
563
564 return 1;
565 } # end sub sendmail
566
567 1;
568 __END__
569
570 =head1 SYNOPSIS
571
572 use Mail::Sendmail;
573
574 %mail = ( To => 'you@there.com',
575 From => 'me@here.com',
576 Message => "This is a very short message"
577 );
578
579 sendmail(%mail) or die $Mail::Sendmail::error;
580
581 print "OK. Log says:\n", $Mail::Sendmail::log;
582
583 =head1 DESCRIPTION
584
585 Simple platform independent e-mail from your perl script. Only requires
586 Perl 5 and a network connection.
587
588 Mail::Sendmail takes a hash with the message to send and sends it to your
589 mail server. It is intended to be very easy to setup and
590 use. See also L<"FEATURES"> below, and as usual, read this documentation.
591
592 There is also a FAQ (see L<"NOTES">).
593
594 =head1 INSTALLATION
595
596 =over 4
597
598 =item Best
599
600 C<perl -MCPAN -e "install Mail::Sendmail">
601
602 =item Traditional
603
604 perl Makefile.PL
605 make
606 make test
607 make install
608
609 =item Manual
610
611 Copy Sendmail.pm to Mail/ in your Perl lib directory.
612
613 (eg. c:\Perl\site\lib\Mail\
614 or /usr/lib/perl5/site_perl/Mail/
615 or whatever it is on your system.
616 They are listed when you type C< perl -V >)
617
618 =item ActivePerl's PPM
619
620 Depending on your PPM version:
621
622 ppm install --location=http://alma.ch/perl/ppm Mail-Sendmail
623
624 or
625
626 ppm install http://alma.ch/perl/ppm/Mail-Sendmail.ppd
627
628 But this way you don't get a chance to have a look at other files (Changes,
629 Todo, test.pl, ...).
630
631 =back
632
633 At the top of Sendmail.pm, set your default SMTP server(s), unless you specify
634 it with each message, or want to use the default (localhost).
635
636 Install MIME::QuotedPrint. This is not required but strongly recommended.
637
638 =head1 FEATURES
639
640 Automatic time zone detection, Date: header, MIME quoted-printable encoding
641 (if MIME::QuotedPrint installed), all of which can be overridden.
642
643 Bcc: and Cc: support.
644
645 Allows real names in From:, To: and Cc: fields
646
647 Doesn't send an X-Mailer: header (unless you do), and allows you to send any
648 header(s) you want.
649
650 Configurable retries and use of alternate servers if your mail server is
651 down
652
653 Good plain text error reporting
654
655 Experimental support for SMTP AUTHentication
656
657 =head1 LIMITATIONS
658
659 Headers are not encoded, even if they have accented characters.
660
661 Since the whole message is in memory, it's not suitable for
662 sending very big attached files.
663
664 The SMTP server has to be set manually in Sendmail.pm or in your script,
665 unless you have a mail server on localhost.
666
667 Doesn't work on OpenVMS, I was told. Cannot test this myself.
668
669 =head1 CONFIGURATION
670
671 =over 4
672
673 =item Default SMTP server(s)
674
675 This is probably all you want to configure. It is usually done through
676 I<$mailcfg{smtp}>, which you can edit at the top of the Sendmail.pm file.
677 This is a reference to a list of SMTP servers. You can also set it from
678 your script:
679
680 C<unshift @{$Mail::Sendmail::mailcfg{'smtp'}} , 'my.mail.server';>
681
682 Alternatively, you can specify the server in the I<%mail> hash you send
683 from your script, which will do the same thing:
684
685 C<$mail{smtp} = 'my.mail.server';>
686
687 A future version will (hopefully) try to set useful defaults for you
688 during the Makefile.PL.
689
690 =item Other configuration settings
691
692 See I<%mailcfg> under L<"DETAILS"> below for other configuration options.
693
694 =back
695
696 =head1 DETAILS
697
698 =head2 sendmail()
699
700 sendmail is the only thing exported to your namespace by default
701
702 C<sendmail(%mail) || print "Error sending mail: $Mail::Sendmail::error\n";>
703
704 It takes a hash containing the full message, with keys for all headers
705 and the body, as well as for some specific options.
706
707 It returns 1 on success or 0 on error, and rewrites
708 C<$Mail::Sendmail::error> and C<$Mail::Sendmail::log>.
709
710 Keys are NOT case-sensitive.
711
712 The colon after headers is not necessary.
713
714 The Body part key can be called 'Body', 'Message' or 'Text'.
715
716 The SMTP server key can be called 'Smtp' or 'Server'. If the connection to
717 this one fails, the other ones in C<$mailcfg{smtp}> will still be tried.
718
719 The following headers are added unless you specify them yourself:
720
721 Mime-Version: 1.0
722 Content-Type: 'text/plain; charset="iso-8859-1"'
723
724 Content-Transfer-Encoding: quoted-printable
725 or (if MIME::QuotedPrint not installed)
726 Content-Transfer-Encoding: 8bit
727
728 Date: [string returned by time_to_date()]
729
730 If you wish to use an envelope sender address different than the
731 From: address, set C<$mail{Sender}> in your %mail hash.
732
733
734
735 The following are not exported by default, but you can still access them
736 with their full name, or request their export on the use line like in:
737 C<use Mail::Sendmail qw(sendmail $address_rx time_to_date);>
738
739 =head3 embedding options in your %mail hash
740
741 The following options can be set in your %mail hash. The corresponding keys
742 will be removed before sending the mail.
743
744 =over 4
745
746 =item $mail{smtp} or $mail{server}
747
748 The SMTP server to try first. It will be added
749
750 =item $mail{port}
751
752 This option will be removed. To use a non-standard port, set it in your server name:
753
754 $mail{server}='my.smtp.server:2525' will try to connect to port 2525 on server my.smtp.server
755
756 =item $mail{auth}
757
758 This must be a reference to a hash containg all your authentication options:
759
760 $mail{auth} = \%options;
761 or
762 $mail{auth} = {user=>"username", password=>"password", method=>"DIGEST-MD5", required=>0 };
763
764 =over
765
766 =item user
767
768 username
769
770 =item pass or password
771
772 password
773
774 =item method
775
776 optional method. compared (stripped down) to available methods. If empty, will try all available.
777
778 =item required
779
780 optional. defaults to false. If set to true, no delivery will be attempted if
781 authentication fails. If false or undefined, and authentication fails or is not available, sending is tried without.
782
783 (different auth for different servers?)
784
785 =back
786
787 =back
788
789 =head2 Mail::Sendmail::time_to_date()
790
791 convert time ( as from C<time()> ) to an RFC 822 compliant string for the
792 Date header. See also L<"%Mail::Sendmail::mailcfg">.
793
794 =head2 $Mail::Sendmail::error
795
796 When you don't run with the B<-w> flag, the module sends no errors to
797 STDERR, but puts anything it has to complain about in here. You should
798 probably always check if it says something.
799
800 =head2 $Mail::Sendmail::log
801
802 A summary that you could write to a log file after each send
803
804 =head2 $Mail::Sendmail::address_rx
805
806 A handy regex to recognize e-mail addresses.
807
808 A correct regex for valid e-mail addresses was written by one of the judges
809 in the obfuscated Perl contest... :-) It is quite big. This one is an
810 attempt to a reasonable compromise, and should accept all real-world
811 internet style addresses. The domain part is required and comments or
812 characters that would need to be quoted are not supported.
813
814 Example:
815 $rx = $Mail::Sendmail::address_rx;
816 if (/$rx/) {
817 $address=$1;
818 $user=$2;
819 $domain=$3;
820 }
821
822 =head2 %Mail::Sendmail::mailcfg
823
824 This hash contains installation-wide configuration options. You normally edit it once (if
825 ever) in Sendmail.pm and forget about it, but you could also access it from
826 your scripts. For readability, I'll assume you have imported it
827 (with something like C<use Mail::Sendmail qw(sendmail %mailcfg)>).
828
829 The keys are not case-sensitive: they are all converted to lowercase before
830 use. Writing C<$mailcfg{Port} = 2525;> is OK: the default $mailcfg{port}
831 (25) will be deleted and replaced with your new value of 2525.
832
833 =over 4
834
835 =item $mailcfg{smtp}
836
837 C<$mailcfg{smtp} = [qw(localhost my.other.mail.server)];>
838
839 This is a reference to a list of smtp servers, so if your main server is
840 down, the module tries the next one. If one of your servers uses a special
841 port, add it to the server name with a colon in front, to override the
842 default port (like in my.special.server:2525).
843
844 Default: localhost.
845
846 =item $mailcfg{from}
847
848 C<$mailcfg{from} = 'Mailing script me@mydomain.com';>
849
850 From address used if you don't supply one in your script. Should not be of
851 type 'user@localhost' since that may not be valid on the recipient's
852 host.
853
854 Default: undefined.
855
856 =item $mailcfg{mime}
857
858 C<$mailcfg{mime} = 1;>
859
860 Set this to 0 if you don't want any automatic MIME encoding. You normally
861 don't need this, the module should 'Do the right thing' anyway.
862
863 Default: 1;
864
865 =item $mailcfg{retries}
866
867 C<$mailcfg{retries} = 1;>
868
869 How many times should the connection to the same SMTP server be retried in
870 case of a failure.
871
872 Default: 1;
873
874 =item $mailcfg{delay}
875
876 C<$mailcfg{delay} = 1;>
877
878 Number of seconds to wait between retries. This delay also happens before
879 trying the next server in the list, if the retries for the current server
880 have been exhausted. For CGI scripts, you want few retries and short delays
881 to return with a results page before the http connection times out. For
882 unattended scripts, you may want to use many retries and long delays to
883 have a good chance of your mail being sent even with temporary failures on
884 your network.
885
886 Default: 1 (second);
887
888 =item $mailcfg{tz}
889
890 C<$mailcfg{tz} = '+0800';>
891
892 Normally, your time zone is set automatically, from the difference between
893 C<time()> and C<gmtime()>. This allows you to override automatic detection
894 in cases where your system is confused (such as some Win32 systems in zones
895 which do not use daylight savings time: see Microsoft KB article Q148681)
896
897 Default: undefined (automatic detection at run-time).
898
899 =item $mailcfg{port}
900
901 C<$mailcfg{port} = 25;>
902
903 Port used when none is specified in the server name.
904
905 Default: 25.
906
907 =item $mailcfg{debug}
908
909 C<$mailcfg{debug} = 0;>
910
911 Prints stuff to STDERR. Current maximum is 6, which prints the whole SMTP
912 session, except data exceeding 500 bytes.
913
914 Default: 0;
915
916 =back
917
918 =head2 $Mail::Sendmail::VERSION
919
920 The package version number (you can not import this one)
921
922 =head2 Configuration variables from previous versions
923
924 The following global variables were used in version 0.74 for configuration.
925 As from version 0.78_1, they are not supported anymore.
926 Use the I<%mailcfg> hash if you need to access the configuration
927 from your scripts.
928
929 =over 4
930
931 =item $Mail::Sendmail::default_smtp_server
932
933 =item $Mail::Sendmail::default_smtp_port
934
935 =item $Mail::Sendmail::default_sender
936
937 =item $Mail::Sendmail::TZ
938
939 =item $Mail::Sendmail::connect_retries
940
941 =item $Mail::Sendmail::retry_delay
942
943 =item $Mail::Sendmail::use_MIME
944
945 =back
946
947 =head1 ANOTHER EXAMPLE
948
949 use Mail::Sendmail;
950
951 print "Testing Mail::Sendmail version $Mail::Sendmail::VERSION\n";
952 print "Default server: $Mail::Sendmail::mailcfg{smtp}->[0]\n";
953 print "Default sender: $Mail::Sendmail::mailcfg{from}\n";
954
955 %mail = (
956 #To => 'No to field this time, only Bcc and Cc',
957 #From => 'not needed, use default',
958 Bcc => 'Someone <him@there.com>, Someone else her@there.com',
959 # only addresses are extracted from Bcc, real names disregarded
960 Cc => 'Yet someone else <xz@whatever.com>',
961 # Cc will appear in the header. (Bcc will not)
962 Subject => 'Test message',
963 'X-Mailer' => "Mail::Sendmail version $Mail::Sendmail::VERSION",
964 );
965
966
967 $mail{Smtp} = 'special_server.for-this-message-only.domain.com';
968 $mail{'X-custom'} = 'My custom additionnal header';
969 $mail{'mESSaGE : '} = "The message key looks terrible, but works.";
970 # cheat on the date:
971 $mail{Date} = Mail::Sendmail::time_to_date( time() - 86400 );
972
973 if (sendmail %mail) { print "Mail sent OK.\n" }
974 else { print "Error sending mail: $Mail::Sendmail::error \n" }
975
976 print "\n\$Mail::Sendmail::log says:\n", $Mail::Sendmail::log;
977
978 Also see http://alma.ch/perl/Mail-Sendmail-FAQ.html for examples
979 of HTML mail and sending attachments.
980
981 =head1 CHANGES
982
983 Main changes since version 0.79:
984
985 Experimental SMTP AUTH support (LOGIN PLAIN CRAM-MD5 DIGEST-MD5)
986
987 Fix bug where one refused RCPT TO: would abort everything
988
989 send EHLO, and parse response
990
991 Better handling of multi-line responses, and better error-messages
992
993 Non-conforming line-endings also normalized in headers
994
995 Now keeps the Sender header if it was used. Previous versions
996 only used it for the MAIL FROM: command and deleted it.
997
998 See the F<Changes> file for the full history. If you don't have it
999 because you installed through PPM, you can also find the latest
1000 one on F<http://alma.ch/perl/scripts/Sendmail/Changes>.
1001
1002 =head1 AUTHOR
1003
1004 Milivoj Ivkovic <mi\x40alma.ch> ("\x40" is "@" of course)
1005
1006 =head1 NOTES
1007
1008 MIME::QuotedPrint is used by default on every message if available. It
1009 allows reliable sending of accented characters, and also takes care of
1010 too long lines (which can happen in HTML mails). It is available in the
1011 MIME-Base64 package at http://www.perl.com/CPAN/modules/by-module/MIME/ or
1012 through PPM.
1013
1014 Look at http://alma.ch/perl/Mail-Sendmail-FAQ.html for additional
1015 info (CGI, examples of sending attachments, HTML mail etc...)
1016
1017 You can use this module freely. (Someone complained this is too vague.
1018 So, more precisely: do whatever you want with it, but be warned that
1019 terrible things will happen to you if you use it badly, like for sending
1020 spam, or ...?)
1021
1022 Thanks to the many users who sent me feedback, bug reports, suggestions, etc.
1023 And please excuse me if I forgot to answer your mail. I am not always reliabe
1024 in answering mail. I intend to set up a mailing list soon.
1025
1026 Last revision: 06.02.2003. Latest version should be available on
1027 CPAN: F<http://www.cpan.org/modules/by-authors/id/M/MI/MIVKOVIC/>.
1028
1029 =cut