use Socket;

#! perl -w
use Socket;
# BEGIN LOCAL CONFIG PORTION
# Declare the name of the host we're pawning the mail off onto. localhost
# is probably the best option if we've got a mailserver on this
# machine. If not, change it to another host. *YOU MUST HAVE MAIL RELAY
# PERMISSION ON THIS HOST!*
my $mailhost_name = "localhost"; # Fill this in with your local SMTP host name
my $mailhost_ip = ""; # The IP address for the mailhost. If left blank,
# we'll go try to figure it out. Should be in
# packed format, so no 1.2.3.4 here.
my $mailhost_port = 25; # The port to connect to. Except in the most
# bizarre of circumstances, this'll be 25.
my $we_are = ""; # Who we are. Fill this in if your mailserver needs to
# know. The only way to find this out locally is with
# POSIX::uname. Not everyone has it, and POSIX is a
# memory pig anyway. If you don't, we'll try a reverse
# lookup from the IP address on this end of things after
# the connection to the mailserver.
#
# END OF LOCAL CONFIG PORTION

# smailer - quicko sub to send mail. Takes from, a reference to an array
# with the to addresses in it, and a reference to an array with
# the actual formatted mail message in it, minus line terminators.
sub smailer ($\@\@){
my ($from, $to_ref, $message_ref) = @_;

my $mailhost_paddr; # Where the packed IP address & port will get stuck
my $they_said;

# Translate the port to a number if it's a name
$mailhost_port = getservbyname($mailhost_port, 'tcp') if $mailhost_port =~ /\D/;
# Figure the IP address if we need to
$mailhost_ip ||= inet_aton($mailhost_name);
# Build the packed socket address
$mailhost_paddr = sockaddr_in($mailhost_port, $mailhost_ip);

# Create the socket
socket(MAILSOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die "socket:$!";
# Open the socket
connect(MAILSOCK, $mailhost_paddr) || die "Connect error: $!";
# Dup it
open(MAILOUTSOCK, ">&MAILSOCK") || die "Erro dupping, $! $^E";
select(MAILSOCK);
$| = 1;
select(MAILOUTSOCK);
$| = 1;
select(STDOUT);

# Unless we know who we are, we'd better go figure it out
my $stuff = getsockname(MAILSOCK) || die "Hey! $^E $!";
my ($foo, $bar) = unpack_sockaddr_in($stuff);
$we_are = gethostbyaddr($bar, AF_INET) unless $we_are;

# Talk to the server. First fetch the initial 'hi there' message
$they_said = <MAILSOCK>;

# Say hi
syswrite(MAILOUTSOCK, "HELO $we_are\cM\cJ", length($we_are) + 7);

# Wait for them to say hi back
$they_said = <MAILSOCK>;
# Make sure we like it
if (substr($they_said, 0, 1) ne '2') {
# not a 2 response. Bail
close(MAILSOCK);
die "server said $they_said (why?)";
}

# Tell it who the mail's from
syswrite(MAILOUTSOCK, "MAIL FROM: $from\cM\cJ", length($from) + 13);

# was it OK?
$they_said = <MAILSOCK>;
chomp $they_said;
# Make sure we like it
if (substr($they_said, 0, 1) ne '2') {
# not a 2 response. Bail, but not badly
close(MAILSOCK);
die "server said $they_said (why?)";
}

# Tell 'em who it's going to
foreach my $recipient (@$to_ref) {
# Tell it who the mail's from
syswrite(MAILOUTSOCK, "RCPT TO: $recipient\cM\cJ", length($recipient) + 11);

# was it OK?
$they_said = <MAILSOCK>;
chomp $they_said;
# Make sure we like it
if (substr($they_said, 0, 1) ne '2') {
# not a 2 response. Bail, but not badly
close(MAILSOCK);
die "server said $they_said (why?)";
}
}

# Time for the message
syswrite(MAILOUTSOCK, "DATA\cM\cJ", 6);

# was it OK?
$they_said = <MAILSOCK>;
chomp $they_said;
# Make sure we like it
if ((substr($they_said, 0, 1) ne '2')&& (substr($they_said, 0, 1) ne '3')) {
# not a 2 response. Bail, but not badly
close(MAILSOCK);
die "server said $they_said (why?)";
}

# Send the message. If a line's got just a period, then send a double
# period. (SMTP protocol dictates that a message ends with a single
# period, and we don't want it ending before we're ready)
foreach my $line (@$message_ref) {
if ($line eq '.') {
syswrite(MAILOUTSOCK, "..\cM\cJ", 4);
} else {
syswrite(MAILOUTSOCK, "$line\cM\cJ", length($line)+2);
}
}

# 'Kay, send the closing period
syswrite(MAILOUTSOCK, ".\cM\cj", 3);
# Did they like the mail?
$they_said = <MAILSOCK>;
chomp $they_said;
# Make sure we like it
if (substr($they_said, 0, 1) ne '2') {
# not a 2 response. Bail, but not badly
close(MAILSOCK);
die "server said $they_said (why?)";
}

# Go away
syswrite(MAILOUTSOCK, "QUIT\cM\cJ", 6);
close MAILSOCK;
close MAILOUTSOCK;
return 1;
}