#!/usr/local/bin/perl5.8.5 -T
#!/usr/bin/perl5 -T

# dummy-smtpd.pl
# Copyright 2003-2006 Kai Schlichting - All rights reserved
# http://www.spamshield.org
#
#
# history:
# V1.4 20060801 - reported rare race condition of child proc $peer_ip = inet_ntoa() bombing out
#		  removed call from child, reusing info from parent
#
# V1.3 20060607 - fix to "did not issue MAIL/EXPN/VRFY/ETRN during connection to MTA"
#		  after RSET+QUIT : $have_mail flag now preserved in $had_any_mail
#
# V1.2 20040414
#		- getinput() fix broke with quick return without cancelling alarm,
#		  preventing TCP conn. closures from being recognized (and SMTP
#		  null connects)
#		- suid/sgid switches prevent us from reading SM virtusers table -
#		  moved opening file into parent before surrendering root privs,
#		  never opening or closing it in the child
#
# V1.1 20040409
#	- Jon Lewis contributed code:
#		- drop root privileges after binding to 25/tcp , improved on this
#		  by doing username/group name lookups as well.
#		- fix crashes under high load where $client->peeraddr() would burn,
#		  because the remote end had already closed the connection before
#		  we could handle it.
#		- fix piling up zombies under high load: we were missing SIGCHLD's
#		  and were not reaping processes when that happened.
#		- didn't accept your 'potty mouth/profanity fixes' for now :)
#		- getinput() fix for "Use of uninitialized value in string" problem
#	- now starting in taint mode to be sure
#	- some perl installations don't seem to implement suid switching ( sruid() ),
#		v5.8.3 built for i386-bsdos seems to be one of those.
#		$use_euid_only used for using switching to EUID only
#	
# V1.0 20040327
#
# This dummy is a fake, logging SMTP daemon, intended to run on your
# lowest-priority (highest-distance) MX for your domain(s). Example:
#  example.com.               8H IN MX        10 mail.example.com.
#  example.com.               8H IN MX        50 mail2.example.com.
#  example.com.               8H IN MX        100 trap.example.com. <- running dummy-smtpd.pl
#
# Rationale for doing this: tons of spamware connects to your
# lowest-priority MX ONLY, and tries to dump its spam there, and
# only there, falsely assuming that the lower-priority MX
# hosts have less spam protection than the primary mail exchangers,
# do not have a complete view of existing accounts, and will blindly
# relay anything and everything for your domain.
# Extensive testing has shown this to be the case in late 2003/early 2004
#
# This is possible front-end code for spamtraps feeding your personal DNSBLs - but
# don't be a fool, and feed everything that connects to dummy-smtpd into that:
# perfectly legitimate senders connect to backup MX's for a variety of reasons.
# Use the extended log info on DNSBLs, EHLO parameters, rDNS names, RFC-violating
# 'impatience', logged header info and other logged discrepancies to consider a
# DNSBL listing of your own.

# run as ./dummy-smtpd.log >>/full/path/logfile , all DEBUG output is to STDOUT
#	redirecting stdout to >/dev/null is ok for no debugging., set $DEBUG = 0, too
# all regular logging output is via syslog.

# kill -HUP or -TERM to the running PID will terminate the process
# kill -USR1 will decrease the $DEBUG level by one (min: 0)
# kill -USR2 will increase the $DEBUG level by one (max: 10)


# Set this to 0 for essential info, 1 or 2 for regular level, 3 for line-by-line responses
local $DEBUG = 2;

# my $service_port = 26;		# TCP port to listen on
# my $service_addr = "127.0.0.1";	# interface address to listen on
my $service_port = 25;			# TCP port to listen on
my $service_addr = "192.0.2.1";	# interface address to listen on

my $smtp_banner = "220 example.com ESMTP Sendmail 8.12.11/8.12.11; Mon, 21 Mar 2006 15:13:02 -0400";

# how many connecting clients will we handle simultaneously?
# (check your available memeory: each forked child may take up 5M with 2M resident)
my $child_max = 10;

# max. number of RCPT TO: lines we accept from a client, "452 Too many recipients" after this, acc. to RFC 2821
my $rcpt_n_max = 5;

# list domain names we MX for, and which we should consider 'fake' in EHLO/HELO and MAIL FROM:
my $our_hostnames = "example\.com|example\.net|example\.TLD";
# list domain names we should consider 'fake' in MAIL FROM:
my $fake_hostnames = "netscape\.com|yahoo\.com|hotmail\.com|msn\.com|aol\.com|excite\./com|juno\.com|192\.0\.2\.1";

# delays in seconds for various SMTP cmds received
my $banner_delay = 5; # SMTP banner after connect
my $ehlo_delay   = 3; # after EHLO/HELO
my $mail_delay   = 3; # after each MAIL FROM:
my $rcpt_delay   = 2; # after each RCPT TO:
my $data_delay   = 1; # after DATA
my $quit_delay   = 1; # after QUIT
my $noop_delay   = 10; # after NOOP
my $rset_delay   = 10; # after RSET
my $badcmd_delay = 15; # after any unimplemented/unrecognized command

my $cmd_timeout = 30; # general timeout

# do we permit the remote client to enter the DATA stage to see parts of the spam?
my $data_max = 25; # max number of accepted DATA lines from any smtp client
		   # recommended: set this to 0 to NEVER accept the DATA cmd of the client

# should we read the entire header, if $data_max > 0 ?
my $data_hdr_only = 0 ;

# if we reject the user at RCPT TO, we can play with the remote client by giving
# them a 2xx code
my $rcpt_reject_code = "250 2.2.0";
# my $rcpt_reject_code = "550 5.5.0";

# cut off the data phase with this msg. don't terminate with \r or \n
my $data_end = "552 5.5.0 Requested mail action aborted: exceeded storage allocation";
# my $data_end = "452 4.3.1 Requested mail action aborted: insufficient system storage";

# use syslog for logging
my $use_syslog = 1;

# 1 = simulate Sendmail-compatible syslog entries, and write to Sendmail's log instead
# 	of our own.
# $use_syslog = 1 is required for this to work
my $smc = 0 ;

