#!/usr/bin/perl -w
use strict;
require 5.005;

=head1 NAME

 sendmail_like.pl - a perl program that can act like /usr/lib/sendmail

=head1 SYNOPSIS

  cat message.txt | sendmail_like.pl -t 
  cat message.txt | sendmail_like.pl -v -fwhoever@nowhere.com -smtp_host smtp.nowhere.com -- frank@company.com

=head1 DESCRIPTION

Some programs have a hardcoded behavior for sending mail, doing something
like this in their code:

   open(SENDMAIL, "|$sendmail -t");

or the equivalent in some other programming language.

But /usr/lib/sendmail doesn't exist on windows, and sometimes on unix one
has a machine where sendmail.cf isn't set up.

There is blat for windows, but it is C code and also doesn't work on Unix.
There are lots of perl modules to send mail, but they don't have a plug-in
replacement program for sendmail (just some programmatic interface which
is substantially different), so they don't help in working with other programs
that assume they will be calling sendmail.

This requires a smtp server. It finds one as follows:

  -smtp_host option on the command line
  'smtp_hosts' variable in Net::Config (just the first in the array)
  $DEFAULT_SMTP_HOST variable in this file
  fatal error

It supports these sendmail command line options (copying descriptions from the sendmail man page):

     -Btype      Set the body type to type. Current legal values 7BIT or
                 8BITMIME.

     -ba         Go into ARPANET mode.  All input lines must end with a CR-LF,
                 and all messages will be generated with a CR-LF at the end.
                 Also, the ``From:'' and ``Sender:'' fields are examined for
                 the name of the sender.

     -bm         Deliver mail in the usual way (default).

     -fname      Sets the name of the ``from'' person (i.e., the sender of the
                 mail).  -f can only be used by ``trusted'' users (normally
                 root, daemon, and network) or if the person you are trying to
                 become is the same as the person you are.

     -rname      An alternate and obsolete form of the -f flag.

     -i          Ignore dots alone on lines by themselves in incoming mes­
                 sages.  This should be set if you are reading data from a
                 file.

     -t          Read message for recipients.  To:, Cc:, and Bcc: lines will
                 be scanned for recipient addresses.  The Bcc: line will be
                 deleted before transmission.

     -v          Go into verbose mode.  Alias expansions will be announced,
                 etc.

     --          Stop processing command flags and use the rest of the argu­
                 ments as addresses.

No other options are accepted.
Because it just talks directly to a remote SMTP server, it doesn't do
alias expansion or any of that.
These options are accepted and ignored: -Btype, -ba, -bm, -i, -oi (means same as -i).
Of course our -v output is nothing like sendmail's.

To determine envelope (from and to) information, you must either:

   specify -t, or
   specify {-f,-r} and recipient addresses on the command line.

The message in stdin is used exactly as the message itself; the command line
affects only the envelope information. 

The program will block while it is doing things.

=head1 DEPENDENCIES

This currently relies on:

  Net::Config
  Mail::Internet
  Net::SMTP

=head1 BUGS

See comments on _prephdr below -- we are defaulting From and Sender in the message using
the envelope From because of mis-features of Mail::Internet.
We leave "To" alone.

=head1 TODO

Support not having "--" before recipients.

Support -OErrorMode=m (same as -oem).

Support -ODeliveryMode=b

Does sendmail inject addresses from the command line into the message header?

Does sendmail merge recipients if they are both on the command line and -t is given?

Is there any use for -Ffullname, or is that just for querying a sendmail config
db which no one uses?

Retry against a list of smtp servers.

Maybe also check for a host named 'mailhost'.

Maybe look at the configs for other modules, such as
   $Mail::Sendmail::mailcfg{'smtp'}
   $ENV{SMTPHOSTS} # Mail::Internet

Maybe actually let Mail::Mailer propose one, possibly using $ENV{PERL_MAILERS}

Offer other ports than 25.

=head1 AUTHOR

Copyright 2000, Mark D. Anderson, mda@discerning.com.

This is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

####
# cpan modules
####

# so we can check it for smtp_hosts
use Net::Config qw(%NetConfig);

####
# config
####
use vars qw($DEFAULT_SMTP_HOST $DEFAULT_TIMEOUT);
# edit if you want a fallback
$DEFAULT_SMTP_HOST = '';
$DEFAULT_TIMEOUT = 60;

####
# globals
####

####
# utils
####

my $DEBUG = 0;
sub debug {
    $| = 1 if $DEBUG;
    print "DEBUG: ", @_, "\n" if $DEBUG;
}

sub read_command_line {
    my %opt_values = ();

=begin ignore

    use Getopt::Long;
    my @opt_control = qw(smtp_host=s parse_headers|t from|f|r=s B=s ba bm i v);

    # GetOptions({'smtp_host=s' => \$smtp_host});
    GetOptions(\%opt_values, @opt_control);

=cut

    debug "argv is: ", join('|',@ARGV);

    while ($_ = shift @ARGV) {
	debug "processing option '$_'";
	next unless $_;
	last if $_ eq '--';
	m/-smtp_host/ and $opt_values{smtp_host} = (shift @ARGV || die "undefined value for '$_' option"), next;
	m/-timeout/ and $opt_values{timeout} = (shift @ARGV || die "undefined value for '$_' option"), next;
	m/-[fr](.*)/ and $opt_values{from} = $1, next;
	m/-t/ and $opt_values{parse_headers} = 1, next;
	m/--verbose/ || m/-v/ and $DEBUG = 1, next;
	m/-B/ || m/-b/ || m/-i/ || m/-oi/ and next;
	die "unknown option '$_'";
    }

    debug "options are: ", join (', ', map { $_ . ' => ' . $opt_values{$_} } keys %opt_values);
    return \%opt_values, \@ARGV;
}
    

