use IO::Socket;
use Time::localtime;

sub lc_hachage {
    my %hachage = @_;
    my ($cle,%new_hachage) ;
    for (sort keys %hachage) {
        $new_hachage{lc($_)}=$hachage{$_};
    }
    return %new_hachage;
}

sub verification_structure {
    # be carreful STATUT_VERIFICATION,COMMENTAIRE_VERIFICATION is rese
+rved by system
    # The MOTHER structure is in UPPER_CASE 
    # The Structure to be Verif mus be in Lower CASE
    #
    # erreur : 0 => No error
    #       1 => Be Carreful (Substitution)
    #       2 => Error (STOP)
     #
    my $erreur = 0 ;
    my $comment = "LOOK Structure \n";
    my (%structure) = @_ ;
    my $cle ;
    for $cle (sort keys %structure) {
        #We works in UPPER_CASE KEY
        if (!($cle =~ /[a-z]/)) { 
            if (!exists ($structure{lc($cle)}) or $structure{lc($cle)}
+ eq '') {
                if (uc($structure{$cle}[0]) eq 'FACULTATIF') {
                    # erreur will take 1 -> Information of substitutio
+n
                    if ($erreur == 0) { $erreur = 1 };
                    $structure{lc($cle)}=$structure{$cle}[1];
                    $commentaire .= $structure{$cle}[2]."\n";
                } 
                else {
                    #Erreu will take 2 -> A Mistake
                    $erreur =2 ;
                    $commentaire .= $structure{$cle}[2]."\n";
                }
            } else {
                #Structure correcte 
                $commentaire .= "variable $cle correcte\n";    
            }
            
        }
    }
    #delete the keys in UPPER CASE
    for $cle (sort keys %structure) {
        #on travail sur les clé en MAJUSCULE
        if (!($cle =~ /[a-z]/)) { 
            delete ($structure{$cle});
        }
    }
        
    #WRITING THE RESULT IN THE VARIABLE
    $structure{'STATUT_VERIFICATION'}=$erreur;
    $structure{'COMMENTAIRE_VERIFICATION'}=$commentaire;
    return %structure;
}


