#!/usr/bin/perl
#  
#  Copyright (c) 2003 Steve Slaven, All Rights Reserved.
#  
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License as
#  published by the Free Software Foundation; either version 2 of
#  the License, or (at your option) any later version.
#  
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#  GNU General Public License for more details.
#  
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston,
#  MA 02111-1307 USA
#  

use IO::Socket;
use Getopt::Std;

getopts( 'h', \%o );

my $server = shift;
my $to = shift;
my $from = shift() || $to;

$o{ h } = 1 unless $to;
die( qq{
Mail Server Test v0.98
Author: Steve Slaven - http://hoopajoo.net
Usage: $0 server to\@host.com [from\@host.com]

Sends email to to\@host.com through server, optionally
sending from from\@host.com.  The whole mail message
is accepted on stdin and the entire conversation
with the mail server is output while the script operates.

The mail on stdin should be something like:

--- temp.txt
To: user1
From: user2
Subject: test

Test!
--- end temp.txt

Then you could call $0 as:

$0 myserver.com user1 < temp.txt

} ) if $o{ h };

my $s = IO::Socket::INET -> new(
	PeerAddr => $server,
	PeerPort => 'smtp' );

println();
sendln( "helo $server" );
println();
sendln( "mail from: $from" );
println();
sendln( "rcpt to: $to" );
println();
sendln( "data" );
println();
sendln( join( "", map { s/^\./>./; $_ } <STDIN> ) );
sendln( "." );
println();
sendln( "quit" );
println();

sub println {
	my $looping = 1;
	while( $looping ) {
		my $line = $s -> getline();
		chomp( $line );
		$line =~ s/([^[:print:]])/sprintf( '(%s)', ord( $1 ) )/egi;

		print "<<<< $line\n";
		$looping = 0 if $line =~ /^\d\d\d /;
	}
}

sub sendln {
	my $out = shift;
	$out .= "\r\n";
	print ">>>> $out";
	$s -> print( $out );
}