##########################################################################
# Simple subroutine to send mail from any perl script
# FREE!!!
# usage: include in your script line (put this script in your
# perl\lib or working dir)
# require "mail.pl"
# This sub uses associative array MAIL which MUST be defined in your
program
# Keys of MAIL to be specified (keys in lowercase !!!):
# %MAIL =
# ( 'from', 'phil@somewhere.in.usa', # Sender's e-mail
# 'to', 'eric@somewhere.in.uk', # Receiver's e-mail
# 'subject', 'Testing mail from perl script', # Subject of e-mail
# 'date', 'Mon, 14 Apr 1997 11:34:49', # Date of mail,
# # localtime(time)
def.
# 'debug', '1', # 0 - no debug
# 'sender name', 'Phil Collins', # Senders name
# 'receiver name', 'Eric Clapton', # Name of receiver
# 'server', 'mail.server.there', # IP or name of mail
server
# 'port', '25', # port of SMTP, 25
default
# 'status', '', # status of message,
can be blank
# 'message', "Hi, Eric\nThis is test\nof mail.pl"); # Message (strings,
# # separated
by \n)
#
# Errors of sending mail will be in $MAIL{'errors'}
# ---- Main program ----
# require "mail.pl"
# %MAIL =
# ('from', ......, 'to, ...... ... ...);
# $MAIL{'message'} = join("\n", "Hi, ...", "test from perl", "bye");
# if (&mail())
# { print "Success!\n"; }
# else
# { print "Failure, errors:\n",$MAIL{'errors'}; }
# ---- End of main program -----
#
# Script is not very smart...yet... ;-)
##########################################################################
# Script by Gintaras Gruzdys, gincius@soften.ktu.lt
# Version 2.0, code name HELO ;-)
##########################################################################
# Now script send 'HELO your.computer.name', at begining.
# You can find error '550 Unrecognized command' in $MAIL{'errors'},
# but script don't care, if server doesn't support HELO.
##########################################################################
# Sub to get IP and name of computer, parameter - computer's name
# returns array ('ip.of.your.computer', 'name.of.computer')
sub ___get_ip_addr
{ local($computer_name) = @_;
local($name, $aliases, $addrtype, $length, @addrs) =
gethostbyname($computer_name);
($addrs[0], $name);
}
# Sub to listen a socket for a specific response of
# remote computer, eg. line 220 ok :-)
sub ___wait_for {
local($str) = @_;
local($s) = "";
local($cc) = "";
local($err) = 0; # Errors reading socket
$line_end = pack("C", 10);
while ($err < 5000)
{
do { $err++; next; } if (sysread(S, $cc, 1, 0) != 1);
$err = 0;
print $cc if ($MAIL{'debug'} && $cc ne $line_end);
do { $s .= $cc; next; } if ($cc ne $line_end);
if ($s =~ /^(\d+)\s+(.*)/)
{ if ($1 != $str)
{ $MAIL{'errors'} .=
"Mail server error: waiting $str, get $1,",
" full response:\n$s\n";
return 0; }
else
{ return 1; }
}
$s = "";
}
0;
}
# Main sub for sending mail
sub mail
{ $MAIL{'debug'} = 0 unless (defined($MAIL{'debug'}));
local($AF_INET, $SOCK_STREAM) = (2, 1);
$MAIL{'port'} = 25 unless (defined($MAIL{'port'}) &&
$MAIL{'port'} =~ /^\d+$/);
if (!defined($MAIL{'server'}))
{ $MAIL{'server'} = (___get_ip_addr('localhost'))[0];
$server = $MAIL{'server'}; }
else
{ $server = $MAIL{'server'};
if ($MAIL{'server'} !~ /^\d+\.\d+\.\d+\.\d+/)
{ $MAIL{'server'} = (___get_ip_addr($MAIL{'server'}))[0];
do { $MAIL{'errors'} .=
"MAIL: Can't obtain IP of server $server\n";
return 0; } unless $MAIL{'server'};
}
else
{ $MAIL{'server'} = pack("C" x 4, split(/\./, $MAIL{'server'}));
}
}
print "\nConnecting to mail server $server...\n" if $MAIL{'debug'};
local($sockaddr) = ('S n a4 x8');
local($name,$aliases,$proto) = getprotobyname('tcp');
local($name,$aliases,$port) = getservbyname($MAIL{'port'},'tcp');
local($this) = pack($sockaddr, $AF_INET, 0,
(&___get_ip_addr($ENV{'computername'}))[0]);
local($that) = pack($sockaddr, $AF_INET, $MAIL{'port'}, $MAIL{'server'});
# Make the socket filehandle.
if (socket(S, $AF_INET, $SOCK_STREAM, $proto))
{ print "socket ok\n" if $MAIL{'debug'}; }
else
{ $MAIL{'errors'} .= "Socket error:$!\n"; return 0; }
# Give the socket an address
if (bind(S, $this))
{ print "bind ok\n" if $MAIL{'debug'}; }
else
{ $MAIL{'errors'} .= "Bind error:$!\n"; return 0; }
# Call up the server.
if (connect(S, $that))
{ print "connect ok\n" if $MAIL{'debug'}; }
else
{ $MAIL{'errors'} .= "Connect error:$!\n"; return 0; }
select(S); $| = 1; select(STDOUT);
local($n) = pack("CC", 13, 10);
return 0 unless (&___wait_for('220'));
#### HELO
print "HELO ",(&___get_ip_addr($ENV{'computername'}))[1],"$n"
if $MAIL{'debug'};
print S "HELO ",(&___get_ip_addr($ENV{'computername'}))[1],"$n";
&___wait_for('250'); # Not critical error...
##### End HELO
print 'mail from: <', $MAIL{'from'}, "\>$n" if $MAIL{'debug'};
print S 'mail from: <', $MAIL{'from'}, "\>$n";
return 0 unless (&___wait_for('250'));
print 'rcpt to: <', $MAIL{'to'}, "\>$n" if $MAIL{'debug'};
print S 'rcpt to: <', $MAIL{'to'}, "\>$n" ;
return 0 unless (&___wait_for('250'));
print "data$n" if $MAIL{'debug'};
print S "data$n";
$MAIL{'message'} =~ s/\n/$n/g;
return 0 unless (&___wait_for('354'));
$MAIL{'date'} = localtime(time) unless (defined($MAIL{'date'}));
print "from: \"", $MAIL{'sender name'}, "\" <",$MAIL{'from'},"\>$n" if
$MAIL{'debug'};
print S "from: \"", $MAIL{'sender name'}, "\" <",$MAIL{'from'},"\>$n";
print "to: \"", $MAIL{'receiver name'}, "\" <",$MAIL{'to'},"\>$n" if
$MAIL{'debug'};
print S "to: \"", $MAIL{'receiver name'}, "\" <",$MAIL{'to'},"\>$n";
print "subject: ", $MAIL{'subject'}, "$n" if $MAIL{'debug'};
print S "subject: ", $MAIL{'subject'}, "$n";
print "date: ", $MAIL{'date'}, "$n" if $MAIL{'debug'};
print S "date: ", $MAIL{'date'}, "$n";
print "Status: ", $MAIL{'status'}, "$n" if $MAIL{'debug'};
print S "Status: ", $MAIL{'status'}, "$n";
print $MAIL{'message'}, "$n.$n" if $MAIL{'debug'};
print S $MAIL{'message'}, "$n.$n";
return 0 unless (&___wait_for('250'));
print "quit\n" if $MAIL{'debug'};
print S "quit\n";
return 0 unless (&___wait_for('221'));
close(S);
1;
} # End of mail
1;