# DNSBLs we will query the connecting IP against (for logging purposes only)
my %dnsbls = (
	# no whitespace allowed on left side - for logging purposes
	# "sbl"		=> "sbl.spamhaus.org",
	# "spamcop"	=> "bl.spamcop.net",
	# "cbl"		=> "cbl.abuseat.org",
	# "xbl"		=> "sbl-xbl.spamhaus.org",
	# "spews_L1"	=> "l1.spews.dnsbl.sorbs.net",
	# "sorbs"		=> "dnsbl.sorbs.net",
	# "dsbl"		=> "list.dsbl.org",
	# "ahbl"		=> "dnsbl.ahbl.org",
	# "njabl"		=> "combined.njabl.org",
	# "asnbl"		=> "bl.asnbl.org",
);

my $cfg_syslog_fac = 'local5';		# If using 'use_syslog' above: syslog facility
my $cfg_syslog_sev = 'info';		# If using 'use_syslog' above: syslog severity
my $cfg_syslog_host = "127.0.0.1";	# this is usually the loopback interface (localhost = default)

# if we are using syslog and ALSO use '$smc = 1' :
my $cfg_smc_syslog_fac = 'mail';	# If using 'smc' above: syslog facility for Sendmail log
my $cfg_smc_syslog_sev = 'info';	# If using 'smc' above: syslog severity
my $cfg_smc_syslog_host = "127.0.0.1";	# this is usually the loopback interface (localhost = default)

# who-am-i for syslog purposes
# our name for logging purposes
my $sn = "dummy-smtpd"; 

# we have to start as root to bind to port 25/tcp. switch to this user/group
# after doing so to improve security
my $runas_user  = "nobody"; # make this "" to disable
my $runas_group = "nobody"; # make this "" to disable
my $use_euid_only = 0; # set to 1 if your platforms doesn't permit/implement setruid()

########################### No user-servicable parts below ##############################


# package main;
use strict;
no strict "vars";

use IO::Socket;
use Time::HiRes;
# use Net:hostent;

select(STDOUT); $| = 1; # make unbuffered STDOUT so we can properly grep during debug

my $sock;
my $client;
local $peer_ip = "";
local $peer_port = "";
my $query = "";
my $route = "";
my $asn = "";
my $tries;
my $child_pid;
my $child_n;
my $bl_list;
my $pid = $$;
local %users; # hash for virtusers
local $virtusers_open = 0;
my $runasuid;
my $runasgid;

# make environment safe for external calls: taint mode requires this
$ENV{PATH} = "/usr/bin:/bin:/usr/sbin:/sbin:/usr/contrib/bin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin";

$SIG{TERM} = \&sig_term;
$SIG{HUP} = \&sig_term;
$SIG{CHLD} = \&sig_chld;
# $SIG{ABRT} = \&child_sigterm;
$SIG{USR1} = \&sig_usr1; # lower DEBUG level
$SIG{USR2} = \&sig_usr2; # increase DEBUG level


my $dnsbl_list = join (",", keys %dnsbls);

debug (0, "Starting with $child_max max. children.\n");


if ($use_syslog) {

	# using Syslog.pm module. provides openlog(),syslog(),closelog()
	# use Sys::Syslog ;
	use Sys::Syslog qw(:DEFAULT setlogsock); # Perl 5.004_02 or later
	setlogsock ('unix');

	if ($smc) {
		# $Sys::Syslog::host = $cfg_smc_syslog_host;
		# openlog($sn,'pid,ndelay',$cfg_smc_syslog_fac);
		openlog($sn,'pid,ndelay',$cfg_smc_syslog_fac);
	} else {
		# $Sys::Syslog::host = $cfg_syslog_host;
		# openlog($sn,'pid',$cfg_syslog_fac);
		openlog($sn,'pid',$cfg_syslog_fac);
	}
}

# need root privs for this on virtually all systems
# depending on your Perl install that doesn't use Berkeley DB as it's default DB,
# this requires installation of the CPAN DB_File package, and using "use DB_File;",
# or, in most simpler cases: specifying /etc/mail/virtusertable.db instead of /etc/mail/virtusertable
#
# check debug output to see if /etc/mail/virtusertable is observed - if it doesn't,
# the dbmopen call will likely pollute the /etc/mail/ directory with two files - which you should erase:
# /etc/mail/virtusertable.db.dir
# /etc/mail/virtusertable.db.pag
use DB_File;
if (dbmopen(%users,"/etc/mail/virtusertable.db",0600) ) {
	debug (1,"Parent: opened /etc/mail/virtusertable ok.\n");
	$virtusers_open = 1 ;
	my $entry;
	foreach $entry (keys %users) {
		debug (3,"Parent: virtusertable entry: $entry $users{$entry}\n");
	}
} else {
	debug (0,"Parent: could not open /etc/mail/virtusertable - need root privs?\n");
}


$sock = IO::Socket::INET->new (Listen => 1, # FBSD won't allow values < 1 , makes it 5 if encountered?
				LocalAddr => $service_addr,
				LocalPort => $service_port,
				Proto     => 'tcp',
				Reuse     => 1,
				Blocking  => 1
				) ;

# set up uid/gid's

unless ($runas_group eq "") {
 	$runasgid = getgrnam($runas_group);
	unless ( ( $( = $runasgid ) && ( $) = "$runasgid $runasgid") ) {
		debug(0, "Parent: couldn't setgid/setegid to $runasgid: $!\n");
		exit 1;
	}
}

unless ($runas_user eq "") {
	$runasuid = getpwnam($runas_user);
	unless ( $> = $runasuid ) {
		debug(0, "Parent: couldn't set effective uid to $runasuid: $!\n");
		exit 1;
	}
	unless ($use_euid_only) {
		unless ( $< = $runasuid ) {
			# prevent "setruid() not implemented" (BSDI 4.x, others?) if used without setting euid
			# prevent "couldn't set real uid to 32767: Operation not permitted" if used under BSDI/others?
			debug(0, "Parent: couldn't set real uid to $runasuid: $!\n");
			exit 1;
		}
	}
}


if ($sock) {
         # we are ok
} else {
	debug (0, "Parent: couldn't open socket - quitting.\n");
	exit 1;
}

$sock->autoflush; # default?

