#!/usr/bin/env perl
#
# Copyright (c) 2007-2010 Illumina, Inc.
#
# This software is covered by the "Illumina Genome Analyzer Software
# License Agreement" and the "Illumina Source Code License Agreement",
# and certain third party copyright/licenses, and any user of this
# source file is bound by the terms therein (see accompanying files
# Illumina_Genome_Analyzer_Software_License_Agreement.pdf and
# Illumina_Source_Code_License_Agreement.pdf and third party
# copyright/license notices).
#
# This file is part of the Consensus Assessment of Sequence And VAriation
# (CASAVA) software package.
#
# functions scavenged from AJ Cox script RunReport.pl, some
# refactoring may be needed down the line


use warnings;
use strict;
use File::Basename;
use File::Spec;
use IO::Socket;



my @message;
my @transcript;

my @s;

my $serverName=shift(@ARGV);
my $domainName=shift(@ARGV);
my $serverPort=25; # usual port for SMTP service
my $maxServerWait=20; # wait this long for a connection, then die

my $socket;

@s=split(':',$serverName);
($serverName,$serverPort)=@s if (@s==2);

my $host=`uname -n`;
$host=~s/[\n\r]$//;
$host=$ENV{HOSTNAME} unless (defined($host));
$host="unknown_host" unless (defined($host));


sub sendLine
{
    my ($lineRef)=@_;
    # The "\r\n" is vital when talking to Windows SMTP servers
    # It may be the case that Linux/UNIX SMTP servers need "\n" only
    print $socket $lineRef. "\r\n";
    push @transcript, "> $lineRef\n";
} # sendLine

sub getResponse
{
    my $answer=<$socket>;
    push @transcript, "< $answer";
    #  All error codes are in range 500-599
    if ($answer=~/^5[0-9][0-9]/)
    {
        print STDERR "$_" foreach (@transcript);
        warn "Error in SMTP protocol, report not sent";
        exit (0);
   } # if
} # getResponse


sub sendMessage
{
   

    my $answer;
    unless ($socket=IO::Socket::INET->new
            ( PeerAddr => $serverName,
              PeerPort => $serverPort,
              Proto => 'tcp',
              Type  => SOCK_STREAM,
              Timeout => $maxServerWait))
    {
        warn "Could not connect to $serverName:$serverPort - $!";
        exit (0);
    } # OR

    # Some servers demand a domain name here. Those that don't don't seem
    # to mind if one is there.
    sendLine("helo ${domainName}");

    getResponse();

    # Our servers demand that domainName is our domain name. Others might
    # be less fussy.
    sendLine ("mail from: <${host}\@${domainName}>");

    getResponse();

    # Our main email server only allows email to be sent to addresses within
    # our domain name
    foreach (@ARGV)
    {
        my @emails = split / /, ${_};
	foreach (@emails)
	{
		sendLine("rcpt to: <${_}>");
        	getResponse();
        	unshift @message, "To: <${_}>";
	}
    } # foreach

    sendLine('data');

    getResponse();


    foreach (@message)
    {
        sendLine($_);
    } # foreach

    sendLine ('.');

    getResponse();

    sendLine ('quit');

    getResponse();

    print "SMTP protocol completed, transcript follows:\n";
    foreach (@transcript)
    {
        print "$_";
    } # for
} # sub sendMessage




push @message, pop @ARGV;
my $subject = "Subject: " . pop @ARGV;
unshift @message, $subject;
sendMessage();