####
# main
####
sub main{
    # read command line
    my ($opts, $recipients) = read_command_line();

    # determine smtp host
    my $net_cfg = $NetConfig{smtp_hosts} || [];
    # suppress bundled default (in lib/Net/libnet.cfg or lib/Net/Config.pm)
    if ($net_cfg->[0] && $net_cfg->[0] =~ m/uwinnipeg.ca/) {
	debug "ignoring unconfigured smtp_hosts value in Net::Config";
	$net_cfg = [];
    }

    my $smtp_host = $opts->{smtp_host} || $net_cfg->[0] || $DEFAULT_SMTP_HOST || die "no default smtp host configured or set via -smtp_host; see module documentation";
    # IO::Socket may say:
    # the smtp host 'smtp.whatever.com' seems bad: Insecure dependency in connect while running setuid at
    # /home/buildsite/local/perl-5.6.0/lib/5.6.0/i686-linux/IO/Socket.pm line 108
    $smtp_host =~ m/([\w\-\.\_]*)/;
    die "smtp host '$smtp_host' seems to have illegal characters" unless $1 && $smtp_host eq $1;
    $smtp_host = $1;
    debug "using smtp_host '$smtp_host'";

    # complain if no envelope information
    die "you must say either '-t', or specify -f and some recipients" if !$opts->{parse_headers} && (!$opts->{from} || !scalar(@$recipients));

    # read rfc822 message from input
    debug "reading message from stdin";
    # Mail::Internet wants an array of lines
    # my $message_string; {local $/ = undef; $message_string = <STDIN>;}
    my @message_lines = <STDIN>;

    # we definitely have to parse it if -t
    # for now, we also have to parse it because our mail sender wants body and headers separate
    my $message_obj;
    my $header_obj;
    my $body_string;
    my $header_hash;
    {
	use Mail::Internet;
	$message_obj = new Mail::Internet (\@message_lines);
	# end of lines are still there
	$body_string = join('', $message_obj->body());
	# Mail::Header
	$header_obj = $message_obj->head();
	my %headers = map {$_ => $header_obj->get($_)} $header_obj->tags();
	$header_hash = \%headers;
    }

    # send it

=begin ignore

    # Mail::Mailer - not bundled
    # Mail::Send requires Mail::Mailer, and is used (but not required in perlbug)
    # not much help in dealing with envelope vs. message
    # weak at errors
    # has an uninitialized variable warning on 5.005 win32 
    if (0) {
	use Mail::Mailer;

	my $mailer = new Mail::Mailer 'smtp', Server => $smtp_host;

	if (!$opts->{parse_headers}) {
	    # BUG: we are modifying the message itself now, to match envelope information
	    $header_hash->{From} = $opts->{from};
	    $header_hash->{To} = $recipients;
	}
	
	$mailer->open($header_hash);
	print $mailer $body_string;
	$mailer->close();
    }
=cut

    # Mail::Internet - not bundled
    # this seems to work.
    if (1) {
	use Mail::Internet;

	# if $recipients is not empty, the module will override the To given in the message,
	# but for the envelope only (i.e. the header still has whatever To it has).
	# this is exactly the right behavior.

	# the module sets the envelope From using Mail::Util qw(mailaddress), 
	# which uses the MAILADDRESS env var among other heuristics.
	# the module mostly does the right thing, not touching the header To but only the envelope.
	my $envelope_from = $opts->{from} || $header_hash->{From} || die "no from";
	local $ENV{MAILADDRESS} = $envelope_from;

	# the _prephdr() function in Mail::Internet is the one that fools with the headers.
	# it:
	#   deletes 'Received'
	#   replaces 'X-Mailer' with itself
	#   defaults From and Sender using a heuristic
	# according to http://www.ietf.org/internet-drafts/draft-ietf-drums-msg-fmt-08.txt
	# that is incorrect behavior (Sender is only mandatory if there are multiple From fields,
	# and anyway should default from the From, not the envelope).
	# so we default them ourselves (with a bug if there are multiple From's)
	# Because _prephdr() is called from smtpsend, there isn't much we can do about this.
	# Note that we still allow no "To" to be sent in the message.
	$header_obj->add('Sender', ($header_hash->{From} || $envelope_from)) unless $header_obj->get('Sender');
	$header_obj->add('From', $envelope_from) unless $header_obj->get('From');

	# the Host option can be either a string (like $smtp_host), or a Net::SMTP object 
	# we create it so we can set timeout, and catch errors
	use Net::SMTP;
	my $smtp_obj;
	eval {$smtp_obj = new Net::SMTP($smtp_host, Timeout => ($opts->{timeout} || $DEFAULT_TIMEOUT), Debug => $DEBUG)};
	die "the smtp host '$smtp_host' seems bad: $@" if $@;
	my @to_addresses = $message_obj->smtpsend(Host => $smtp_obj, To => $recipients);
	unless (@to_addresses) {
	    die "could not send message, using smtp host '$smtp_host'; last response code was '", $smtp_obj->code(), "' and last response text was: '", join("\n", $smtp_obj->message()), "'";
	}
    }

=begin ignore

    # Mail::Sendmail - not bundled
    # this should work (not tested).
    if (0) {
	use Mail::Sendmail;

	# it deletes all special keys from the arguments, and uses the rest as headers
	my $is_success = sendmail
	    (
	     Server => $smtp_host,
	     %$header_hash,
	     To => ($recipients || $header_hash->{To}),
	     From => ($opts->{from} || $header_hash->{From}),
	     Message => $body_string,
	     );
	die $Mail::Sendmail::error unless $is_success;
    }
=cut
    1;
}

main();

####
# testing
####
sub testme {
    system("cat junkmail.txt | perl -w sendmail_like.pl -t");
}