LISTENLOOP:
while (1) {

	if ($child_n >= $child_max) {
		$0 = "$sn: not accepting connections: have max. of $child_max children already";
		debug (2, "Parent: not accepting connections: have $child_n of $child_max max children already - sleeping 1 sec.\n");
		sleep 1;
		next LISTENLOOP;
	}

	$query = "";
	debug (3, "Parent: waiting for connect\n");
	$0 = "$sn: waiting for connect";
	$client = $sock->accept(); # SIGCHLD uses alarm(2), interrupting this

	if (defined $client && $client->peeraddr() && $client->peerport() ) {
		# checking for all 3 conditions, because a rapidly connecting/disconn. client
		# may have made $client->peeraddr() invalid already

		$peer_ip = inet_ntoa ( $client->peeraddr() );
		$peer_port = $client->peerport();

		$child_n += 1;
		if ($child_n > $child_max) {
			debug (0, "Parent: connect from $peer_ip:$peer_port - number of children is at max $child_max - closing connection\n");
			close ($client);
			$child_n -= 1;
			next; # while
		}


		$child_pid = fork;

		if (! $child_pid) {
			# we are the child
			&child; # no return
		}

		debug (0, "Parent: connect from $peer_ip:$peer_port for child \#$child_n [$child_pid]\n");
		# debug (1, "parent: forked off child $child_pid - child is \#$child_n\n");

	} else {
		# print "Parent: sock-accept call was interrupted by SIGCHLD - ignoring\n";
	}

} # LISTENLOOP - we only ever leave via SIGHUP handler



#######################

sub sig_term {

 # $SIG{TERM} = \&child_sigterm;
 debug (0,"parent: got SIGTERM - quitting.\n");
 close ($sock);
 exit 0;

}

#######################

sub sig_chld {

 # $SIG{TERM} = \&child_sigterm;
 # print "parent sig_chld: got SIGCHLD.\n";
 my $kid;

 use POSIX ":sys_wait_h";

 do {
	$kid = waitpid(-1, WNOHANG);
	if ($kid > 0) {
		$child_n -= 1;
		debug (3, "parent sig_chld: reaped child $kid - child_n is at $child_n\n");
	}
 } until $kid < 1;
 # we possibly missed a SIGCHLD signal under high load
 # and may have to reap more than one child to avoid piling up zombies.

 return;

}

#######################

sub sig_usr1 {

 my $old = $DEBUG;
 
 $DEBUG -= 1;
 if ($DEBUG <0 ) {
	$DEBUG = 0;
 }

 debug (0, "sig_usr1: decreasing DEBUG from $old to $DEBUG\n");

 return;

}

#######################

sub sig_usr2 {

 my $old = $DEBUG;
 
 $DEBUG += 1;
 if ($DEBUG >10 ) {
	$DEBUG = 10;
 }

 debug (0, "sig_usr2: increasing DEBUG from $old to $DEBUG\n");

 return;

}

#######################

