#!/usr/bin/perl
# ----------------------------------------------------------------------------
# This software is Copyright (C) 2007, All Rights Reserved
# ----------------------------------------------------------------------------
# This program is protected by local and international copyright laws. Any
# use of this program is subject to the the terms of the license agreement
# included as part of this distribution archive. Any other uses are strictly
# prohibited without the written permission of the Vendor and all
# other rights are reserved.
# -----------------------------------------------------------------------------
# Warning : Modifying this program violates your license agreement!
# -----------------------------------------------------------------------------

package IT::Email;

use strict;

use IT::Globals;
use Socket;

# user defined globals (set by Init call)
use vars qw(@REQUIRED_USER_DEFINED_GLOBALS $SEND_MAIL_WITH $SENDMAIL_PATH $SMTP_HOST $SMTP_PORT $SMTP_HELO);
use vars qw($SMTP_TIMEOUT_SECONDS $POP3_LOGIN_BEFORE_SMTP $POP3_HOST $POP3_PORT $POP3_USERNAME $POP3_PASSWORD);
@REQUIRED_USER_DEFINED_GLOBALS = qw(SEND_MAIL_WITH SENDMAIL_PATH SMTP_HOST
                                       POP3_LOGIN_BEFORE_SMTP POP3_HOST POP3_USERNAME POP3_PASSWORD);
$SEND_MAIL_WITH         = '';
$SENDMAIL_PATH          = '';
$SMTP_HOST              = '';
$SMTP_PORT              = 25;
$SMTP_HELO              = 'localhost';
$SMTP_TIMEOUT_SECONDS   = 30;
$POP3_LOGIN_BEFORE_SMTP = '';
$POP3_HOST              = '';
$POP3_PORT              = 110;
$POP3_USERNAME          = '';
$POP3_PASSWORD          = '';


# library globals
use vars qw($INIT_CALLED $DEBUG $POP3_LOGIN_COMPLETED);
$INIT_CALLED             = 0;           # indicated whether init() has been called or not
$DEBUG                = 0;
$POP3_LOGIN_COMPLETED    = 0;



# ----------------------------------------------------------------------------
# Function    : init
# Description : define filepaths and globals required by library
# Usage       : &init({
#                 'ARGUMENT' => "$value",
#               });
#
# Note: Don't call any functions that call &_die_unless_init_called()
#       from this function because then we'll get a confusing error about the init
#       function not being called instead of the actual error.
# ----------------------------------------------------------------------------