sub send_smtp {
##################################################
# Sub to send an email by using the Socket Connexion
# The real goal is to send an email by using a specific
# return_path
##################################################
my  %caracteristique= lc_hachage(@_) ;
my %structure = (
'SMTP'       => ['FACULTATIF' ,'localhost','Smtp is not precise , Loca
+lhost will be use'                           ],
'RETURN_PATH'     => ['OBLIGATOIRE','',         'No email for RETURN_P
+ATH. Structure is not CORRECT'                    ],
'TO'          => ['OBLIGATOIRE','',         'No email ro precise the R
+ECEPT-BOX. Structure is not CORRECT'          ],
'MESSAGE'    => ['OBLIGATOIRE','',         'No message to send . Strcu
+ture is not CORRECT '                  ],
'TIME_OUT'    => ['FACULTATIF' ,'5',        'No Time Out precise. Defa
+ult is 5 secondes.'                          ],
);
my %res= (
'ERROR' => '',
'STATUT' => '2',
'COMMENT' => '',
'TIME'=>''
);

## CLEAN UP STRUCTURE
%caracteristique = verification_structure(%caracteristique,%structure)
+;
if ($caracteristique{STATUT_VERIFICATION}==2) {
    $res{COMMENT} = $caracteristique{COMMENT_VERIFICATION};
    print_debug("ERREUR","SENDER",$res{'COMMENT'});
}
    
$|=1;

my $debut = time();
my $result= 0;
my $reponse ;
my $serveur = IO::Socket::INET->new(    PeerAddr     => $caracteristiq
+ue{smtp} ,
                    PeerPort     => '25' ,
                    Proto        => 'tcp' ,
                    Type         => SOCK_STREAM ,
                    Timeout     => $caracteristique{time_out}
                    ) or $result='1';

if ($result eq '1') {                                        
    # Traitement du problème de liaison sur le serveur
    # Aucune connection n'est possible
    $res{'COMMENT '} = "Erreur à la connection avec $caracteristique{s
+mtp} -($!)-";
    print_debug("ERREUR","SENDER",$res{'COMMENT '});
    $res{'ERROR'}= "sender:connecting";
    return %res;
   }
else {
    $res{'COMMENT'}= "Connexion on SMTP $caracteristique{smtp} -> OK \
+n";
}


$reponse = <$serveur>;
if ($reponse =~ /^220/sgi) { $res{'COMMENT'}.= "RECEPTION SMTP Ok \n";
+ }
    else
    {
    $res{'COMMENT'}.= "ERROR WHEN CONNECTING SMTP -> ($reponse) \n";
    $res{'ERROR'} = 'sender:authent';
    return %res;
}

print $serveur "HELO robot\r\n";
$reponse = <$serveur>;
if ($reponse =~ /^250/sgi) { $res{'COMMENT'}.= "Welcome on SMTP Ok \n"
+; }
    else
    {
    $res{'COMMENT'}.= "Problem when we try to be friendly -> ($reponse
+) \n";
    $res{'ERROR'} = 'sender:authent';
    return %res;
    }

print $serveur "MAIL FROM: <$caracteristique{return_path}>\r\n";
$reponse =<$serveur>;
if ($reponse =~ /^250/sgi) { $res{'COMMENT'}.= "Printing RETURN PATH O
+k \n"; }
    else
    {
    $res{'COMMENT'}.= "Problem when we introduice RETURN PATH -> ($rep
+onse) \n";
    $res{'ERROR'} = 'sender:sending';
    return %res;
    }

print $serveur "RCPT TO: <$caracteristique{to}>\r\n";
$reponse = <$serveur>;
if ($reponse =~ /^250/sgi) { $res{'COMMENT'}.= "WRITING recept email O
+k \n"; }
    else
    {
    $res{'COMMENT'}.= "Proble when we writing recept email -> ($repons
+e) \n";
    $res{'ERROR'} = 'sender:sending';
    return %res;
    }

print $serveur "DATA\r\n";
$reponse = <$serveur>;
if ($reponse =~ /^354/sgi) { $res{'COMMENT'}.= "Asking DATA Ok \n"; }
    else
    {
    $res{'COMMENT'}.= "Probleme when it ask DATA -> ($reponse) \n";
    $res{'ERROR'} = 'sender:sending';
    return %res;
    }

print $serveur $caracteristique{message};
$reponse = <$serveur>;
if ($reponse =~ /^250/sgi) { $res{'COMMENT'}.= "SENDIND Message Ok \n"
+; }
    else
    {
    $res{'COMMENT'}.= "Problem when wh SENDING DATA -> ($reponse) \n";
    $res{'ERROR'} = 'sender:sending';
    return %res;
    }

print $serveur "QUIT\r\n";
$reponse = <$serveur>;
if ($reponse =~ /^221/sgi) { $res{'COMMENT'}.= "We prepare us to exit 
+\n"; }
    else
    {
    $res{'COMMENT'}.= "Problem when we exit sender ($reponse) \n";
    $res{'ERROR'} = 'sender:sending';
    return %res;
    }
$res{'TIME'}=time()-$debut;
$res{'STATUT'}=$caracteristique{VERIFICATION_STATUT};
return %res;
}

## TEST : We will send a message, but the return path will be change t
+o
##        be route to another account


$message=<<MESSAGE;
to: FRIEND <everyone@world.com>
from: ONE FRIEND <people@mydomain.com>
Subject: This is a TEST

This email is a text.

.

MESSAGE


send_smtp (
     (
     'to'        => 'everyone@world.com' ,
     'return_path' => 'robo@mydomain.com'  ,
     'time_out'    => 10 ,
     'message'     => $message 
     )
);

#We can send every kind of MAIL (ALTERNAT, MIXED ... )
[download]