sub child {

	local $conn_time = time;
	# my $conn_date = localtime($conn_time);
	my $bl_list = ""; # list of DNSBL matches for connecting client
	my $host_type = "" ; # dynamic,dynamic2, etc. for logging
	my $input;
	my $cur_input;
	my $n;
	my $d;
	my $hostname;
	my $rdns_true;
	my $so;
	my $host_rdns; # short version of $so for logging
	my $have_ehlo;
	my $ehlo_proto;
	my $have_mail;
	my $had_any_mail;
	my $have_rcpt;
	my $rcpt_list;
	my $have_data;
	my $have_eof;
	my $t_banner;	# time banner was sent
	my $t_ehlo;	# time EHLO/HELO was seen from client
	my $t_mail;	# time MAIL FROM: was seen
	my $t_rcpt;	# time RCPT TO: was seen
	my $t_data;	# time DATA was seen
	my $t_eof;	# time EOF of data stream was seen
	my $ehlo_param; # what did EHLO/HELO have as parameter
	my $ehlo_true;	# 0 = pretends to be us, 1 = blatantly forged or not FQDN , 2 = ok
	my $last_cmd_at = $conn_time ; # for idle timer
	my $last_cmd;	# which cmd was it?
	my $cmd;
	my $mail_param; # what did MAIL FROM: have as parameter
	my $mail_true;	# 0 = pretends to be us, 1 = blatantly forged/freemail , 2 = other
	my $rcpt_param; # what did MAIL FROM: have as parameter
	my $rcpt_n;	# number of RCPT TO: lines
	my $data_n;	# number of DATA lines
	# my $virtusers_open = 0; # have we opened the /etc/mail/virtusertable file yet?
			# moved this to parent - inheriting this variable from there
	# my %users;	# virtusertable hash
			# moved this to parent - inheriting this variable from there
	my $sm_qid;	# QID for sendmail-style logging


	if ($smc) {
		# generate QID for sendmail-style logging
		my ($sec,$min,$hour,$mday,$mon);
		($sec,$min,$hour,$mday,$mon,,,,) = localtime(time);
		$sm_qid = sprintf "%02u%02u%02u%02uP%05u", $mon+1 , $mday, $hour, $min, $$ ;
		#	example: 02261537P04573 (assuming PIDs are never more than 5 digits)
	}

	# who are we talking to? IP:port - now inherited from parent
	# $peer_ip = inet_ntoa ( $client->peeraddr() );
	# $peer_port = $client->peerport();

	$0 = "$sn: [$peer_ip] connect - checking rDNS";

	# rDNS checks
	($hostname,$rdns_true) = rdns_check($peer_ip);

	if ($rdns_true == 0) {
		$so = "([NO rDNS])";
		$host_rdns = "none";
	} elsif ($rdns_true == 1) {
		$so = "([FORGED!] $hostname)";
		$host_rdns = "forged";
	} elsif ($rdns_true == 2) {
		$so = "([FCrDNS] $hostname)";
		$host_rdns = "ok";
	} else {
		$so = "([unknown rDNS status] $hostname)";
		$host_rdns = "unknown_forged"; # unknown_forged has more meaning below
	}

	debug (0, "connect $peer_ip:$peer_port $so\n");

	$0 = "$sn: [$peer_ip] connect - checking DNSBLs";

	# DNSBL lookups
	if ( $bl_list = dnsbl_lookups($peer_ip) ) {
		$d = elap();
		debug (0, "$d sec: [$peer_ip] DNSBL-listed in $bl_list\n");
	} else {
		$d = elap();
		debug (0, "$d sec: [$peer_ip] not DNSBL-listed.\n");
	}

	if ($host_rdns =~ /forged|none/) {
		$host_type = "untrusted";
	} else {
		$host_type = "default";
	}
	if ($hostname =~ /(?:ppp|dialup|dial|dsl|\.cable|\.dip|modem|pool|pooles|\.dyn|dynamic|\.abo|\.client|\..*?-ip|\.in-addr|\.reverse|\.cablemodem|dhcp|resnet\.)/ ) {
		debug (0, "$d sec: [$peer_ip] is dynamic Dialup/Cable/DSL host\n");
		$host_type = "dynamic_ip";
	} elsif ( $hostname =~ /\d{1,3}.\d{1,3}.\d{1,3}/ ) {
		# typically: m235.net81-64-119.noos.fr or c-67-162-0-11.client.comcast.net
		debug (0, "$d sec: [$peer_ip] is dynamic host with script-generated rDNS name type 1\n");
		$host_type = "dynamic_ip2";
	} elsif ( $hostname =~/[a-fA-F0-9]{6,}/ ) {
		# typically: p5086423C.dip0.t-ipconnect.de or chello062178065024.22.11.vie.surfer.at or h00e018407897.ne.client2.attbi.com
		debug (0, "$d sec: [$peer_ip] is dynamic host with script-generated rDNS name type 2\n");
		$host_type = "dynamic_ip3";
	}

	$d = elap();
	$n = $banner_delay - $d;
	if ($n < 1) {
		$n = 0;
	}
	debug (3, "$d sec: DNSBL lookups done, sending SMTP banner in $n secs.\n");
	$0 = "$sn: [$peer_ip] delaying $n secs for SMTP banner";
	sleep $n;

	debug (3, "out: $smtp_banner\n");
	print $client "$smtp_banner\r\n";
	$t_banner = time;

	$0 = "$sn: [$peer_ip] $hostname - SMTP banner sent";

	CONNECTED:
	while (1) {

		$input = getinput(20); # this breaks entered lines in mid-stream - whatever - we can't hang here forever
		$d = elap();
		if (! defined $input ) {
			if (! $had_any_mail) {
				debug (0, "$d sec: [$peer_ip] did not issue MAIL/EXPN/VRFY/ETRN during connection to MTA\n");
				if ($smc && $use_syslog) {
					syslog ($cfg_smc_syslog_sev, "$sm_qid: $hostname [$peer_ip] did not issue MAIL/EXPN/VRFY/ETRN during connection to MTA");
					debug (0, "logged to smc: did not issue MAIL/EXPN/VRFY/ETRN during connection to MTA\n");
				}
			} else {
				debug (0, "$d sec: [$peer_ip] remote host closed connection.\n");
				if ($smc && $use_syslog) {
					syslog ($cfg_smc_syslog_sev, "$sm_qid: lost input channel from $hostname [$peer_ip] to MTA after $last_cmd");
				}
			}
			close ($client);
			last CONNECTED;
		}

		if ($input eq "") {
			# nothing seen yet. are we over time (5m)?
			if ((time - $last_cmd_at) > $cmd_timeout ) {
				print $client "554 Timeout $cmd_timeout"."s after $last_cmd. Good-bye.\r\n";
				debug (0, "$d sec: [$peer_ip] timeout on $last_cmd - $cmd_timeout"."s - closing connection\n");
				if ($smc && $use_syslog) {
					syslog ($cfg_smc_syslog_sev, "$sm_qid: timeout waiting for input from $hostname [$peer_ip] during server cmd $last_cmd");
				}
				close ($client);
				last CONNECTED;
			}
			next; # we got no input
		}

		# ok, we got SOMETHING

		# DATA phase
		if ($have_data) {
			$last_cmd_at = time; # keep this updated whenever data comes in
			# we are in the DATA phase, these are not commands
			if ($input eq ".") {
				# EOF
				$have_eof = 1;
				$have_data = 0; # end
				debug (0, "$d sec: [$peer_ip] end of DATA\n");
				sleep ($data_delay);
				debug (0, "out: [$peer_ip] $data_end\n");
				print $client "$data_end\r\n";
				$0 = "$sn: [$peer_ip] $hostname - EOF after DATA";
				next;
			}

			chomp $input; # make sure we don't log/print \n\n for an empty line
			debug (0, "[$peer_ip] DATA: $input\n");
			$data_n += 1;

			if ( ($data_n >= $data_max) || ( ($data_hdr_only) && ($input eq "") ) ) {
				if ($input eq "") {
					debug (0, "$d sec: [$peer_ip] read complete header up to $data_max lines - aborting.\n");
				} else {
					debug (0, "$d sec: [$peer_ip] read max. of $data_max DATA lines - aborting.\n");
				}
				debug (0, "out: [$peer_ip] $data_end\n");
				print $client "$data_end\n";
				close ($client);
				$d = elap();
				debug (0, "$d sec: we [forced] closed connection with [$peer_ip]\n");
				last CONNECTED;
			}
			# sleep 1; # one line per second, please
			# this might only hurt us, not them.
			next;
		}

		$last_cmd_at = time;
		$cmd = check_cmd ($input);
		$last_cmd = $cmd;

		if (! $cmd) {
			debug (0, "$d sec: [$peer_ip] sends illegal command: $input\n");
			sleep ($badcmd_delay);
			debug (3, "out: 504 Command parameter not implemented - use a spellchecker, asshole\n");
			print $client "504 Command parameter not implemented - use a spellchecker, asshole\r\n";
			# consider: 500 5.5.1 Command unrecognized
			next;
		}

		if ($cmd eq "quit") {
			debug (0, "$d sec: [$peer_ip] sends QUIT\n");
			if (! $had_any_mail) {
				debug (0, "$d sec: [$peer_ip] did not issue MAIL/EXPN/VRFY/ETRN during connection to MTA\n");
				if ($smc && $use_syslog) {
					syslog ($cfg_smc_syslog_sev, "$sm_qid: $hostname [$peer_ip] did not issue MAIL/EXPN/VRFY/ETRN during connection to MTA");
					debug (0, "logged to smc: did not issue MAIL/EXPN/VRFY/ETRN during connection to MTA\n");
				}
			}
			sleep ($quit_delay);
			debug (3, "out: 221 2.2.0 Good-bye\n");
			print $client "221 2.2.0 Good-bye\r\n";
			$d = elap();
			debug (0, "$d sec: [$peer_ip] : we closed connection after seeing QUIT\n");
			close ($client);
			#if ($virtusers_open) {
			#	# close this
			#	dbmclose(%users);
			#	$virtusers_open = 0 ;
			#}
			last CONNECTED;
		}

		if ($cmd eq "noop") {
			debug (0, "$d sec: [$peer_ip] sends NOOP\n");
			sleep ($noop_delay);
			debug (3, "child $$: out: 250 2.2.0 Ok\n");
			print $client "250 2.2.0 Ok\r\n";
			next;
		}

		if ($cmd eq "rset") {
			debug (0, "$d sec: [$peer_ip] sends RSET\n");
			debug (3, "out: 250 2.2.0 Ok\n");
			$have_mail = 0;
			$have_rcpt = 0;
			$rcpt_list = "";
			$rcpt_n = 0;
			$have_data = 0;
			# $have_eof = 0; 
			sleep ($rset_delay);
			print $client "250 2.2.0 Ok\r\n";
			#if ($virtusers_open) {
			#	# close this
			#	dbmclose(%users);
			#	$virtusers_open = 0 ;
			#}
			next;
		}

		if ( $cmd =~ /debug|help/ ) {
			# we're playing a joke here
			$d = elap();
			debug (0, "$d sec: [$peer_ip] sends \U$cmd\E\n");
			sleep ($badcmd_delay);
			debug (3, "out: 250-2.2.0 Ok\n");
			print $client "250-2.2.0 Ok\r\n";
			sleep ($badcmd_delay);
			debug (3, "out: 250 2.2.0 Ok\n");
			print $client "250 2.2.0 Ok\r\n";
			next;
		}

		if ( $cmd =~ /ehlo|helo/ ) {
			# ok, we got EHLO/HELO

			if ($have_ehlo) {
				# we already saw a EHLO/HELO . highly unusual, but RFC821 allows it
				debug (0, "$d sec: [$peer_ip] sends duplicate EHLO/HELO: $input\n");
				sleep ($ehlo_delay);
				debug (3, "out: 250 duplicate EHLO/HELO - you got any other tricks coming?\n");
				print $client "250 duplicate EHLO/HELO - you got any other tricks coming?\r\n";
				next;
			}

			if ($input =~ /(?i)^(?:ehlo|helo)\s(\S+)$/ ) {
				$have_ehlo = 1;
				$t_ehlo = time;
				$ehlo_param = $1;
				$0 = "$sn: [$peer_ip] $hostname - EHLO/HELO $ehlo_param";

				if ($smc && $use_syslog) {
					syslog ($cfg_smc_syslog_sev, "$sm_qid: helo=$ehlo_param [$peer_ip]");
				}

				if ($cmd eq "ehlo") {
					$ehlo_proto = "ESMTP";
				} else {
					$ehlo_proto = "SMTP";
				}

				if ($ehlo_param =~ /\[.*\]/ ) {
					# this is legal
					debug (0, "$d sec: [$peer_ip] sends RFC821-conform bracketed IPv4 addr as EHLO/HELO parameter: $input\n");
					sleep ($ehlo_delay);
					debug (3, "out: 250 A bracketed IPv4 addr. You really read RFC821 - Awwwwww.\n");
					print $client "250 A bracketed IPv4 addr. You really read RFC821 - Awwwwww.\r\n";
					$ehlo_true = 1;
					next;
				}
				if ($ehlo_param =~ /^[a-zA-Z0-9_\-]+$/ ) {
					debug (0, "$d sec: [$peer_ip] sends bareword EHLO/HELO parameter: $input\n");
					sleep ($ehlo_delay);
					debug (3, "out: 250 An unqualified bareword as a hostname? Can you read some fucking RFCs, dimwit?\n");
					print $client "250 An unqualified bareword as a hostname? Can you read some fucking RFCs, dimwit?\r\n";
					$ehlo_true = 1;
					next;
				}

				unless ( $ehlo_param =~ /^\d+\.\d+\.\d+\.\d+$/ ) {
					# we will not do a hostname lookup on an IP number as EHLO parameter
					$host_match = fdns_check ($ehlo_param,$peer_ip);
					debug (4,"host_match for $ehlo_param and $peer_ip is $host_match\n");
				}

				if ( ($ehlo_param eq $hostname) || ($host_match) ) {
					if ( ($rdns_true == 2) || ($host_match) ) {
						debug (0, "$d sec: [$peer_ip] sends FCrDNS hostname: $input\n");
						sleep ($ehlo_delay);
						debug (3, "out: 250 2.5.0 Ok, so you're really $ehlo_param - lets go on.\n");
						print $client "250 2.5.0 Ok, so you're really $ehlo_param - lets go on.\r\n";
						$ehlo_true = 2;
					} else {
						debug (0, "$d sec: [$peer_ip] unmatched/forged hostname: $input\n");
						sleep ($ehlo_delay);
						debug (3, "out: 250 2.5.0 You claim to be $hostname, but rDNS does not match this - lets go on.\n");
						print $client "250 2.5.0 You claim to be $hostname, but rDNS does not match this - lets go on.\r\n";
						$ehlo_true = 1;
					}
					next;
				}
				if ( ($ehlo_param =~ /($our_hostnames)\b/ ) || ($ehlo_param =~ /$service_addr/) ) {
					debug (0, "$d sec: [$peer_ip] EHLO/HELO pretends to be us: $input\n");
					sleep ($ehlo_delay);
					debug (3, "out: 250 2.5.0 So you pretend to be me, hmm? Come-on, give it your best shot!\n");
					print $client "250 2.5.0 So you pretend to be me, hmm? Come-on, give it your best shot!\r\n";
					$ehlo_true = 0;
					next;
				}
				if ($ehlo_param =~ /^\d+\.\d+\.\d+\.\d+$/ ) {
					debug (0, "$d sec: [$peer_ip] EHLO/HELO with bare IP number: $input\n");
					sleep ($ehlo_delay);
					debug (3, "out: 250 2.5.0 A bare IP number? Can you read some fucking RFCs, cretin?\n");
					print $client "250 2.5.0 A bare IP number? Can you read some fucking RFCs, cretin?\r\n";
					$ehlo_true = 1;
					next;
				}
				debug (0, "$d sec: [$peer_ip] EHLO/HELO forged parameter: $input\n");
				sleep ($ehlo_delay);
				debug (3, "out: 250 2.5.0 Ok, $ehlo_param wannabe, on with business\n");
				print $client "250 2.5.0 Ok, $ehlo_param wannabe, on with business\r\n";
				$ehlo_true = 1;
				next;
			} else {
				debug (0, "$d sec: [$peer_ip] sends broken EHLO/HELO: $input\n");
				sleep ($badcmd_delay);
				debug (3, "out: 550 5.5.0 Syntax error - you got any other tricks coming?\n");
				print $client "550 5.5.0 Syntax error - you got any other tricks coming?\r\n";
				next;
			}

		} # end of EHLO/HELO

		# MAIL FROM:
		if ($cmd eq "mailfrom" ) {

			if ($have_mail) {
				# we already saw a MAIL FROM:
				debug (0, "$d sec: [$peer_ip] sends duplicate MAIL FROM: $input\n");
				sleep ($badcmd_delay);
				debug (3, "out: 503 5.0.3 duplicate MAIL FROM: - you got any other tricks coming?\n");
				print $client "503 5.0.3 duplicate MAIL FROM: - you got any other tricks coming?\r\n";
				next;
			}

			if (! $have_ehlo) {
				# illegal MAIL FROM: before EHLO/HELO
				debug (0, "$d sec [$peer_ip] sends MAIL FROM before EHLO/HELO: $input\n");
				debug (3, "out: 503 5.0.3 Bad sequence: no MAIL before EHLO/HELO\n");
				print $client "503 5.0.3 Bad sequence: no MAIL before EHLO/HELO\n";
				next;
			}

			# ok, we got MAIL FROM
			if ($input =~ /(?i)^(?:mail from):\s*(<.*?>)(.*?)$/ ) {
				$have_mail = 1;
				$had_any_mail = 1;
				$t_mail = time;
				$mail_param = $1;
				$0 = "$sn: [$peer_ip] $hostname - MAIL FROM: $mail_param";

				if ($2 ne "") {
					debug (0, "$d sec: [$peer_ip] MAIL FROM: with extras: $input\n");
				}

				if ($mail_param =~ /\s/ ) {
					debug (0, "$d sec: [$peer_ip] MAIL FROM: address contains whitespace: $input\n");
					$mail_true = 1; # forgery
					$mail_param =~ s/\s//g ; # remove that whitespace
				}

				if ($mail_param =~ /.*?\@(.*\..*)/ ) {
					my $domain = $1;
					if ($domain =~ /($fake_hostnames)\b/) {
						$mail_true = 1; # forgery
						debug (0, "$d sec: [$peer_ip] forges well-known freemail address: $input\n");
					} elsif ( ($domain =~ /($our_hostnames)\b/ ) || ($domain eq $service_addr) ) {
						debug (0, "$d sec: [$peer_ip] pretends to be us: $input\n");
						$mail_true = 0; # us?
					} else {
						# regular MAIL FROM: command
						debug (0, "$d sec: [$peer_ip] $input\n");
					}
					sleep ($mail_delay);
					debug (3, "out: 250 2.2.0 Ok\n");
					print $client "250 2.2.0 Ok\r\n";
					next;
				} elsif ($mail_param eq "<>") {
					# null-sender
					debug (0, "$d sec: [$peer_ip] $input\n");
					sleep ($mail_delay);
					debug (3, "out: 250 2.2.0 Ok\n");
					print $client "250 2.2.0 Ok\r\n";
					next;
				} else {
					$mail_true = 1; # forgery
					debug (0, "$d sec: [$peer_ip] forges invalid address: $input\n");
					sleep ($mail_delay);
					print $client "250 2.1.0 You gotta come up with a real sender address, asswipe\r\n";
					debug (3, "out: 250 2.1.0 You gotta come up with a real sender address, asswipe\n");
					next;
				}

			} else {
				debug (0, "$d sec: [$peer_ip] MAIL FROM: broken: $input\n");
				sleep ($badcmd_delay);
				debug (3, "out: 550 5.5.0 Syntax error - you got any other tricks coming?\n");
				print $client "550 5.5.0 Syntax error - you got any other tricks coming?\r\n";
				next;
			}

		} # end MAIL FROM:


		# RCPT TO:
		if ($cmd eq "rcptto" ) {

			my $reject = ""; # possible RHS reject msg for this address

			if (! $have_mail) {
				# illegal RCPT TO: before MAIL FROM:
				debug (0, "$d sec: [$peer_ip] sends RCPT TO before MAIL FROM: $input\n");
				debug (3, "out: 503 Bad sequence: no RCPT TO before MAIL FROM\n");
				print $client "503 Bad sequence: no RCPT TO before MAIL FROM\n";
				next;
			}

			# ok, we got a RCPT TO:
			if ($input =~ /(?i)^(?:rcpt to):\s*(<.*?>)(.*?)$/ ) {
				$have_rcpt = 1;
				$rcpt_n += 1;
				$t_rcpt = time;
				$rcpt_param = $1;
				$0 = "$sn: [$peer_ip] $hostname - RCPT TO: $rcpt_param";

				if ($2 ne "") {
					debug (0, "$d sec: [$peer_ip] RCPT TO: with extras: $input\n");
				}

				if ($rcpt_param =~ /\s/ ) {
					debug (0, "$d sec: [$peer_ip] RCPT TO: address contains whitespace: $input\n");
				}

				if ( $rcpt_param =~ /<(.*?)>/ ) {
					my $rcpt = $1;
					my $rhs; # right-hand side

					$rcpt =~ s/\s//g ; # remove whitespace

					if ($rcpt_list ne "") {
						$rcpt_list .= ",";
					}
					$rcpt_list .= "<$rcpt>"; # only unqualified mailbox names have no angle-brackets

					#unless ($virtusers_open) {
					#	# we are opening this only once per session, on the first RCPT TO:
					#	dbmopen(%users,'/etc/mail/virtusertable',0600);
					#	$virtusers_open = 1 ;
					#}

					if ($virtusers_open) {
						my $lc_rcpt = lc $rcpt;
						$rhs = $users{$lc_rcpt}; # we don't have to do an exists() check - there's no auto-vivification with a dbm-tied hash
						if ($rhs ne "") {
							# match for this user@domain.tld in the virtusers file	
							# - is there a reject msg stored for this addres?
							if ($rhs =~ /error:nouser\s*\"(.*?)\"/) {
								# the reject message
								$reject = $1;
							} else {
								debug (4, "$d sec: [$peer_ip] SM virtusers file entry for $rcpt ignored.\n");
							}
						} else {
							# no match, let's try @domain.tld
							my $domain_here;
							if ($rcpt =~ /.*(\@.*)/ ) {
								$domain_here = lc $1;
								$rhs = $users{$domain_here};
								if ($rhs =~ /error:nouser\s*\"(.*?)\"/) {
									# the reject message
									$reject = $1;
								} else {
									debug (3, "[$peer_ip] sent RCPT $rcpt, virtusers entry for $domain_here: $rhs - no error:nouser line?\n");
								}
							} else {
								debug (0, "$d sec: [$peer_ip] failed to extract domain from $rcpt - can't match against wildcard virtusers entry.\n");
							}						
						}
					} # else: we couldn't open the /etc/mail/virtusertable file for some reason

					if ($rcpt_n <= $rcpt_n_max) {
						# we have a permitted number of RCPT TO:'s

						if ($reject eq "") {
							# case #1: the user supposedly exists - we are ignoring stunts with the /etc/mail/aliases for now
							# case #2: it's a SMTP relay attempt to the outside - which we'll accept for now
							# case #3: couldn't open/read virtusertable file
							debug (0, "$d sec: [$peer_ip] $input\n");
						} else {
							debug (0, "$d sec: [$peer_ip] $input - fails: $reject\n");
							if ($smc && $use_syslog) {
								syslog ($cfg_smc_syslog_sev, "$sm_qid: <$rcpt>... $reject");
							}
						}
					} else {
						# Too many RCPT TO:'s
						debug (0, "$d sec: [$peer_ip] $input - fails: 452 Too many recipients\n");
						if ($smc && $use_syslog) {
							# not quite Sendmail-like: we are keeping the "<$rcpt>... ", unlike SM
							syslog ($cfg_smc_syslog_sev, "$sm_qid: <$rcpt>... Too many recipients");
						}
					}

				} else {
						debug (0, "$d sec: [$peer_ip] illegal RCPT TO: parameter: $input - rejected.\n");					
						debug (3, "out: 550 5.5.0 That's not a proper RCPT TO parameter, that's garbage!\n");
						print $client "550 5.5.0 That's not a proper RCPT TO parameter, that's garbage!\r\n";
				}

				sleep ($rcpt_delay);

				if ($rcpt_n <= $rcpt_n_max) {
					my $out_msg;
					if ($reject ne "") {
						$out_msg = "$rcpt_reject_code $reject";
					} else {
						$out_msg = "250 2.2.0 Keep'em coming";
					}
					debug (3, "out: $out_msg\n");
					print $client "$out_msg\r\n";
				} else {
					debug (3, "out: 452 4.5.0 Too many recipients\n");
					print $client "452 4.5.0 Too many recipients\r\n";
				}

				next;

			} else {
				debug (0, "$d sec: [$peer_ip] RCPT TO: broken: $input\n");
				sleep ($badcmd_delay);
				debug (3, "out: 550 5.5.0 Syntax error - you got any other tricks coming?\n");
				print $client "550 5.5.0 Syntax error - you got any other tricks coming?\r\n";
				next;
			}

		} # end RCPT TO:

		# DATA
		if ($cmd eq "data" ) {

			#if ($virtusers_open) {
			#	# close this
			#	dbmclose(%users);
			#	$virtusers_open = 0 ;
			#}

			if ($have_mail && $have_rcpt && $data_max) {
				# have MAIL FROM:, RCPT TO: AND we permit DATA ($data_max)
				$have_data = 1;
				debug (1, "$d sec: [$peer_ip] cmd: $input\n");
				sleep ($data_delay);
				$0 = "$sn: [$peer_ip] $hostname - DATA";
				debug (3, "$d sec: [$peer_ip] out: 354 Enter mail, end with "." on a line by itself\n");
				print $client "354 Enter mail, end with "." on a line by itself\r\n";
				next;
			} else {
				$0 = "$sn: [$peer_ip] $hostname - DATA";
				if ($data_max) {
					# no MAIL FROM and RCPT TO: , but entering DATA phase?
					debug (0, "$d sec: [$peer_ip] sends DATA before RCPT TO: $input\n");
					debug (3, "out: 503 Bad sequence: no RCPT TO before DATA\n");
					print $client "503 Bad sequence: no RCPT TO before MAIL FROM\r\n";
					next;
				} else {
					debug (0, "$d sec: [$peer_ip] sends DATA - ignoring due to \$data_max=0 - out: 503 Can't do DATA right now\n");
					print $client "503 5.0.0 Can't do DATA right now\r\n";
					next;
				}
			}
		}

		debug (0, "$d sec: [$peer_ip] sends command we can't deal with yet: $input\n");
		$0 = "$sn: [$peer_ip] $hostname UNKNOWN CMD: $input";
		# sleep ($badcmd_delay);
		sleep 5;
		debug (3, "out: 451 I can't deal with this right now.\n");
		print $client "451 I can't deal with this right now.\r\n";
		sleep 2;

	} # CONNECTED

 $d = elap();
 debug (2, "Closed connection with [$peer_ip] after $d secs total\n");

 # it's logging time!
 if ($had_any_mail) {
	# we saw a MAIL FROM and can generate a from= line, we'll fake size=2000
	if ($smc && $use_syslog) {

		my $host_suffix = "";

		if ($hostname ne "") {
			# for formatting purposes only: can't have something like relay= [210.181.218.222]
			$hostname .= " ";
			# SM only adds this if there is a rdns name at all
			if ($host_rdns eq "unknown_forged") {
				$host_suffix = " (may be forged)";
			}
		}

		if ($bl_list eq "") {
			# we can alter this now, for logging purposes
			$bl_list = "none";
		}

		syslog ($cfg_smc_syslog_sev, "$sm_qid: from=$mail_param, size=2000, class=0, nrcpts=$rcpt_n, proto=$ehlo_proto, ehlo=$ehlo_param, daemon=$sn, dnsbls=$bl_list, host_type=$host_type, rdns=$host_rdns, relay=$hostname\l[$peer_ip]$host_suffix");
	}
 }

 if ($have_data || $have_eof) {
	# we have everything, so we can write a to= line, too
	if ($smc && $use_syslog) {
		# this better never be longer than 100 hrs
		my ($t_sec,$t_min,$t_hr,$t_str);
		$t_hr = int ($d / 3600);
		$t_min = int ( ($d - $t_hr * 3600) / 60);
		$t_sec = ($d - $t_hr * 3600 - $t_min * 60);
		$t_str = sprintf "%02u:%02u:%02u", $t_hr , $t_min, $t_sec ; 
		#
		syslog ($cfg_smc_syslog_sev, "$sm_qid: to=$rcpt_list, delay=$t_str, xdelay=$t_str, mailer=local, pri=0, dsn=4.0.0, stat=Deferred: caught in $sn trap");
	}
 }

 # debug (3, "child $$: good-bye\n");

 #if ($virtusers_open) {
 #	# close this
 #	dbmclose(%users);
 #}

 # we gotta detect state here and see if we lost the connection violating protocol
 exit;

}