sub init {
  my $args = shift;
  if (!$args)                     { die("no arguments specified!"); }
  if (ref $args ne 'HASH')        { die("args must be passed by hash ref!"); }

  # error checking
  my($thisSubroutine) = (caller(0))[3];
  foreach (@REQUIRED_USER_DEFINED_GLOBALS) {
    unless (exists $args->{$_}) { &IT::Error::dieAsCaller("required $thisSubroutine argument '$_' not defined"); }
  }

  # set user defined globals
  $SEND_MAIL_WITH         = $args->{'SEND_MAIL_WITH'};
  $SENDMAIL_PATH          = $args->{'SENDMAIL_PATH'};
  $SMTP_HOST              = $args->{'SMTP_HOST'};
  $SMTP_PORT              ||= $args->{'SMTP_PORT'};
  $SMTP_HELO              ||= $args->{'SMTP_HELO'};
  $SMTP_TIMEOUT_SECONDS   ||= $args->{'SMTP_TIMEOUT_SECONDS'};
  $POP3_LOGIN_BEFORE_SMTP = $args->{'POP3_LOGIN_BEFORE_SMTP'};
  $POP3_HOST              = $args->{'POP3_HOST'};
  $POP3_PORT              ||= $args->{'POP3_PORT'};
  $POP3_USERNAME          = $args->{'POP3_USERNAME'};
  $POP3_PASSWORD          = $args->{'POP3_PASSWORD'};
  $DEBUG                  = $args->{'DEBUG'} if exists $args->{'DEBUG'};

  # check for HOSTNAME:PORT
  if ($SMTP_HOST =~ s/:(\d+)$//) { $SMTP_PORT = $1; }
  if ($POP3_HOST =~ s/:(\d+)$//) { $POP3_PORT = $1; }

  # error checking
  &IT::Error::dieOnValidationErrors(
    ["\$SEND_MAIL_WITH",         $SEND_MAIL_WITH,         "oneOf(SMTP, SENDMAIL)"],
  );

  if ($SEND_MAIL_WITH eq 'SENDMAIL') {
    &IT::Error::dieOnValidationErrors(
      ["\$SENDMAIL_PATH",          $SENDMAIL_PATH,          "allowBlank fileMustExist"],
    );
  }

  if ($SEND_MAIL_WITH eq 'SMTP') {
    &IT::Error::dieOnValidationErrors(
      ["\$SMTP_HOST",              $SMTP_HOST,              "allowBlank validHostnameOrIP"],
      ["\$SMTP_PORT",              $SMTP_PORT,              "positiveInt"],
      ["\$SMTP_HELO",              $SMTP_HELO,              "notBlank"],
      ["\$SMTP_TIMEOUT_SECONDS",   $SMTP_TIMEOUT_SECONDS,   "positiveInt"],
      ["\$POP3_LOGIN_BEFORE_SMTP", $POP3_LOGIN_BEFORE_SMTP, "allowBlank oneOf(0,1)"],
      ["\$POP3_HOST",              $POP3_HOST,              "allowBlank validHostnameOrIP"],
      ["\$POP3_PORT",              $POP3_PORT,              "positiveInt"],
      ["\$POP3_USERNAME",          $POP3_USERNAME,          "notRef"],
      ["\$POP3_PASSWORD",          $POP3_PASSWORD,          "notRef"],
    );
  }



  # set sub globals
  $INIT_CALLED = 1;

}

# ----------------------------------------------------------------------------
# Function    : _die_unless_init_called()
# Description : Dies unless &init() has been called.  This is called
#               first by many public function to make sure the init function
#               for the module has been called.
# Usage       : &_die_unless_init_called();
# ----------------------------------------------------------------------------

sub _die_unless_init_called {
  if ($INIT_CALLED) { return; }

  my($thisPackage) = (caller(0))[0];
  my($subroutine) = (caller(1))[3];
  &IT::Error::dieAsCaller("You must call &${thisPackage}::init() before calling $subroutine",2);

}

# ----------------------------------------------------------------------------
# Function    : sendMessage
# Description : send a message with specified mailer.  dies on errors.
#
# Usage       : &IT::Email::sendMessage($messageWithHeaders);
# Arguments   : $messageWithHeaders (see below)
#               Subject: $subject
#               From: $fromName <$fromEmail>
#               To: $toEmail
#
#               Test Message
# ----------------------------------------------------------------------------

sub sendMessage {
  &_die_unless_init_called();
  my $message = shift;

  if ($SEND_MAIL_WITH eq 'SMTP') {
    eval { &_SMTP_sendmail($message) };
    if ($@) { die("Error sending message: $@"); }
  }

  elsif ($SEND_MAIL_WITH eq 'SENDMAIL') {
    my($fromEmail) = &_parseMessageHeader($message);

    my $fh = &IT::File::createFilehandle();
    open($fh,"|$SENDMAIL_PATH -oi -f $fromEmail -t") || die "Can't open $SENDMAIL_PATH : $!";
    print $fh $message;
    close($fh);
  }

  else {
    die("unknown mail send method '$SEND_MAIL_WITH'!\n");
  }

  return 0;
}

# ---------------------------------------------------------------------------------
# Function    : _parseMessageHeader
# Description : parse email header for from and recipient emails (to, cc, bcc).
#
#               This function just extracts strings that look like emails from the
#               (from, to, cc, bcc) lines in the message header.
#
# Usage       : ($fromEmail,@recipientEmails) = &_parseMessageHeader($messageWithHeaders);
# ---------------------------------------------------------------------------------

sub _parseMessageHeader {
  my $messageWithHeaders = shift;                                            # message content

  # split message into header and body
  $messageWithHeaders =~ tr/\r//d;
  my($header,$body)   = split(/\n\n/, $messageWithHeaders, 2);
  unless ($header && defined $body) { die("Can't parse email header!\n"); }

  # parse out fromEmail and recipient emails
  my($fromEmail, @recipients);
  my @headerLines = split(/\n/, $header);
  foreach my $line (@headerLines) {
    unless ($line =~ /^\s*(From|To|CC|BCC)\s*:/i) { next; }
    my $headerName = $1;

    my @matchedEmails;
    while ($line =~ m/($IT::Validation::VALID_EMAIL_REGEXP)/g) {
      push @matchedEmails, $1;
    }

    if ($headerName =~ /From/) {
      if (@matchedEmails > 1) { die "Multiple emails matched on From: line of message!"; }
      $fromEmail = $matchedEmails[0];
    }
    else {  # To, CC, and BCC emails are all recipients
      push @recipients, @matchedEmails;
    }
  }

  # error checking
  unless ($fromEmail)  { die "couldn't find From: address in mail header\n"; }
  unless (@recipients) { die "couldn't find recipient addresses (To, CC, or BCC) in mail header\n"; }


  return($fromEmail, @recipients);
}

# ---------------------------------------------------------------------------------
# Function    : _connect
# Description : connect to a TCP server and prepare socket. dies on errors
# Usage       : my $socket = &_connect($hostOrIP, $port);
# ---------------------------------------------------------------------------------

sub _connect {
  my $hostOrIP = shift || &IT::Error::dieAsCaller("no hostname specified!");
  my $port     = shift || &IT::Error::dieAsCaller("no port specified!");

  # get socket
  my $socket   = &IT::File::createFilehandle();
  my $protocol = getprotobyname('tcp') || 0;
  socket($socket, PF_INET, SOCK_STREAM, $protocol) || die "No socket! $!\n";

  # connect to server
  my $absoluteHost = &IT::Common::getCompleteDomainWithTrailingDotOrIP($hostOrIP);
  my $fourByteIP   = inet_aton($absoluteHost) || die "Unknown host '$hostOrIP'!\n";
  my $sockaddr_in  = pack_sockaddr_in($port, $fourByteIP) || die $!;
  my $ipString     = join '.', unpack('C4', $fourByteIP);

  unless (connect($socket, $sockaddr_in)) {
    if ($! eq "Unknown error") { die "Could not connect to $hostOrIP. Server does not exist or is not responding on port $port.\n"; } # windows returns "Unknown Error" on failed connects
    else                       { die "Could not connect to $hostOrIP. Connect failed: $!\n"; }
  }

  # unbuffer socket
  my $oldFH = select($socket);
  $|=1;
  select($oldFH);

  # set binary mode
  binmode($socket);                                # binary mode for socket

  # return socket
  return $socket;
}

# ---------------------------------------------------------------------------------
# Function    : SMTP_sendmail
# Description : send a email message via a smtp server (RFC 821 compliant).  dies
#               on errors
#
# Usage       : &_SMTP_sendmail($messageWithHeaders);
#               - $message should include all headers (to, from, CC, BCC)
# ---------------------------------------------------------------------------------

sub _SMTP_sendmail {
  &_die_unless_init_called();
  my $messageWithHeaders = shift;

  my $timeoutTime                    = time() + $SMTP_TIMEOUT_SECONDS;
  my($fromNameAndEmail, @recipients) = &_parseMessageHeader($messageWithHeaders);
  $messageWithHeaders                =~ s/^\s*BCC\s*:.*\n//mgi;  # Remove BCC lines so they don't appear in outgoing message

  # Authenticate via POP3
  if ($POP3_LOGIN_BEFORE_SMTP && !$POP3_LOGIN_COMPLETED) {
    &_SMTP_pop3auth();
  }

  ### Connect to SMTP server
  my $socket = &_connect($SMTP_HOST, $SMTP_PORT);

  my $response;

  # Wait for SMTP welcome Banner (Valid response codes: 220)
  $response = &_SMTP_readline($socket, $timeoutTime);
  if ($response !~ /^220/) { die "An unknown error occured.  Server response: $response\n"; }

  # Introduce ourselves (Valid response codes: 250)
  &_SOCK_writeline($socket, "HELO $SMTP_HELO");
  $response = &_SMTP_readline($socket, $timeoutTime);
  if ($response !~ /^250/) { die "An unknown error occured.  Server response: $response\n"; }

  # Send mail from: (Valid response codes: 250)
  &_SOCK_writeline($socket, "MAIL FROM:<$fromNameAndEmail>");
  $response = &_SMTP_readline($socket, $timeoutTime);
  if ($response !~ /^250/) { die "An unknown error occured.  Server response: $response\n"; }

  # Send rcpt to: (Valid response codes: 250, 251)
  foreach my $recipient (@recipients) {
    &_SOCK_writeline($socket, "RCPT TO:<$recipient>");
    $response = &_SMTP_readline($socket, $timeoutTime);
    if ($response =~ /^55/) { die "The server ($SMTP_HOST) won't accept mail for '$recipient'.  Server response: $response\n"; }
    if ($response !~ /^25/) { die "An unknown error occured.  Server response: $response\n";; }
  }

  # initiate data stream (Valid response codes: 354)
  &_SOCK_writeline($socket, "DATA");
  $response = &_SMTP_readline($socket, $timeoutTime);
  if ($response !~ /^354/) { die "An unknown error occured.  Server response: $response\n"; }

  # send message content
  # Note: Message headers/content has NOTHING to do with who a message is sent from or to.
  #       It's simply a block of content that often happens to contain that information.
  $messageWithHeaders =~ s/^\./\.\./gm;          # escape "end of data" char (see RFC)
  &_SOCK_writeline($socket, $messageWithHeaders);

  # close data stream (Valid response codes: 250)
  &_SOCK_writeline($socket, ".");
  $response = &_SMTP_readline($socket, $timeoutTime);
  if ($response !~ /^250/) { die "An unknown error occured.  Server response: $response\n"; }

  # logoff SMTP server and disconnect (Valid response codes: 221)
  &_SOCK_writeline($socket, "QUIT");
  close($socket);                               # don't wait for response, close connection

}

# ---------------------------------------------------------------------------------
# Function    : SMTP_readline (called from SMTP_sendmail)
# Description : Return response from SMTP server
#
# Usage       : $line = &_SMTP_readline(\*FH,$timeout);
# ---------------------------------------------------------------------------------

sub _SMTP_readline {

  my $FH = $_[0];                                       # FILEHANDLE to check
  my $timeout = int($_[1]);                             # smtp timeout in seconds or time() format (default 5 seconds per readline)

  # Error checking
  if (!$timeout)        { die("SMTP_readline: no timeout value specified!\n"); }
  if ($timeout < 10**8) { die("SMTP_readline: timeout value must be in time() format! (received: $timeout)\n"); }
  fileno($FH) || die("SMTP_readline: invalid filehandle or filehandle not open!\n");

  # Read response from SMTP server
  my($line,$data);
  while (!$line || substr($line,3,1) eq '-') {
    $line = &_SOCK_readline($FH,$timeout);
    $data .= $line;
  }

  return $data;
}

# ---------------------------------------------------------------------------------
# Function    : SMTP_pop3auth (called from SMTP_sendmail)
# Description : authenticate via pop3 server before SMTP (RFC 1939 compliant)
#
# Usage       : &_SMTP_pop3auth();
# ---------------------------------------------------------------------------------

sub _SMTP_pop3auth {
  if ($POP3_LOGIN_COMPLETED) { return 1; }

  my $timeoutTime = time() + $SMTP_TIMEOUT_SECONDS;


  ### Connect to POP3 server
  my $socket = &_connect($POP3_HOST, $POP3_PORT);

  my $response;

  # Wait for POP3 welcome Banner (Valid response codes: 220)
  $response = &_SOCK_readline($socket, $timeoutTime);
  if ($response !~ /^\+OK/i) { die "An unknown error occured.  Server response: $response\n"; }

  # Send username
  &_SOCK_writeline($socket, "USER $POP3_USERNAME");
  $response = &_SOCK_readline($socket, $timeoutTime);
  if ($response !~ /^\+OK/i) { die "The server didn't accept the login info for '$POP3_USERNAME'.  Server response: $response\n"; }

  # Send password
  &_SOCK_writeline($socket, "PASS $POP3_PASSWORD");
  $response = &_SOCK_readline($socket, $timeoutTime);
  if ($response !~ /^\+OK/i) { die "The server didn't accept the login info for '$POP3_USERNAME'.  Server response: $response\n"; }

  # Logoff POP3 server and disconnect
  &_SOCK_writeline($socket, "QUIT");
  close($socket);                                                  # don't wait for response, close connection

  $POP3_LOGIN_COMPLETED = 1;
}


# ---------------------------------------------------------------------------------
# Function    : SOCK_can_read
# Description : Check if filehandle has data waiting on it and is ready to be read (for sockets).
#               Don't use blocking reads (read or $line = <$fh>)
#               use sysread() or recv() instead.
#
#               Warning: this sub will return true on closed filehandles.
#
# Usage       : &_SOCK_can_read(\*FH,$timeout);     # returns true or false
#
#               while(1) {                                    # wait up to N seconds for data
#                 &_SOCK_can_read($socket,5) || die("timed out..");
#                 $socket->recv($buf,8*1024);                 # read in up to 10k at a time
#                 $responce .= $buf || last;                  # last if no content read (connection closed)
#                 }
# ---------------------------------------------------------------------------------

sub _SOCK_can_read {

  my $FH = $_[0];                                       # FILEHANDLE to check
  my $timeout = $_[1] || '0';                           # timeout (in secs, 0 to poll)
  my($rin,$rout,$win,$wout,$ein,$eout,$nfound);

  fileno($FH) || die("SOCK_can_read: invalid filehandle or filehandle not open!\n");

  vec($rin, fileno($FH), 1) = 1;                        # mark FH in $rin
  $nfound = select($rout=$rin, undef, undef, $timeout);
  return vec($rout, fileno($FH),1);

}

# ---------------------------------------------------------------------------------
# Function    : SOCK_readline
# Description : Return one line of data from socket, terminated by a \n char
#
# Usage       : $line = &_SOCK_readline(\*FH,$timeout);
# ---------------------------------------------------------------------------------

sub _SOCK_readline {
  my $socket  = shift;
  my $timeout = int shift;  # timeout in sec or time() (default 5 seconds per readline)

  # Error checking
  if (!$timeout)        { die("SOCK_readline: no timeout value specified!\n"); }
  if ($timeout < 10**8) { die("SOCK_readline: timeout value must be in time() format!\n"); }
  fileno($socket) || die("SOCK_readline: invalid filehandle or filehandle not open!\n");

  # Read line from server
  my($line,$char);
  while($timeout >= time()) {                           # wait up to N seconds for data
    &_SOCK_can_read($socket, 0.10) || next;              # check if data is waiting for us
    sysread($socket, $char, 1)  || last;                # returns bytes read (if data waiting, but 0 bytes read, we're at EOF)
    $line .= $char;                                     # add char to line
    if ($char eq "\x0A") { last; }                      # stop when we reach a \n
  }

  # if no data received we timed out
  if (not defined $line) { die "Timed out waiting for server to respond!"; }

  # debugging
  if ($DEBUG) { &_debug($line); }
  return $line;

}

# ---------------------------------------------------------------------------------
# Function    : SOCK_writeline
# Description : write message to socket.  Adds CRLF automatically
# Usage       : &_SOCK_writeline($socket, $message);
# ---------------------------------------------------------------------------------

sub _SOCK_writeline {
  my $socket = shift;
  my $message = shift;

  $message .= $CRLF unless ($message =~ /$CRLF$/);
  print $socket $message;

  # debugging
  if ($DEBUG) { &_debug($message); }

}

# ---------------------------------------------------------------------------------
# Function    : _debug (called from SMTP_sendmail)
# Description : print a SMTP debug message
#
# Usage       : &_debug($message);
# ---------------------------------------------------------------------------------

sub _debug {
  my $msg = join '', @_;
  $msg =~ s/\s+$//m;            # remove spacing off end of line
  my $date = gmtime();

  if (!$msg) { $date = ""; $msg = "\n"; }
#  if ($msg =~ /^From:/i) { $msg = "[email content]"; }          # don't show email content
#  if ($msg =~ /^PASS /i) { $msg = "PASS (not shown)"; }         # don't show pop3 passwords

#  open(LOG,">>smtp.log") || die $!;
#  print LOG "$date (GMT) $msg\n";
#  print STDOUT "$msg\n";
#  close(LOG);

  $msg =~ s/</&lt;/g;
  $msg =~ s/>/&gt;/g;
  $msg =~ s/\r\n|\n/<br>\n/g;

#  print "<p>$msg<br>\n\n";
  print &IT::Common::contentType("text/html");
  print "$msg<br/>\n";

}

# ----------------------------------------------------------------------------
# end of file
1;

