#!/usr/bin/perl
#
# ------------------------------------------------------------
# script:  mail.pl
# Author:  Premson P R (premson@premson.net)
# Date:    7 May 2002
#

# Packages
use strict;
use Socket;     

# Set some default values:
my($CRLF) = "\r\n";
my($MIMEversion) = "1.0";
my($DEFAULT_CONTENT_TYPE) = "application/octet-stream";
my($content_type) = "";
my($padchar) = "=";
my($LINESIZE) = 76;

# Set some flags for use in determining state:
my($_attachment_encoded) = 0;
my($boundary) = "";
my($message) = "";
my($file_msg) = "";
my(@filemsg) = "";
my($_filename) = "";
my($last_processed) = -1;
my($no_stdin) = 0;
my($headeroverride) = 0;

# Declare some variables for use in the SMTP session:
my ( $mailcmd, $in_addr, $proto, $addr );
my ( $mailtest, $error_test );

# Base 64 encode characters table:
my(@encode_table) = (
    'A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P',
    'Q','R','S','T','U','V','W','X','Y','Z','a','b','c','d','e','f',
    'g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v',
    'w','x','y','z','0','1','2','3','4','5','6','7','8','9','+','/'
);

# Define global variables used for configuration information:
my($mailhost) = "mail.premson.net";
my($mailport) = 25;
my($to) = "";
my($recipient);
my(@recipients);

## PPR **--Start--** ##

my($ccrecipient);
my(@ccrecipients);
my($bccrecipient);
my(@bccrecipients);

## PPR **--Stop--** ##

my($from) = "premson\@eml.cc";
my($cc) = "";
my($bcc) = "";
my($replyto) = "";
my($subject) = "Test Attachment From Premson";
my($body) = "";
my(@bodymsg) = "";
my($attachment_list) = "";

# Declare an array to hold files for attachment:
my(@file);

# Since we're being strict, we need to pre-declare all vars:
my($i, $j, @attachments, $file_msg, @filemsg, $filename, $file_buffer, @attachments_encoded, $attachment, $flag, $extension, $random_int, $the_header, $tmp_incoming_data, $header, @decoded_attachment_data, $plain_text, $element, $encoded_attachment, @buffer, $encode_count, $buffer_string, $tmp_string); 

unless ($#ARGV >= 0) {
	&usage;
}

# Parse the command line to gather all necessary information.
&parseCmdLine;

unless ($no_stdin) {
    while (<STDIN>) {
	if ($_ =~ /^\./) {
		last;
	}
	$body .= $_;
    }
    print STDOUT "EOT\n";
}

open(FILEMSG, "$file_msg") or die "message: $!";
@bodymsg = <FILEMSG>;
$body .= @bodymsg;
close(FILEMSG);

# Dump the major vars to the screen for review and exit.
print "To:       $to\n";
print "From:     $from\n";
print "CC:       $cc\n";
#print "BCC:      $bcc\n";
#print "Reply-To: $replyto\n";
print "Subject:  $subject\n";
#print "Body:     $body\n";
#print "Mailhost: $mailhost\n";
#print "Port:     $mailport\n";
print "Attachments: $attachment_list\n";
#print "Last arg processed: $last_processed\n";
#exit;