#######################

sub dnsbl_lookups {

 use Net::DNS;
 my $ip = $_[0];
 my $bl;
 my $zone;
 my $rev_addr;
 my $h;
 my $listings = "";

 if ($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ ) {
	$rev_addr = "$4.$3.$2.$1";
 } else {
	debug (0, "child $$: no valid IP address $ip available for DNSBL lookups\n");
 }

 foreach $bl (keys %dnsbls) {

	$zone = $dnsbls{$bl};

	# print "child $$: looking up $rev_addr.$zone\n";

	$h = gethostbyname($rev_addr.".".$zone);

	if (defined ($h)) {
		# print "child $$: $ip listed in $bl\n";
		if ($listings ne "") {
			$listings .= ",".$bl;
		} else {
			$listings = $bl;
		}
	} else {
		# print "child $$: $ip not listed in $bl\n";
	}

 }

 return $listings;

}

#######################

sub rdns_check {

 my $ip = $_[0];
 my $n;
 my $hostname;
 my $ret = 0; # 0 no in-addr.arpa name, 1 if forged/non-matching rDNS, 2 verified FCRDNS, 3 unknown_forged
 my @h_ip;
 my $addr;
 my $ip_tmp;
 my $hostname_tmp;

 $n = pack ('C4', split /\./, $ip);
 $hostname = (gethostbyaddr $n, 2); # 2 = AF_INET . Is this portable?

 if (!defined ($hostname) ) {
	$hostname = "";
 }

 if ($hostname eq "") {
	# try this once more, some resolver libraries are a bit impatient
	sleep 1;
	$hostname = (gethostbyaddr $n, 2); # 2 = AF_INET . Is this portable?

	if (!defined ($hostname) ) {
		$hostname = "";
	}

 	if ($hostname eq "") {
		return ("",0);
	}
 }

 # ok, we have a rDNS name, but we assume it is unknown_forged
 $ret = 3;

 # ok, what IP addresses do we get with forward-resolving the hostname we got?
 (undef,undef,undef,undef,@h_ip) = gethostbyname $hostname ;
 unless (@h_ip) {
	# we failed to get any IPs, let's try this once more
	sleep 1;
	(undef,undef,undef,undef,@h_ip) = gethostbyname $hostname ;
 }

 # the hostname can have several IPs (stored in @h_ip) :
 for (@h_ip) {
	$addr = $_;
	($a1,$a2,$a3,$a4) = unpack('C4',$addr);
	$ip_tmp = "$a1.$a2.$a3.$a4";
	$hostname_tmp = (gethostbyaddr $addr, 2); # reverse-resolve this IP
	if ($hostname_tmp eq "") {
		# try this once more, some resolver libraries are a bit impatient
		sleep 1;
		$hostname_tmp = (gethostbyaddr $addr, 2); # reverse-resolve this IP
	}
        if ($hostname_tmp eq $ip_tmp) {
		# now this is special: some asses out there set their in-addr.arpa PTR TXT
		# record to the exact string of the IP number, e.g. "IN PTR 10.0.2.3", previously
		# resulting in mail to abuse|postmaster@2.3 and similar mook - no more!
		$ret = 1;
		last;
	}
	if ($hostname_tmp eq $hostname) {
		# we have FCrDNS
		$ret = 2;
		last;
	} else {
		# non-matching in-addr.arpa name
		$ret = 1;
	}
 }

 return ($hostname, $ret);

}

