bin/sendmail.pl

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