bin/sendmail.pl

   1 #!/usr/bin/perl
   2
   3 # sendmail.pl - sendmail to SMTP bridge
   4 # Copyright (c) 2014 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';
  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        --
  91               Signals the end of the options.  Anything following will be taken
  92               as a recipient address even if it starts with a '-'.
  93
  94        recipient ...
  95               Zero or more recipient addresses to deliver the message to.  Each
  96               of these addresses will be passed to an SMTP "RCPT TO:" command.
  97               If both '-t' and one or more recipient addresses are given then
  98               the '-t' addresses will be added after the explicitly listed
  99               recipients.  Multiple recipients concatenated together using ','s
 100               and passed as a single recipient argument will be handled
 101               correctly.  At least one recipient must be given either
 102               explicitly or via the '-t' option.
 103
 104 ENVIRONMENT
 105        SENDMAIL_PL_NCBIN
 106               The netcat binary to use.  Must understand the -w secs option.
 107               If this is not set then "nc" is expected to be in the PATH.
 108
 109        SENDMAIL_PL_NCOPT
 110               Additional options to pass to nc (netcat).  No other options
 111               besides -w are passed by default.  Should be a space-separated
 112               list of options complete with leading '-'.  For example:
 113                      export SENDMAIL_PL_NCOPT='-4'
 114               to force use of IPv4 addresses.
 115
 116        SENDMAIL_PL_HOST
 117               The SMTP host to connect to.  If not set then "localhost" will
 118               be used.
 119
 120        SENDMAIL_PL_PORT
 121               The SMTP host port to connect to.  If not set then 25 will be
 122               used.
 123
 124 BUGS
 125        The header parsing provided by the '-t' option may fail to pick up the
 126        correct recipient addresses if they use anything more than basic address
 127        syntax and/or any of the header lines are wrapped.
 128
 129        Using environment variables to configure some of the settings may be a
 130        less common technique for tools of this sort.
 131
 132 VERSION
 133        sendmail.pl version $VERSION
 134        Copyright (c) 2014 Kyle J. McKay.  All rights reserved.
 135        License GPLv2+: GNU GPL version 2 or later.
 136        http://gnu.org/licenses/gpl.html
 137        This is free software: you are free to change and redistribute it.
 138        There is NO WARRANTY, to the extent permitted by law.
 139
 140 HELP
 141 }
 142
 143 sub protect($)
 144 {
 145   my $line = shift;
 146   return $line unless $line && $line =~ /^[.]/;
 147   return '.' . $line;
 148 }
 149
 150 sub cleanup($)
 151 {
 152   my $line = shift;
 153   $line =~ s/(?:\r\n|\r|\n)$//os;
 154   return $line;
 155 }
 156
 157 sub main
 158 {
 159   my $done = 0;
 160   my $opt_v = 0;
 161   my $opt_i = 0;
 162   my $opt_t = 0;
 163   my $opt_f = $ENV{'LOGNAME'} || 'nobody';
 164   my $hn = hostfqdn;
 165   my @rcpts = ();
 166   while (@ARGV && $ARGV[0] =~ /^-/) {
 167     my $opt = shift @ARGV;
 168     last if $opt eq '--';
 169     print($VERSIONMSG), exit 0 if $opt eq '-V' || $opt eq '--version';
 170     $opt_v = 1, next if $opt eq '-v' || $opt eq '--verbose';
 171     print(($opt_v?$HELP:$USAGE),"\n"), exit 0 if $opt eq '-h' || $opt eq '--help';
 172     die "$USAGE\n" if $opt eq '-f' && !@ARGV;
 173     $opt_f = shift @ARGV, next if $opt eq '-f';
 174     $opt_f = $1, next if $opt =~ /^-f(.+)$/;
 175     $opt_i = 1, next if $opt eq '-i' || $opt eq '-oi' || $opt eq '-oitrue';
 176     $opt_t = 1, next if $opt eq '-t';
 177     $opt_i = $opt_t = 1, next if $opt eq '-ti' || $opt eq '-it';
 178     die "Unknown option: $opt\n$USAGE\n";
 179   }
 180   $opt_f =~ s/^[ \t]*<//; $opt_f =~ s/>[ \t]*$//;
 181   $opt_f =~ s/^[ \t]+//; $opt_f =~ s/[ \t]+$//;
 182   $opt_f .= '@'.$hn if $opt_f && $opt_f !~ /\@/; # some servers require @domain
 183   $opt_f = '<' . $opt_f . '>';
 184   foreach my $rcpt (split(/,/, join(',', @ARGV))) {
 185     $rcpt =~ s/^[ \t]*<//; $rcpt =~ s/>[ \t]*$//;
 186     $rcpt =~ s/^[ \t]+//; $rcpt =~ s/[ \t]+$//;
 187     $rcpt .= '@'.$hn if $rcpt && $rcpt !~ /\@/; # some servers require @domain
 188     push(@rcpts, '<' . $rcpt . '>') if $rcpt;
 189   }
 190   @ARGV = ();
 191
 192   die "sendmail.pl: error: no recipients specified\n$USAGE\n"
 193     unless @rcpts || $opt_t;
 194
 195   my @headers = ();
 196   my $lasthdr = '';
 197   my $extraline = '';
 198   for (;;) {
 199     my $line = <>;
 200     $line = undef if !$opt_i && $line =~ /^[.][\r\n]*$/;
 201     $done = 1, last unless defined($line);
 202     $line =~ s/(?:\r\n|\r|\n)$//os;
 203     $line =~ s/[ \t]+$//;
 204     if ($lasthdr && $line =~ /^[ \t]+(.*)$/) {
 205       # Unfold
 206       $lasthdr .= ' ' . $1;
 207       next;
 208     }
 209     push(@headers, $lasthdr) if $lasthdr;
 210     $lasthdr = '';
 211     if ($line =~ /^[\x21-\x39\x3b-\x7e]+:/) {
 212       $lasthdr = $line;
 213       next;
 214     }
 215     $extraline = $line;
 216     last;
 217   }
 218   push(@headers, $lasthdr) if $lasthdr;
 219
 220   if ($opt_t) {
 221     foreach my $hdr (@headers) {
 222       if ($hdr =~ /^(?:To|Cc|Bcc):[ \t]*(.*)$/osi) {
 223         my $alist = $1;
 224         # Very crude parsing here
 225         $alist =~ s/[(].*?[)]//go; # Dump comments
 226         $alist =~ s/["].*?["]//go; # Dump quoted
 227         $alist =~ s/[ \t]+,/,/go;  # Kill extra
 228         $alist =~ s/,[ \t]+/,/go;  # spaces
 229         foreach my $adr (split(/,/, $alist)) {
 230           my $rcpt = '';
 231           if ($adr =~ /<([^ \t>]+)>/) {
 232             $rcpt = $1;
 233           } elsif ($adr =~ /^([^ \t]+)$/) {
 234             $rcpt = $1;
 235           }
 236           $rcpt .= '@'.$hn if $rcpt && $rcpt !~ /\@/; # some servers require @domain
 237           push(@rcpts, '<' . $rcpt . '>') if $rcpt;
 238         }
 239       }
 240     }
 241   }
 242
 243   my $ncbin = $ENV{'SENDMAIL_PL_NCBIN'} || 'nc';
 244   my $ncopt = $ENV{'SENDMAIL_PL_NCOPT'} || '';
 245   my @ncopts = ();
 246   @ncopts = split(' ', $ncopt) if $ncopt;
 247   my $nchost = $ENV{'SENDMAIL_PL_HOST'} || 'localhost';
 248   my $ncport = $ENV{'SENDMAIL_PL_PORT'} || '25';
 249   my @cmd = ();
 250   push(@cmd, $ncbin, '-w', '30', @ncopts, $nchost, $ncport);
 251
 252   die "sendmail.pl: error: no recipients specified\n" unless @rcpts;
 253
 254   my ($send, $recv);
 255   (my $pid = open2($recv, $send, @cmd))
 256     or die "sendmail.pl: error: nc failed: $!\n";
 257
 258   my $resp;
 259   defined($resp = <$recv>) && $resp =~ /^220 /
 260     or die "sendmail.pl: error: failed to receive initial SMTP 220 response\n";
 261   print $send "HELO localhost\r\n";
 262   defined($resp = <$recv>) && $resp =~ /^250 /
 263     or die "sendmail.pl: error: failed to receive SMTP HELO 250 response\n";
 264
 265   print $send "MAIL FROM: $opt_f\r\n";
 266   defined($resp = <$recv>) && $resp =~ /^250 /
 267     or die "sendmail.pl: error: SMTP MAIL FROM: $opt_f failed\n";
 268   foreach my $rcpt (@rcpts) {
 269     print $send "RCPT TO: $rcpt\r\n";
 270     defined($resp = <$recv>) && $resp =~ /^250 /
 271       or die "sendmail.pl: error: SMTP RCPT TO: $rcpt failed\n";
 272   }
 273
 274   print $send "DATA\r\n";
 275   defined($resp = <$recv>) && $resp =~ /^354 /
 276     or die "sendmail.pl: error: SMTP DATA failed\n";
 277   foreach my $hdr (@headers) {
 278     print $send "$hdr\r\n" unless $opt_t && $hdr =~ /^Bcc:/i;
 279   }
 280   print $send "\r\n";
 281   print $send protect($extraline), "\r\n" if $extraline;
 282
 283   if (!$done) {
 284     while (my $line = <>) {
 285       $line =~ s/(?:\r\n|\r|\n)$//os;
 286       last if !$opt_i && $line =~ /^[.]$/;
 287       print $send protect($line), "\r\n";
 288     }
 289   }
 290
 291   print $send ".\r\n";
 292   defined($resp = <$recv>) && $resp =~ /^250 /
 293     or die "sendmail.pl: error: SMTP message not accepted (@{[cleanup($resp)]})\n";
 294
 295   print $send "QUIT\r\n";
 296   $resp = <$recv>; # Should be /^221 / for goodbye, but we don't really care
 297   close $send;
 298   close $recv;
 299   exit 0;
 300 }