# Create MIME attachments for each file named as an attachment
if ($#attachments >= 0) {
	for $j (0...$#attachments) {
	    $filename = $attachments[$j];
	    open (INCOMING, $filename) || die "Can't open $filename\n";
	    $file_buffer = "";
	    while (<INCOMING>) {
	    	$file_buffer .= $_;
	    }
	    close(INCOMING);
	
            # Fix to correct filename so it doesn't include path name
            @file = split(/\//, $filename);
            $_filename = @file[$#file];
	    $attachments_encoded[$j] = &printEncoded("$file_buffer");
	    $j++;
	
	}
}

## Creation of the Message portion

$boundary = &createBoundaryMarker;

$message = "From: " . $from . $CRLF;
$message .= "To: $to" . $CRLF;
$message .= "Cc: $cc" . $CRLF;
$message .= "Bcc: $bcc" . $CRLF;
if ($replyto) {
	$message .= "Reply-To: $replyto" . $CRLF;
}
$message .= "Subject: $subject" . $CRLF;

if ($attachment_list) {
	$message .= "MIME-Version: $MIMEversion" . $CRLF;
	$message .= "Content-Type: multipart/mixed; boundary=\"$boundary\"" . $CRLF . $CRLF;
	$message .= "This is a multi-part message in MIME format." . $CRLF . $CRLF;
        if ($body) {
             $message .= "--$boundary" . $CRLF;
             $message .= "Content-Type: text/plain; charset=us-ascii" 
                         . $CRLF;
             $message .= "Content-Transfer-Encoding: 7bit" . $CRLF;
        }
}

unless ($headeroverride) {
	$message .= $CRLF;
}

foreach $body (@bodymsg) {
$message .= $body;
}

#if ($body) {
#        $message .= $body . $CRLF; # Add the rest of the message
#        $message .= $CRLF;
#}

if ($attachment_list) {
	$message .= $CRLF . "--" . $boundary;
	
	foreach $attachment (@attachments_encoded) {
	    $message .= $CRLF . $attachment . $CRLF;
	    $message .= "--$boundary";
	}
	
	$message .= "--" . $CRLF;
}

## Sends the message

$in_addr = (gethostbyname($mailhost))[4];
$addr = sockaddr_in($mailport, $in_addr);

$proto = getprotobyname('tcp');

# Create a socket
socket(S, AF_INET, SOCK_STREAM, $proto) or die "socket: $!";

# Connect the socket to the host
connect(S, $addr) or die "Connect: $!";

# fflush socket after every write
select (S); $| = 1; select (STDOUT);

# Send SMTP request to the server
die "ERROR: $!" unless &expect(220,500);
print $mailcmd;

# Be nice, say hello to the mail host.
# Of course, say in MIME-wise with EHLO.
print S "EHLO $mailhost" . $CRLF;
die "ERROR: $!" unless &expect(250,501);
print $mailcmd;

print "Connected to $mailhost." . $CRLF;

print S "MAIL FROM: $from" . $CRLF;
#print "From: $from" . $CRLF;
die "ERROR: $!" unless &expect("ok",500);
print $mailcmd;

# Break the recipient list into individual addresses in
# order to create a proper envelope.
@recipients = split /,/, $to;
foreach $recipient (@recipients) {
     print S "RCPT TO: $recipient" . $CRLF;
     print "To: $recipient" . $CRLF;
     die "ERROR: $!" unless &expect("ok",500);
     print $mailcmd;
}

## PPR **--Start--** ##

@ccrecipients = split /,/, $cc;
foreach $ccrecipient (@ccrecipients) {
     print S "RCPT TO: $ccrecipient" . $CRLF;
     print "Cc : $ccrecipient" . $CRLF;
     die "ERROR: $!" unless &expect("ok",500);
     print $mailcmd;
}

@bccrecipients = split /,/, $bcc;
foreach $bccrecipient (@bccrecipients) {
     print S "RCPT TO: $bccrecipient" . $CRLF;
     die "ERROR: $!" unless &expect("ok",500);
     print $mailcmd;
}

## PPR **--Stop--** ##

print S "DATA" . $CRLF;
print "Sending message...";
die "ERROR: $!" unless &expect(354,50);
print $mailcmd;

print S "$message" . $CRLF;
#print "$message" . $CRLF;
print S "." . $CRLF;
#print "." . $CRLF;
die "ERROR: $!" unless &expect(250,500);
#print $mailcmd;

print S "QUIT" . $CRLF;
#print "QUIT" . $CRLF;
die "ERROR: $!" unless &expect(221,50);
#print $mailcmd;

# DBG
print "Finished\n\n";

# Clean up and exit
close(S);
exit;

## The subroutine section

sub usage {

    print <<ENDOFUSAGE;
        mail.pl [-u] [-f from] [-m mailhost] [-p port]
		[-s subject] [-c cc-addr] [-b bcc-addr] [-r replyto-addr]
		[-a attachment#1[:attachment#2...]] [-w] to_addresses
	-a		List of files to attach, colon seperated
	-b		List of blind carbon copy addresses
	-c		List of carbon copy addresses
	-f		Email sender's address (FROM:)
	-m		SMTP mailhost (name or IP address)
	-w		Do not wait on STDIN for message part
        -o              Override headers
	-p		Port to use when connecting to mailhost
	-r		Email reply-to address
	-s		Subject to use
	-g		Message to use
	-u		Shows this usage information
	to_addresses    Email recipients address (TO:) in a comma
                  seperated list

ENDOFUSAGE

  exit(0);

} # End sub usage

sub parseCmdLine {

     foreach $i (0...$#ARGV) {

    if ( $ARGV[$i] =~ /^\-(\w)$/ ) {

        $flag = $1;
        $_ = $flag;

      SWITCH: {

          /u/     and &usage, last SWITCH;
          /f/     and $from = $ARGV[$i+1], $last_processed += 2, last SWITCH;
          /r/     and $replyto = $ARGV[$i+1], $last_processed += 2, last SWITCH;
          /m/     and $mailhost = $ARGV[$i+1], $last_processed += 2, last SWITCH;
          /o/     and $headeroverride = 1, last SWITCH;
          /w/     and $no_stdin = 1, $last_processed++, last SWITCH;
          /p/     and $mailport = $ARGV[$i+1], $last_processed += 2, last SWITCH;
	  /a/     and $attachment_list = $ARGV[$i+1], $last_processed += 2, last SWITCH;
	  /s/	  and $subject = $ARGV[$i+1], $last_processed += 2, last SWITCH;
	  /c/     and $cc = $ARGV[$i+1], $last_processed += 2, last SWITCH;
	  /b/	  and $bcc = $ARGV[$i+1], $last_processed += 2, last SWITCH;
	  /g/	  and $file_msg = $ARGV[$i+1], $last_processed += 2, last SWITCH;

      } # end SWITCH
    } # end if/else
    } # end foreach

    # If attachments were found, put them into the attachments array
    if ($attachment_list) {
    	@attachments = split(/:/, $attachment_list);
    }

    # Any arguments left on the command line after the last 
    # switch processed should be To: addresses.
    foreach $i (($last_processed + 1)...$#ARGV) {
	if ($to) {
		$to .= ",";
	}
	# Provide some basic error checking.  Don't append anything
	# to the To: list unless it has an '@' sign in it.
	if ($ARGV[$i] =~ /\@/) {
		$to .= $ARGV[$i];
	}
    }

} # end sub parseCmdLine

sub setContentType {

      # Need to determine the type from filename

      # set a default content type in case nothing can be found
      $content_type = $DEFAULT_CONTENT_TYPE;

      # get the start of the filename extension
      if ( $_filename =~ /.*\.(\w{3,4})$/ ) {

    	# extract the extension
    	$extension = $1;

        # DBG
        #print "file extension: $extension\n";

        # try some common extensions

        if ($extension eq "gif") {

          # GIF
          $content_type = "image/gif";

        } elsif ($extension eq "jpg" || $extension eq "jpeg") {

          # JPEG
          $content_type = "image/jpeg";

        } elsif ($extension eq "txt") {

          # text
          $content_type = "text/plain";

        } elsif ($extension eq "htm" || $extension eq "html") {

          # HTML
          $content_type = "text/html";

        } elsif ($extension eq "mpg" || $extension eq "mpeg") {

          # MPEG
          $content_type = "video/mpeg";

        } # end if extension...

      } # end if start_extension...

} # end sub setContentType


sub createBoundaryMarker {

    # random number as integer
    $random_int = int(rand(1000)) * 98765;

    # create the marker
    $boundary="====PLUGGEDIN====" . $random_int . "====_";

    return $boundary;

} # end subcreateBoundaryMarker


sub createHeader {

    # the header to be created
    $the_header = "";

    # set a content type
    &setContentType;

    # is the content type text?
    if ($content_type =~ /^text/ ) {

      # yes, it's text

      # create header
      $the_header = "Content-Type: $content_type; charset=us-ascii; name=\"$_filename\"\n" .
               "Content-Transfer-Encoding: 7bit\n" .
               "Content-Disposition: inline; filename=\"$_filename\"\n\n";

    } else {

      # not text, therefore the content will be base64 encoded

      # create header
      $the_header="Content-Type: $content_type; name=\"$_filename\"\n" .
               "Content-Transfer-Encoding: base64\n" .
               "Content-Disposition: inline; filename=\"$_filename\"\n\n";

    }

    return $the_header;
}

sub printEncoded {

    # DHW:  Added the requirement for the incoming data to be passed as
    #       a parameter.  It is a String.
    $tmp_incoming_data = pop(@_);

    # DBG
    #print "The input to \&printEncoded was $tmp_incoming_data\n";

    # Turn the string input into an array of characters from processing.
    @decoded_attachment_data = split(//,$tmp_incoming_data);

    # DBG
    #print "The decoded_attachment_data array consists of:\n";
    #foreach $element (@decoded_attachment_data) {
        #print "$element\n";
    #}

    # encoded attachment size counter
    $encode_count = 0;

    # is there anything to encode?
    if (@decoded_attachment_data == 0) {

      # nothing to encode

      # DBG
      print "Nothing to encode!\n\n";

      return "null";

    }

    # Set the MIME content type for this attachment
    &setContentType;

    # DBG
    ##print "Content type is: $content_type\n";

    # create the MIME header
    $header = &createHeader;

    # initialise the encode string
    $encoded_attachment = $header;

    # DBG
    #print "After setting the header, \$encoded_attachment is: $encoded_attachment\n";

    # Is the content type text of some form?
    if ($content_type =~ /^text/i) {

      # the encoded attachment is plain text - no need to encode

      # DBG
      #print "The content type is text: no encoding needed!\n";

      $plain_text = "";
      foreach $element (@decoded_attachment_data) {
    	$plain_text .= $element;
      }

      # DBG
      print "plain_text length = " . length($plain_text) . "\n";
      #print "plain_text is: $plain_text\n";

      $encoded_attachment .= $plain_text;

    } else {

      # DBG
      #print "The content type is NOT text: encoding!\n";

      # create a suitable buffer - each 3 decoded bytes, becomes 4 encoded
      @buffer = ('');

      # DBG
     # print "printEncoded: d_a_d length: " . @decoded_attachment_data . "\n";

      # go through the attachment
      for ($i=0; $i < ( @decoded_attachment_data - 2 ); $i+=3) {

        # convert 3 bytes to 4 encoded characters
        $buffer[$encode_count++] = $encode_table[((vec($decoded_attachment_data[$i],0,8) & 0xFC) >> 2) ];
        $buffer[$encode_count++] = $encode_table[(((vec($decoded_attachment_data[$i],0,8) & 0x03) << 4) | ((vec($decoded_attachment_data[$i+1],0,8) & 0xF0) >> 4)) ];
        $buffer[$encode_count++] = $encode_table[(((vec($decoded_attachment_data[$i+1],0,8) & 0x0F) << 2) | ((vec($decoded_attachment_data[$i+2],0,8) & 0xC0) >>
 6)) ];
        $buffer[$encode_count++] = $encode_table[(vec($decoded_attachment_data[$i+2],0,8) & 0x3F) ];

      }

      # check to see if padding required
      if ( $i < @decoded_attachment_data ) {

        $i -= 3;

        # DBG
        #print "\$i = $i\n";
        #print "Padding is required.  At least one byte is left over.\n";

        # there's at least one byte left over
        $buffer[$encode_count++] = $encode_table[((vec($decoded_attachment_data[$i],0,8) & 0xFC) >> 2)];
        $buffer[$encode_count] = $encode_table[((vec($decoded_attachment_data[$i],0,8) & 0x03) << 4)];

        # move to the next char, if any
        $i++;

        # any more bytes left over?
        if ($i < @decoded_attachment_data ) {

          # yes, include it

          # DBG
          #print "There is a second byte left over.\n";

          # need to redo the current character
          $buffer[$encode_count++] = $encode_table[(((vec($decoded_attachment_data[$i-1],0,8) & 0x03) << 4) | ((vec($decoded_attachment_data[$i],0,8) & 0xF0) >>
 4))];

          $buffer[$encode_count++] = $encode_table[((vec($decoded_attachment_data[$i],0,8) & 0x0F) << 2)];

        } else {

          # need a pad character
          $buffer[$encode_count++] = $padchar;

      # DBG
      #print "Added a pad character\n";

        }

        # need at least one pad character
        $buffer[$encode_count++] = $padchar;

    # DBG
    #print "Added a pad character\n";

      }

      # convert to string - put a new line every LINESIZE chars
      $buffer_string = "";
      foreach $element (@buffer) {
    	$buffer_string .= $element;
      }
      for ($i=0; $i<= ($encode_count-$LINESIZE) ; $i+=$LINESIZE) {

        # DBG
        #print "Entered the line-wrapping for loop. i=$i\n";

        # convert LINESIZE bytes to string
        $tmp_string = substr($buffer_string,$i,$LINESIZE);
        # add this string to the encoded string, plus a newline
        $encoded_attachment .= $tmp_string . "\n";

        # DBG
        #print "tmp_string: $tmp_string\n";
        #print "encoded_attachment: $encoded_attachment\n\n";

      }

      # do any leftover chars
      if ($i != $encode_count) {

        # convert the remaining bytes to string
        $tmp_string = substr($buffer_string,$i,$encode_count - $i);

        # add this string to the encoded string, plus a newline
        $encoded_attachment .= $tmp_string . "\n";

      }

    }

    # DBG
    #print "The buffer holds: $buffer_string\n";

    # set flag to indicate attachment has been encoded
    $_attachment_encoded = 1;

    # DBG
    #print "TEMP:  \$encoded_attachment = $encoded_attachment\n\n";

    # attachment is appropriately encoded by now
    return $encoded_attachment;

} # sub printEncoded

sub expect {
  my($ok);
  my($mailtest) = shift;
  my($error_test) = shift;

  # DBG
  #print "test: $mailtest\n";
  #print "error_test: $error_test\n";

  $mailcmd = "";
  while (<S>) {
    $mailcmd .= $_;
    if (/$mailtest/i) {
        $ok = 1;
        last;
    }
    if (/$error_test/i) {
        $ok = 0;
        last;
    }
  }
  return $ok;
}