#!/usr/bin/perl -w
# Send an email via SMTP. (Perl Template for Lab 4)
#
# XXX The symbol XXX flags things that need fixing or removing.
#
# XXX (CST8165 Lab 4 template - to be completed by the student.)
# XXX other documentation still to be added; see lab04.txt
#
# XXX this will be the full calling sequence when finished:
#
#   $0 -to user@domain.com  -from sender@domain.com \
#          -smtpserver mail.domain.com  -port 25
#
# XXX Right now (under development) it uses:  $0 [ hostname [ port ] ]

# XXX Comments labelled "Perl:" are teacher comments explaining to
# XXX students of the language how Perl works.  They would never appear
# XXX as comments in a production Perl program, since they have nothing to
# XXX do with how the program works.  Don't write comments like these in
# XXX your submitted Perl programs (unless you are a teacher).

# XXX This program needs proper argument checking and handling added.
# XXX Right now (under development) it uses:  $0 [ hostname [ port ] ]
# XXX When finished, the script will use the proper calling sequence
# XXX and will validate each argument properly before using it.

# Perl: Always use "perl -w" and "use strict" in your Perl programs!
#
use strict;
use Net::Telnet();

$| = 1;  # all output will be flushed (not buffered)

# Perl: You can fetch any environment variable inside Perl
# Perl: You have to escape the \@ if not expanding an array variable
#
print "Hello $ENV{USER} !  Is your email $ENV{USER}\@gmail.com ?\n";

# Some constants (set these small for debugging and testing):
#
my $SMTP_OPEN_TIMEOUT = 10; # seconds to wait for connection to SMTP server
my $SMTP_LINE_TIMEOUT = 10; # seconds to wait for each SMTP response

# Perl: Some people prefer to declare variables when first used.
# Perl: Do it one way or the other.
#
my $conn;   # the single Net::Telnet connection handle
my $ret;    # for testing return values of various things
my @lines;  # array of lines returned by SMTP server
my $code;   # first three characters on line returned by SMTP server
my $want;   # what SMTP response code we are expecting to receive

# Parse the command line and get to, from, smtpserver, and port.
# Print a Usage message if the parsing fails.
# Validate the syntax of each argument.
# XXX to do ...
# Perl: The command line arguments are in array @ARGV.
# Perl: You can find the number of elements in an array using $#ARGV
# Perl:  or even @ARGV in a scalar (not array) context, e.g. $x = @ARGV;.

############################################################################
# Create a new connection; turn off TELNET-specific mode.
#
$conn = new Net::Telnet( Telnetmode => 0 );
$ret = $conn->open(
        Host => $ARGV[0] || 'localhost', # XXX default host name if none given
        Port => $ARGV[1] || 25,          # XXX default port if none given
        Errmode => 'return',      # don't kill program on error; return undef
        Timeout => $SMTP_OPEN_TIMEOUT # timeout waiting for open to complete
    );
unless( $ret ){
    # Perl: "warn" and "die" both print on standard error.
    # Perl: Both print line numbers unless the string ends in a newline.
    # Perl: We could replace warn()+exit() with just die(), below.
    # Perl: The function call has to be outside the string to work.
    # Perl: (Perl variables expand in strings; function calls do not.)
    warn "$0: open error: ", $conn->errmsg(), "\n";
    # XXX Should return only the values/reasons defined in <sysexits.h>
    exit(1);
}

############################################################################
# Step 1 - Receive the SMTP greeting.
#   Ref: RFC2821 Section 4.3.2
#
# In SMTP, the server issues the first line, not the client.
# So we, as client, do a read first:
#
($code,@lines) = &MyGetline($conn);
print "DEBUG first response is:\n", join("\n",@lines), "\n";

# XXX this repeated code should probably be a function
# must use "ne" in case $code is not numeric
#
$want = 220;
if ( $code ne $want ){
    # Perl: Here are two ways to write exactly the same thing, one with
    # Perl:  variables inside the quotes and one with them outside:
    # XXX Should return only the values/reasons defined in <sysexits.h>
    die "Got '$code': Did not get $want response from server: $lines[0]\n";
    # die "Got '", $code, "': Did not get ", $want,
    #   " response from server: ", $lines[0], "\n";
}
# XXX We should be more flexible in accepting "ok" responses from the server

# Perl: Showing more of Perl's features:
# Perl: Do a case-insensitive regexp match to see if ESMTP is present.
# Perl: Use parentheses in the regexp to capture the rest of the line
# Perl:  into variable $1 for output in the line below.
# Perl: Multiple pairs of parentheses can capture into $1, $2, $3, etc.
#
if ( $lines[0] =~ / ESMTP (.*)/i ) {
    print "DEBUG this server is an Extended SMTP server: $1.\n";
}