#######################

sub fdns_check {

 my $hostname;
 my $ip;
 ($hostname,$ip) = @_;
 my $ret = 0; # 0 no match, 1 verified DNS name
 my @h_ip;
 my $addr;
 my $ip_tmp;

 if ($hostname eq "") {
	return (0);
 }

 # ok, we have a rDNS name

 # ok, what IP addresses do we get with forward-resolving the hostname we got?
 (undef,undef,undef,undef,@h_ip) = gethostbyname $hostname ;

 # the hostname can have several IPs (stored in @h_ip) :
 for (@h_ip) {
	$addr = $_;
	($a1,$a2,$a3,$a4) = unpack('C4',$addr);
	$ip_tmp = "$a1.$a2.$a3.$a4";

	if ($ip eq $ip_tmp) {
		# we have verified FDNS
		$ret = 1;
		last;
	}
 }

 return ($ret);

}

#######################

sub elap {

 return (time - $conn_time);

}

#######################

sub debug {

 my ($level, $msg) = @_;

 my $date_str;
 my ($sec,$min,$hour,$mday,$mon,$year);

 if ($DEBUG >= $level){
	($sec,$min,$hour,$mday,$mon,$year,,,) = localtime(time);
	$year += 1900; $mon += 1;

	$date_str = sprintf "%4u/%02u/%02u %02u:%02u:%02u", $year, $mon, $mday, $hour, $min, $sec;
	
 } else {
	return;
 }

 # write to STDOUT in any case
 print "$date_str: $sn\l[$$]: $msg";

 if (! $use_syslog) {
	return;
 }

 if (! $smc) {
	# write our regular debug info to syslog, not the Sendmail-look-alike version 
	if ($use_syslog) {
		syslog ($cfg_syslog_sev, $msg);
	}
	return ;
 }

 # else, we are trying to log looking like Sendmail
 # - and we can't do that for ordinary debug() msgs

		# if ($smc) {
		#	syslog($cfg_smc_syslog_sev, $msg);
		# } else {

}

#######################

sub getinput {

my $timeout = $_[0];
my $input;

 eval {
	local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
	alarm $timeout;
	$input = "";
	unless (defined ( $input = <$client> ) ) {
		alarm 0;
		return;
	}
	$input =~ s/\r//g; # get a possible CR - this is network input!
	unless ($input eq "\n") {
		chomp $input; # get the LF, unless it's an empty line
	}
	# print "child $$: got something \($input\) in the eval\n";
	alarm 0;
 };

 return $input;

}


#######################

sub check_cmd {

my $input = $_[0];
my $cmd;


 if ($input =~ /(?i)^(EHLO |HELO |MAIL FROM|RCPT TO|DATA|RSET|NOOP|QUIT|VRFY|EXPN|DEBUG|HELP)/ ) {
	$cmd = lc ($1);
	$cmd =~ s/\s//g;
	debug (3, "child $$: check_cmd: saw command $cmd\n");
	return $cmd;
 }

 debug (3, "child $$: check_cmd: saw invalid command $cmd\n");
 return 0;

}

#######################