# set to your local SMTP server
$server = "netconsult.netconx.de";

use Socket;

print "HTTP/1.0 200 OK\n" if ($ENV{'PERLXS'} eq "PerlIS");
print "Content-type: text/html\n\n";

$proto = (getprotobyname('tcp'))[2];
$port = (getservbyname('smtp', 'tcp'))[2];

$thisaddr = (gethostbyname(""))[4];
$smptaddr = (gethostbyname($server))[4];

$this = pack('Sna4x8', AF_INET, 0, $thisaddr);
$smtp = pack('Sna4x8', AF_INET, $port, $smptaddr);

if (!socket(S, AF_INET, SOCK_STREAM, $proto)) { die $!; }
if (!bind(S, $this)) { die $!; }
if (!connect(S, $smtp)) { die $!; }

$oldfh = select(S); $| = 1; select($oldfh);

if (eof(S))
{
print "OOPS ! eof(S) == TRUE<br>";
exit(-1);
}

$_ = <S>; if (/^[45]/) { close S; die "$_<br>\n"; }
print "$_<br>\n";

print "helo localhost<BR>\n";
print S "helo localhost\r\n";

$_ = <S>; if (/^[45]/) { close S; die "$_<br>\n"; }
print "$_<br>\n";

print "quit<BR>\n";
print S "quit\r\n";

$_ = <S>; if (/^[45]/) { close S; die "$_<br>\n"; }
print "$_<br>\n";

close S;