#!/usr/local/bin/perl -w
#
#  $Id: endlesssmtpbucket,v 1.3 2000/10/16 16:28:09 dgregor Exp $
#
# Copyright (c) 2000 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.
#
#
# You need to grab Net::SMTP::Server from CPAN, patch it with the patch
# contained in this uuencoded file, and build and install the module.
#
# begin 644 Net::SMTP::Server.diff
# M9&EF9B`M=7(@3F5T+U--5%`O4V5R=F5R+T-L:65N="YP;2!33510+5-E<G9E
# M<BTQ+C$O4V5R=F5R+T-L:65N="YP;0HM+2T@3F5T+U--5%`O4V5R=F5R+T-L
# M:65N="YP;0E&<FD@4V5P(#(Y(#$U.C`U.C4P(#(P,#`**RLK(%--5%`M4V5R
# M=F5R+3$N,2]397)V97(O0VQI96YT+G!M"51U92!$96,@,C@@,3@Z,C$Z,C(@
# M,3DY.0I`0"`M,S<L-R`K,S<L-B!`0`H@("`@(`H@("`@("1S96QF+3Y[1E)/
# M37T@/2!U;F1E9CL*("`@("`D<V5L9BT^>U1/?2`](%M=.PHM("`@("1S96QF
# M+3Y[35-'?2`]('5N9&5F.PH@("`@(`H@("`@("1S96QF+3Y?<'5T*"(R-3`@
# M1FEN92!F:6YE+B(I.PH@?0I`0"`M-C4L,3`@*S8T+#8@0$`*("`@("!M>2@D
# M8VUD+"!`87)G<RD["B`@("`@"B`@("`@;7D@)'-O8VL@/2`D<V5L9BT^>U-/
# M0TM].PHM"BT@("`@)'-E;&8M/GM&4D]-?2`]('5N9&5F.PHM("`@("1S96QF
# M+3Y[5$]](#T@6UT["BT@("`@)'-E;&8M/GM-4T=](#T@=6YD968["B`@("`@
# M"B`@("`@=VAI;&4H/"1S;V-K/BD@>PH@"2,@0VQE86X@=7`N"D!`("TQ-3<L
# M."`K,34R+#8@0$`*("`@("!]"B`@("`@"B`@("`@)'-E;&8M/E]P=70H(C(U
# M,"!)(&=O="!I="!D87)L:6XG+B(I.PHM"BT@("`@<F5T=7)N(#`["B!]"B`*
# .('-U8B!?;F]W87D@>PH`
# `
# end
#


#BEGIN {
#	unshift(@INC, '.');
#}

use Net::SMTP::Server;
use Net::SMTP::Server::Client;

$server = new Net::SMTP::Server("0.0.0.0") ||
	die "Unable to create server instance: $!\n";

$SIG{'INT'} = \&stats;

#use POSIX;
#pipe(READ, WRITE) || die "could not open pipe for child communication: $!\n";
#select(READ); $| = 1; select(STDOUT);
#select(WRITE); $| = 1; select(STDOUT);
#fcntl(READ, F_SETFL(), O_NONBLOCK()) ||
#	die "could non setup non-blocking on READ side of pipe: $!\n";

$| = 1;

$SIG{'CHLD'} = 'IGNORE';	# if we do this, we won't need to worry
				# about reaping children

while($conn = $server->accept()) {
	$firsttime = time() unless defined($firsttime);

	if (!defined($forkret = fork())) {
		die "could not fork: $!\n";
	}

	if ($forkret) {	# this is the parent
		undef($conn);
	} else {	# this is the child
		$SIG{'INT'} = 'DEFAULT';

		my $client = new Net::SMTP::Server::Client($conn) ||
			die "Unable to handle client connection: $!\n";

		$addr =  $client->{SOCK}->peerhost();

		while(defined($stat = $client->process()) && $stat) {
			if ($client->{'MSG'} =~
					m/^Message-Id:\s*([^\n\r]+)\s*$/im) {
				chomp($msgid = $1);
			} else {
				undef($msgid);
			}

			if ($client->{'MSG'} =~
					m/^Subject:\s*([^\n\r]+)\s*$/im) {
				chomp($subject = $1);
			} else {
				undef($subject);
			}

			$size = length($client->{'MSG'});
	
#			print WRITE scalar(localtime()) .
#				" smtpserver[$$]: Received message " .
#				(defined($msgid) ? "ID $msgid " : "") .
#				"of $size bytes from $addr\n";
			print scalar(localtime()) .  " (" . time() . ") " .
				"smtpserver[$$]: Received message " .
				(defined($msgid) ? "ID $msgid " : "") .
				"of $size bytes from $addr " .
				"with subject $subject\n";

			if (!defined($client->{'SOCK'}) ||
					$client->{'SOCK'}->eof()) {
				last;
			}
		}

		undef($client);

		exit;
	}
}

warn "we shouldn't have gotten here: $!\n";

sub stats {
#	close(WRITE);
	wait();

#	$messages = 0;
#	while(<READ>) {
#		$messages++;
#	}
	
#	if (defined($firsttime) && $messages > 0) {
#		print "Total time to process $messages message" .
#			($messages == 1 ? "" : "s") .
#			": " . (time() - $firsttime) . " seconds\n";

	if (defined($firsttime)) {
		print STDERR "Total time between first message and CTRL-C: " .
			(time() - $firsttime) . " seconds\n";
	} else {
		print STDERR "No messages recevied\n";
	}

	exit(0);
}