#!/usr/bin/perl
#-----------------------------------------------------------------------------
#  This program gives you low level control over an SMTP conversation.
#
#  This program delivers a mail message to an SMTP server.  Command line
#  options tell what server to use and determine the commands this program
#  sends to it.  The program reads the mail message itself from 
#  Standard Input.
#
#  This program does not generate headers inside the mail message (e.g.
#  RFC 822 headers).  You can use the program 'makemail' to do that.
#
#  This program does not extract any envelope information from the mail
#  message or rewrite the message in any way.
#-----------------------------------------------------------------------------

use strict;
use warnings;

use Net::SMTP;
use Getopt::Long;
use Sys::Hostname;
use Data::Dumper;
use File::stat;

my $TRUE = 1;
my $FALSE = 0;


sub getSender($) {
    my ($fromOpt) = @_;

    my $retval;
    
    if (defined($fromOpt)) {
        $retval = $fromOpt;
    } else {
        my $user = $ENV{"USER"} || $ENV{"LOGNAME"};
        if (!defined("$user")) {
            die("You didn't supply a sender address with " .
                "--from and I cannot " .
                "default one because neither USER nor LOGNAME environment " .
                "variables is set.");
        } else {
            my $hostname = hostname;
            if (defined($hostname)) {
                $retval = "$user\@$hostname";
            } else {
                $retval = $user;
            }
        }
    }
    return $retval;
}



sub multiplier($) {
    my ($suffix) = @_;

    my $multiplier;

    if (!defined($suffix)) {
        $multiplier = 1;
    } else {
        if ($suffix eq 'k') {
            $multiplier = 1024;
        } elsif ($suffix eq 'm') {
            $multiplier = 1024 * 1024;
        } elsif ($suffix eq 'g') {
            $multiplier = 1024 * 1024 * 1024;
        } else {
            die("Internal error.  Impossible case.");
        }
    }
    return $multiplier;
}



sub getSize($) {
    my ($sizeOpt) = @_;

    my $retval;

    if (defined($sizeOpt)) {
        my $lowerSize = lc($sizeOpt);

        if ($lowerSize eq 'filesize') {
            my $fileInfo = stat(*STDIN);
            if (!defined($fileInfo)) {
                die("Unable to stat Standard Input to determine its filesize");
            }
            if ($fileInfo->size) {
                $retval = $fileInfo->size;
            } else {
                die("Standard Input does not have a filesize, so you can't " .
                    "use -size=filesize");
            }
        } elsif ($lowerSize =~ m{ ^ (\d+) ([kmg])? $ }x) {
            # It's a valid size.
            my ($mantissa, $exponent) = ($1, $2);

            $retval = $mantissa * multiplier($exponent);
        } else {
            die("Invalid value of '-size' option.  Must be either a number " .
                "of bytes or 'filesize'");
        }
    } else {
        $retval = undef;
    }
    return $retval;
}



sub getBits($) {
    my ($bitsOpt) = @_;

    my $retval;
    
    if (defined($bitsOpt)) {
        my $lowerBits = lc($bitsOpt);
        
        if ($lowerBits eq '7') {
            $retval = '7';
        } elsif ($lowerBits eq '8') {
            $retval = '8';
        } elsif ($lowerBits eq 'binary') {
            $retval = 'binary';
        } else {
            die("Invalid value for -bits option.  Must be 7, 8, or 'binary'");
        }
    } else {
        $retval = undef;
    }
    return $retval;
}



sub authenticateIfRequested($$$) {
    my ($smtp, $option, $errorR) = @_;

    my $errorRet;

    if (defined($option->{'user'}) || defined($option->{'user'})) {
        if (!defined($option->{'user'})) {
            $errorRet = "You specified -password, but not -user";
        } elsif (!defined($option->{'password'})) {
            $errorRet = "You specified -user, but not -password";
        } else {
            my $result = $smtp->auth($option->{'user'}, $option->{'password'});
            if (!$result) {
                $errorRet = "Authentication with server failed.  " .
                    "Server says '" . $smtp->message . "'";
            }
        }
    }
    $$errorR = $errorRet;
}



sub sendRecipients($$$) {
    my ($smtp, $recipients, $errorR) = @_;

    my $errorRet;
    foreach my $recipient (@{$recipients}) {
        if (!$errorRet) {
            my $result = $smtp->recipient($recipient);
            if (!$result) {
                $errorRet = "Failed sending RCPT command for '$recipient'.  " .
                    "Server says '" . $smtp->message . "'";
            }
        }
    }
    $$errorR = $errorRet;
}
##############################################################################
#       MAINLINE
##############################################################################

my %options;

$options{"to"} = [];   # Establish as an array reference

GetOptions(\%options, 
           "to=s",
           "from=s",
           "server=s",
           "hello=s",
           "timeout=i",
           "size=s",
           "bits=s",
           "user=s",
           "password=s",
           "quiet",
           "debug"
           );

if ($options{"debug"}) {
  Net::SMTP->debug(1);
}

if (@{$options{"to"}} == 0) {
    die("Must specify the recipient email address with --to");
} 

my @recipients = @{$options{"to"}};
#print Data::Dumper->Dump([ \@recipients ], [ "recipients" ]);

my $sender = getSender($options{"from"});

my $server = $options{"server"} || "localhost";

my $size = getSize($options{"size"});

my $bits = getBits($options{"bits"});

my @smtpOptions = ();  # initial value
if (defined($options{"hello"})) {
    push(@smtpOptions, Hello => $options{"hello"});
}
if (defined($options{"timeout"})) {
    push(@smtpOptions, Timeout => $options{"timeout"});
}
if ($options{"debug"}) {
    push(@smtpOptions, Debug => 1);
}

my $smtp = Net::SMTP->new($server, @smtpOptions);

if (!defined($smtp)) {
    die("Failed to connect to SMTP server at '$server'");
}

if (!$options{"quiet"}) {
    print("Server at $server identifies as '" . $smtp->domain . "' " .
          "and says:\n");
    print $smtp->banner;
    print ("\n");
}

authenticateIfRequested($smtp, \%options, \my $error);
if ($error) {
    warn("Authentication problem.  $error");
    $smtp->quit;
} else {
    my $result = $smtp->mail($sender, Size=>$size, Bits=>$bits);
    if (!$result) {
        warn("Failed sending MAIL command.  " .
             "Server says '" . $smtp->message . "'");
    } else {
        sendRecipients($smtp, \@recipients, \my $error);
        if ($error) {
            warn("Failed to send recipients to server.  $error");
            $smtp->quit;
        } else {
            if (!$options{'quiet'}) {
                print ("Reading mail message from Standard Input...\n");
            }            
            my @message = <STDIN>;
            
            my $result = $smtp->data(@message);
            
            if (!$result) {
                warn("Server rejected message.  " .
                     "Server says '" . $smtp->message . "'");
                $smtp->quit;
            } else {
                $smtp->quit;
                if (!$options{"quiet"}) {
                    my $recipientDesc;
                    if (@recipients == 1) {
                        $recipientDesc = $recipients[0];
                    } else {
                        $recipientDesc = scalar(@recipients) . " recipients";
                    }
                    print("Message sent to $recipientDesc from $sender.\n");
                }
            }
        }
    }
}






