#!/usr/local/bin/perl

# send bare LF to smtp server

use strict;
use IO::Select;
use IO::Socket::INET;

my $host = shift; # smtp server to test
my $addr = shift; # envelope sender and recipient, must be valid
my $timeout = 2;


my $sock = IO::Socket::INET->new(Proto => 'tcp',
                                 PeerAddr => $host,
                                 PeerPort => 25,
                                 Timeout => $timeout);

if($sock){
	my $select = IO::Select->new;
	$select->add($sock);

	my @banner = _getlines($select,$timeout);
	if($banner[-1] =~ /^220\s/){
		print $sock "HELO barelf.tester\n";
	}else{
		die "$host misbehaving, did not get valid banner\n";
	}

	my @helo = _getlines($select,$timeout);
	if($helo[-1] =~ /^250\s/){
		print $sock "MAIL FROM:<$addr>\n";
	}else{
		die "$host misbehaving, did not give 250 to my helo\n";
	}

	my @mf = _getlines($select,$timeout);
	if($mf[-1] =~ /^250\s/){
		print $sock "RCPT TO:<$addr>\n";
	}else{
		die "$host misbehaving, did not give 250 to my mail from\n";
	}

	my @rt = _getlines($select,$timeout);
	if($rt[-1] =~ /^250\s/){
		print $sock "DATA\n";
	}else{
		die "$host misbehaving, did not give 250 to my rcpt to\n";
	}

	my @data = _getlines($select,$timeout);
	if($data[-1] =~ /^354\s/){
		print $sock "From: <$addr>\n",
		            "To: <$addr>\n",
		            "Subject: BareLF SMTP test\n\n",
		            "body\n",
		            ".\n";
	}else{
		die "$host misbehaving, did not give 354 to my DATA: ($data[-1])\n";
	}

	my @body = _getlines($select,$timeout);
	foreach(@body){
		print "body: $_\n";
	}
	close $sock;
}else{
	die "could not make a socket on $host port 25/tcp\n";
}

sub _getlines {
	my $select = shift || die "_getlines syntax error 1";
	my $timeout = shift || die "_getlines syntax error 2";
	my @lines;
	if(my ($pending) = $select->can_read($timeout)){
		while(<$pending>){
			if(/^\d+\s/){
				chomp;
				push @lines, $_;
				last;
			}else{
				push @lines, $_;
			}
		}
	}
	return(@lines);
}