bin/sendmail.pl

   1 #!/usr/bin/perl
   2
   3 # sendmail.pl - sendmail to SMTP bridge
   4 # Copyright (C) 2014,2015 Kyle J. McKay.  All rights reserved.
   5
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation, either version 2 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 use strict;
  20 use warnings;
  21 use bytes;
  22
  23 use IPC::Open2;
  24 use Net::Domain qw(hostfqdn);
  25
  26 exit(&main()||0);
  27
  28 our $VERSION;
  29 my $VERSIONMSG;
  30 my $HELP;
  31 my $USAGE;
  32
  33 BEGIN {
  34   *VERSION = \'1.0.2';
  35   $VERSIONMSG = "sendmail.pl version $VERSION\n" .
  36     "Copyright (c) 2014 Kyle J. McKay.  All rights reserved.\n" .
  37     "License GPLv2+: GNU GPL version 2 or later.\n" .
  38     "http://gnu.org/licenses/gpl.html\n" .
  39     "This is free software: you are free to change and redistribute it.\n" .
  40     "There is NO WARRANTY, to the extent permitted by law.\n";
  41   $USAGE = <<USAGE;
  42 Usage: sendmail.pl [-V] [-v] [-h] [-i] [-f addr] [-t] [recipient ...]
  43 (Use sendmail.pl -v -h for extended help)
  44 USAGE
  45   $HELP = <<HELP;
  46 NAME
  47        sendmail.pl -- sendmail to SMTP bridge
  48
  49 SYNOPSIS
  50        sendmail.pl [-V] [-v] [-h] [-i] [-f addr] [-t] [recipient ...]
  51
  52 DESCRIPTION
  53        sendmail.pl provides semantics similar to the common sendmail executable
  54        and reads an incoming message to be delivered and then connects to
  55        the specified SMTP server to deliver it with the help of netcat.
  56
  57        Only the most basic sendmail options are supported along with the most
  58        basic header support (when -t is given).
  59
  60        The nc (netcat) executable used and options passed to it can be
  61        controlled via environment variables.
  62
  63 OPTIONS
  64        -V
  65               Show the sendmail.pl version.
  66
  67        -v
  68               Verbose output.  If given before -h this help will be shown.
  69
  70        -h
  71               Show basic usage help.
  72
  73        -i
  74               Do not treat a line consisting of a single '.' as ending the
  75               input.
  76
  77        -f addr
  78               Set the envelope header address.  This is the address that will
  79               be passed to the SMTP "MAIL FROM:" command.  If this option is
  80               not specified then the value of the LOGNAME environment variable
  81               will be used instead.  Some SMTP servers may perform validation
  82               on this address requiring a specific value here for the mail
  83               delivery to be successful.
  84
  85        -t
  86               Read the list of recipients from the message's To:, Cc: and Bcc:
  87               headers.  If a Bcc: header is found, it's removed after picking
  88               up the destination addresses.
  89
  90        -m
  91               Ignored for compatibility.
  92
  93        --
  94               Signals the end of the options.  Anything following will be taken
  95               as a recipient address even if it starts with a '-'.
  96
  97        recipient ...
  98               Zero or more recipient addresses to deliver the message to.  Each
  99               of these addresses will be passed to an SMTP "RCPT TO:" command.
 100               If both '-t' and one or more recipient addresses are given then
 101               the '-t' addresses will be added after the explicitly listed
 102               recipients.  Multiple recipients concatenated together using ','s
 103               and passed as a single recipient argument will be handled
 104               correctly.  At least one recipient must be given either
 105               explicitly or via the '-t' option.
 106
 107 ENVIRONMENT
 108        SENDMAIL_PL_NCBIN
 109               The netcat binary to use.  Must understand the -w secs option.
 110               If this is not set then "nc" is expected to be in the PATH.
 111
 112        SENDMAIL_PL_NCOPT
 113               Additional options to pass to nc (netcat).  No other options
 114               besides -w are passed by default.  Should be a space-separated
 115               list of options complete with leading '-'.  For example:
 116                      export SENDMAIL_PL_NCOPT='-4'
 117               to force use of IPv4 addresses.
 118
 119        SENDMAIL_PL_HOST
 120               The SMTP host to connect to.  If not set then "localhost" will
 121               be used.
 122
 123        SENDMAIL_PL_PORT
 124               The SMTP host port to connect to.  If not set then 25 will be
 125               used.
 126
 127 BUGS
 128        The header parsing provided by the '-t' option may fail to pick up the
 129        correct recipient addresses if they use anything more than basic address
 130        syntax and/or any of the header lines are wrapped.
 131
 132        Using environment variables to configure some of the settings may be a
 133        less common technique for tools of this sort.
 134
 135 VERSION
 136        sendmail.pl version $VERSION
 137        Copyright (c) 2014 Kyle J. McKay.  All rights reserved.
 138        License GPLv2+: GNU GPL version 2 or later.
 139        http://gnu.org/licenses/gpl.html
 140        This is free software: you are free to change and redistribute it.
 141        There is NO WARRANTY, to the extent permitted by law.
 142
 143 HELP
 144 }
 145
 146 sub protect($)
 147 {
 148   my $line = shift;
 149   return $line unless $line && $line =~ /^[.]/;
 150   return '.' . $line;
 151 }
 152
 153 sub cleanup($)
 154 {
 155   my $line = shift;
 156   defined($line) or $line = '';
 157   $line =~ s/(?:\r\n|\r|\n)$//os;
 158   return $line;
 159 }
 160
 161 sub main
 162 {
 163   my $done = 0;
 164   my $opt_v = 0;
 165   my $opt_i = 0;
 166   my $opt_t = 0;
 167   my $opt_f = $ENV{'LOGNAME'} || 'nobody';
 168   my $hn = hostfqdn;
 169   my @rcpts = ();
 170   while (@ARGV && $ARGV[0] =~ /^-/) {
 171     my $opt = shift @ARGV;
 172     last if $opt eq '--';
 173     next if $opt eq '-m' || $opt eq '-om';
 174     print($VERSIONMSG), exit 0 if $opt eq '-V' || $opt eq '--version';
 175     $opt_v = 1, next if $opt eq '-v' || $opt eq '--verbose';
 176     print(($opt_v?$HELP:$USAGE),"\n"), exit 0 if $opt eq '-h' || $opt eq '--help';
 177     die "$USAGE\n" if $opt eq '-f' && !@ARGV;
 178     $opt_f = shift @ARGV, next if $opt eq '-f';
 179     $opt_f = $1, next if $opt =~ /^-f(.+)$/;
 180     $opt_i = 1, next if $opt eq '-i' || $opt eq '-oi' || $opt eq '-oitrue';
 181     $opt_t = 1, next if $opt eq '-t';
 182     $opt_i = $opt_t = 1, next if $opt eq '-ti' || $opt eq '-it';
 183     die "Unknown option: $opt\n$USAGE\n";
 184   }
 185   $opt_f =~ s/^[ \t]*<//; $opt_f =~ s/>[ \t]*$//;
 186   $opt_f =~ s/^[ \t]+//; $opt_f =~ s/[ \t]+$//;
 187   $opt_f .= '@'.$hn if $opt_f && $opt_f !~ /\@/; # some servers require @domain
 188   $opt_f = '<' . $opt_f . '>';
 189   foreach my $rcpt (split(/,/, join(',', @ARGV))) {
 190     $rcpt =~ s/^[ \t]*<//; $rcpt =~ s/>[ \t]*$//;
 191     $rcpt =~ s/^[ \t]+//; $rcpt =~ s/[ \t]+$//;
 192     $rcpt .= '@'.$hn if $rcpt && $rcpt !~ /\@/; # some servers require @domain
 193     push(@rcpts, '<' . $rcpt . '>') if $rcpt;
 194   }
 195   @ARGV = ();
 196
 197   die "sendmail.pl: error: no recipients specified\n$USAGE\n"
 198     unless @rcpts || $opt_t;
 199
 200   my @headers = ();
 201   my $lasthdr = '';
 202   my $extraline = '';
 203   for (;;) {
 204     my $line = <>;
 205     $line = undef if !$opt_i && $line =~ /^[.][\r\n]*$/;
 206     $done = 1, last unless defined($line);
 207     $line =~ s/(?:\r\n|\r|\n)$//os;
 208     $line =~ s/[ \t]+$//;
 209     if ($lasthdr && $line =~ /^[ \t]+(.*)$/) {
 210       # Unfold
 211       $lasthdr .= ' ' . $1;
 212       next;
 213     }
 214     push(@headers, $lasthdr) if $lasthdr;
 215     $lasthdr = '';
 216     if ($line =~ /^[\x21-\x39\x3b-\x7e]+:/) {
 217       $lasthdr = $line;
 218       next;
 219     }
 220     $extraline = $line;
 221     last;
 222   }
 223   push(@headers, $lasthdr) if $lasthdr;
 224
 225   if ($opt_t) {
 226     foreach my $hdr (@headers) {
 227       if ($hdr =~ /^(?:To|Cc|Bcc):[ \t]*(.*)$/osi) {
 228         my $alist = $1;
 229         # Very crude parsing here
 230         $alist =~ s/[(].*?[)]//go; # Dump comments
 231         $alist =~ s/["].*?["]//go; # Dump quoted
 232         $alist =~ s/[ \t]+,/,/go;  # Kill extra
 233         $alist =~ s/,[ \t]+/,/go;  # spaces
 234         foreach my $adr (split(/,/, $alist)) {
 235           my $rcpt = '';
 236           if ($adr =~ /<([^ \t>]+)>/) {
 237             $rcpt = $1;
 238           } elsif ($adr =~ /^([^ \t]+)$/) {
 239             $rcpt = $1;
 240           }
 241           $rcpt .= '@'.$hn if $rcpt && $rcpt !~ /\@/; # some servers require @domain
 242           push(@rcpts, '<' . $rcpt . '>') if $rcpt;
 243         }
 244       }
 245     }
 246   }
 247
 248   my $ncbin = $ENV{'SENDMAIL_PL_NCBIN'} || 'nc';
 249   my $ncopt = $ENV{'SENDMAIL_PL_NCOPT'} || '';
 250   my @ncopts = ();
 251   @ncopts = split(' ', $ncopt) if $ncopt;
 252   my $nchost = $ENV{'SENDMAIL_PL_HOST'} || 'localhost';
 253   my $ncport = $ENV{'SENDMAIL_PL_PORT'} || '25';
 254   my @cmd = ();
 255   push(@cmd, $ncbin, '-w', '30', @ncopts, $nchost, $ncport);
 256
 257   die "sendmail.pl: error: no recipients specified\n" unless @rcpts;
 258
 259   my ($send, $recv);
 260   (my $pid = open2($recv, $send, @cmd))
 261     or die "sendmail.pl: error: nc failed: $!\n";
 262
 263   my $resp;
 264   defined($resp = <$recv>) && $resp =~ /^220 /
 265     or die "sendmail.pl: error: failed to receive initial SMTP 220 response\n";
 266   print $send "HELO localhost\r\n";
 267   defined($resp = <$recv>) && $resp =~ /^250 /
 268     or die "sendmail.pl: error: failed to receive SMTP HELO 250 response\n";
 269
 270   print $send "MAIL FROM: $opt_f\r\n";
 271   defined($resp = <$recv>) && $resp =~ /^250 /
 272     or die "sendmail.pl: error: SMTP MAIL FROM: $opt_f failed\n";
 273   foreach my $rcpt (@rcpts) {
 274     print $send "RCPT TO: $rcpt\r\n";
 275     defined($resp = <$recv>) && $resp =~ /^250 /
 276       or die "sendmail.pl: error: SMTP RCPT TO: $rcpt failed\n";
 277   }
 278
 279   print $send "DATA\r\n";
 280   defined($resp = <$recv>) && $resp =~ /^354 /
 281     or die "sendmail.pl: error: SMTP DATA failed\n";
 282   foreach my $hdr (@headers) {
 283     print $send "$hdr\r\n" unless $opt_t && $hdr =~ /^Bcc:/i;
 284   }
 285   print $send "\r\n";
 286   print $send protect($extraline), "\r\n" if $extraline;
 287
 288   if (!$done) {
 289     while (my $line = <>) {
 290       $line =~ s/(?:\r\n|\r|\n)$//os;
 291       last if !$opt_i && $line =~ /^[.]$/;
 292       print $send protect($line), "\r\n";
 293     }
 294   }
 295
 296   print $send ".\r\n";
 297   defined($resp = <$recv>) && $resp =~ /^250 /
 298     or die "sendmail.pl: error: SMTP message not accepted (@{[cleanup($resp)]})\n";
 299
 300   print $send "QUIT\r\n";
 301   $resp = <$recv>; # Should be /^221 / for goodbye, but we don't really care
 302   close $send;
 303   close $recv;
 304   exit 0;
 305 }