############################################################################
# Step 2 - Ask for an extended SMTP session with EHLO
#
$conn->print("EHLO algonquincollege.com");

# Get the server's response to EHLO
#
($code,@lines) = &MyGetline($conn);
print "DEBUG second response is:\n", join("\n",@lines), "\n";

# XXX this repeated code should probably be a function
# must use "ne" in case $code is not numeric
#
$want = 250;
if ( $code ne $want ){
    # XXX Should return only the values/reasons defined in <sysexits.h>
    die "Got '$code': Did not get $want response from server: $lines[0]\n";
}
# XXX We should be more flexible in accepting "ok" responses from the server

# Perl: Showing more of Perl's features:
# Perl: The expression 1..$#lines generates a new array with the first
# Perl:  element missing (the first 250 response line is not an SMTP option).
# Perl: The split() returns an array; we limit the split to two fields
# Perl:  and assign those two fields to another two-field array
# Perl:  and throw away the first field, saving only the second.
#
# The 250 response lines should have all the EHLO SMTP options.
# Show just the SMTP options coming back in response to EHLO.
#
for my $line ( @lines[1..$#lines] ) {
    my (undef,$option) = split(/[- ]+/,$line,2);  # split on blanks or dash
    print "DEBUG SMTP Option: '$option'\n";
    # Perl: do a case-insensitive regexp match to find the SIZE option
    if ( $option =~ /^SIZE /i ){
        my (undef,$size) = split(/ +/,$option,2); # split option on blanks
        print "DEBUG max message size is '$size'\n";
    }
}

############################################################################
# Step 3 and more - 
# XXX more code to be added here, to send a message...

############################################################################
# Last Step - clean up and exit.
#
# That's all for now.  Quit the SMTP connection, close it, and exit.
#
$conn->print("QUIT");

# Any response will do after a QUIT!
#
($code,@lines) = &MyGetline($conn);
print "DEBUG last response is:\n", join("\n",@lines), "\n";

$conn->close();

#-----------------------------------------------------------------------------

# sub MyGetline ( $connection ):
# This function gets all of the lines of a continued SMTP server response.
# The first and only arg is the open Net::Telnet connection.
# Received lines are saved in an array with the trailing \n removed.
# The leading 3-character SMTP code and the whole array are returned.
# Note that we return the first three characters, even if they aren't
# numeric; so, you have to check for valid codes in the caller.
# If the connection dies or times out while we are collecting, we die too.
# XXX Should return only the values/reasons defined in <sysexits.h>
#
# Perl: The Net::Telnet module converts between LF and CR+LF on I/O
# Perl:  so we don't have to worry about it.
#
sub MyGetline {
    my $conn = shift;      # first arg is open Net::Telnet connection
    my $MIN_LENGTH = 3;    # min length from SMTP server is 3-digit code
    my @getline;           # array of lines collected from SMTP server

    # Loop, reading lines from the SMTP connection.
    # Append each line read to the end of the @getline array.
    # Keep getting lines as long as we see SMTP continuation markers.
    # Exit the looping when there is no more continuation marker.
    #
    @getline = ();  # array starts empty; each line is appended in the loop
    for(;;){
        # print "DEBUG start of loop\n";

        # The Timeout here says how long to wait for the line to be read:
	# Make sure we set Errmode to return instead of killing us!
        my $tmpline = $conn->getline(
                Errmode => 'return', # don't kill program on error; return undef
                Timeout => $SMTP_LINE_TIMEOUT
            );  
	# XXX Should return only the values/reasons defined in <sysexits.h>
        die "$0: Server connection broken or time out: ", $conn->errmsg()
            unless $tmpline;
        # remove any trailing newline from the line before doing length
        chomp $tmpline;
        die "$0: Server line '$tmpline' shorter than $MIN_LENGTH\n"
            if length($tmpline) < $MIN_LENGTH;
        # print "DEBUG line is '$tmpline'\n";

        # append this line to the array of lines being collected
        push(@getline,$tmpline);

        # A line shorter than four characters cannot be a continuation line;
        # but, we have to accept it anyway.  (See RFC2821 section 4.2.)
        # Extract the fourth character, if any - the SMTP continuation char
        #
        my $cont = (length($tmpline)>=4) ? substr($tmpline,3,1) : ' ';
        # print "DEBUG cont is '$cont'\n";
        last if $cont ne '-';   # exit loop if no longer continuing

        # print "DEBUG bottom of loop\n";
    }
    # We have collected all the lines, including any continuation
    # lines.  Collected lines have had the newlines removed by chomp().
 
    # Extract just the leading 3-digit SMTP code from the start of the
    # first line; return the code and the whole array of lines collected.
    # Note: We don't assume that the code is all-digits!
    #
    my $code = substr($getline[0],0,3);
    return ($code,@getline);
}