#!/usr/bin/perl -w
#
# Based upon:
#  $Id: smtptest,v 1.2 2004/08/27 19:12:20 dgregor Exp $
# 
# Copyright (c) 1998 Daniel J. Gregor, Jr., All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
# 	This product includes software developed by Daniel J. Gregor, Jr.
# 4. The name of Daniel J. Gregor, Jr. may not be used to endorse or promote
#    products derived from this software without specific prior written
#    permission.
# 
# THIS SOFTWARE IS PROVIDED BY DANIEL J. GREGOR, JR. ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL DANIEL J. GREGOR, JR. BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#

use IO::Socket;
use IO::Select;
use FileHandle;
use POSIX;

$usage =
"smtptest [-p <destination port>] [-s <subject>] [-b <message body>]
	[-B <message body file>] [-v] [-d] <host> <from_address> <to_address>";

require 'getopt.pl';
 
chomp($hostname = `hostname`);

$opt_p = 25;
$opt_d = undef; 	# debug
$opt_s = "Test message from smtptest $hostname sent %c (Epoch: %s)";
$opt_b = "Test message";
$opt_B = undef;		# A body file

Getopt('psbwnliB');

die "Invalid number of arguments\nUsage:\t$usage\n" unless
	@ARGV == 3;

if (defined($opt_B)) {
	open(FILE, "<$opt_B") || die "could not open $opt_B: $!\n";
	$opt_b = join('', <FILE>);
}

$host = shift(@ARGV);
$from_addr = shift(@ARGV);
$to_addr = shift(@ARGV);


sendmessage();

sub sendmessage {
	if (!defined($smtp = new IO::Socket::INET (
			PeerAddr => $host,
			PeerPort => $opt_p,
			Proto => 'tcp',
			))) {
		die "Error creating socket: $!\n";
	}

	$smtp->autoflush(1);

	print("Connected to host " . $host . ".\n") if $opt_d;

	$status = $smtp->getline();

	chomp($status);
	if (!($status =~ m/^2\d\d/)) {
		die "Connect status: $status\n";
	}
	print("Host said hi: $status\n") if $opt_d;
		
	$hostname = `hostname`;
	chomp($hostname);
	smtpcommand("HELO $hostname", 'Saying HELO');
	smtpcommand("MAIL FROM: <$from_addr>", 'MAIL FROM');
	smtpcommand("RCPT TO: <$to_addr>", 'RCPT TO');

	smtpcommand("DATA", 'DATA');
	$smtp->print("From: <$from_addr>\r\n");
	$smtp->print("To: <$to_addr>\r\n");
	$smtp->print("Subject: " . POSIX::strftime($opt_s, localtime()) .
		"\r\n");
	$smtp->print("\r\n");
	$smtp->print($opt_b);
	$smtp->print("\r\n.\r\n");

	smtpcommand("QUIT", 'QUIT');
}


sub smtpcommand {
	$command = shift(@_);
	$msg = shift(@_);

	$smtp->print("$command\r\n");

	$status = $smtp->getline();
	chomp($status);
	if (!($status =~ m/^[23]\d\d/)) {
		die "Error response returned while $msg: $status\nWe said: $command\n";
	}
	print("$msg: $status\n") if $opt_d;
}