lightnin!rwsys!trsvax!utacfd.uta.edu!news.oc.com!lgc.com!cs.utexas.edu!uunet!usc!rpi!scott.skidmore.edu!psinntp!psinntp!internet!sbi!zeuswtc!cyclone!bet Mon Oct  5 20:51:14 CDT 1992
Article: 1056 of comp.lang.perl
Path: lightnin!rwsys!trsvax!utacfd.uta.edu!news.oc.com!lgc.com!cs.utexas.edu!uunet!usc!rpi!scott.skidmore.edu!psinntp!psinntp!internet!sbi!zeuswtc!cyclone!bet
From: bet@sbi.com (Bennett E. Todd @ Salomon Brothers Inc., NY )
Newsgroups: comp.lang.perl
#Subject: Re: a perl program which is run from inetd
Message-ID: <716@cyclone.sbi.com>
Date: 30 Sep 92 21:10:05 GMT
References: <1992Sep24.014021.7410@unilabs.uucp> <1992Sep24.180516.860@netlabs.com>
Sender: news@cyclone.sbi.com
Organization: Salomon Brothers, Inc.
Lines: 223


Here's an example daemon. I continue to twiddle and tweak it periodically.

#/usr/bin/perl

# Location of hosts DBM database
$hosts = '/usr/local/etc/hosts';

# Smtpd: SMTP daemon
#
# Install with a line like so in /etc/inetd.conf:
#  smtp stream tcp nowait root .../smtpd %A

# If we print anything, let's make it look like Internet goop.
$\="\r\n"; # output line delimiter


# Save hostname for a zillion messages; date is needed for mail header
$hostname=`hostname`;
chop $hostname;
$date = `date`;
chop $date;

# Parse arg. The %A above cause $ARGV[0] to be something like 810e5850.2569
$ARGV[0] =~ s/^([0-9a-e][0-9a-e])// || die "500 bad address\r\n221 $hostname stopped";
$o1 = hex($1);
$ARGV[0] =~ s/^([0-9a-e][0-9a-e])// || die "500 bad address\r\n221 $hostname stopped";
$o2 = hex($1);
$ARGV[0] =~ s/^([0-9a-e][0-9a-e])// || die "500 bad address\r\n221 $hostname stopped";
$o3 = hex($1);
$ARGV[0] =~ s/^([0-9a-e][0-9a-e])// || die "500 bad address\r\n221 $hostname stopped";
$o4 = hex($1);
$ARGV[0] =~ s/^\.([0-9][0-9][0-9][0-9])// || die "500 bad address\r\n221 $hostname stopped";
$port = $1;
$via="$o1.$o2.$o3.$o4";

# Try to translate ``via'' IP address into hostname. Don't sweat it if you can't.
#open(HOSTS,'</etc/hosts') || die "500 cannot open /etc/hosts\r\n221 $hostname stopped";
#lookup: while (<HOSTS>) {
#	/^$via[ 	]*([^ 	]*)/ && do { $via=$1; last lookup;};
#};
#close(HOSTS) || die "500 cannot close /etc/hosts\r\n221 $hostname stopped";
dbmopen(%hosts,$hosts,undef) && do {
	($_ = $hosts{$via}) && ($via = $_);
	dbmclose(%hosts);
};

# Suck up passwd file. There are other ways this could be implemented....
open(PASSWD, '</etc/passwd') || die "500 cannot open /etc/passwd\r\n221 $hostname stopped";
while(<PASSWD>) {
	chop;
	($pw_logname, $pw_passwd, $pw_uid, $pw_gid, $pw_gcos, $pw_home, $pw_shell) = split(/:/);
	$pw_passwd{$pw_logname} = $pw_passwd;
	$pw_uid{$pw_logname} = $pw_uid;
	$pw_gid{$pw_logname} = $pw_gid;
	$pw_gcos{$pw_logname} = $pw_gcos;
	$pw_home{$pw_logname} = $pw_home;
	if ($pw_shell eq '') {
		$pw_shell{$pw_logname} = '/bin/sh';
	} else {
		$pw_shell{$pw_logname} = $pw_shell;
	};
};

# Prepare for dialogue.
$|=1;      # Unbuffered writes
$/="\r\n"; # input line delimiter

# Opening greetings
print "220 $hostname Smtpd";

# This is the SMTP protocol, deduced by experimenting against a sendmail.
# Sure, I could have busted it up into subroutines. With lables on the blocks
# I think this is just as clear. It is certainly one hell of a big loop, though.
parse_command: while (<STDIN>) {
	chop;chop;
	/^helo *(.*)/i && do {
		$claim=$1;
		print "250 $hostname Hello $claim ($via), pleased to meet you";
		next parse_command;
	};
	/^help$/i && do {
		print '214-Commands:';
		print '214-	HELO	MAIL	RCPT	DATA	RSET';
		print '214-	NOOP	QUIT	HELP	VRFY	EXPN';
		print '214-For more info use "HELP <topic>".';
		print '214-smtp';
		print '214-Report bugs in the implementation to Bent.';
		print '214 End of HELP info';
		next parse_command;
	};
	s/^help *(.*)/\1/i && do {
	  helpswitch: {
		/helo/i && do {
			print '214-HELO <hostname>';
			print '214-	Introduce yourself.  I am a boor, so I really don\'t';
			print '214-	care if you do.';
			last helpswitch;
		};
		/mail/i && do {
			print '214-MAIL FROM: <sender>';
			print '214-	Specifies the sender.';
			last helpswitch;
		};
		/rcpt/i && do {
			print '214-RCPT TO: <recipient>';
			print '214-	Specifies the recipient.  Can be used any number of times.';
			last helpswitch;
		};
		/data/i && do {
			print '214-DATA';
			print '214-	Following text is collected as the message.';
			print '214-	End with a single dot.';
			last helpswitch;
		};
		/rset/i && do {
			print '214-RSET';
			print '214-	Resets the system.';
			last helpswitch;
		};
		/noop/i && do {
			print '214-NOOP';
			print '214-	Do nothing.';
			last helpswitch;
		};
		/quit/i && do {
			print '214-QUIT';
			print '214-	Exit smtpd (SMTP).';
			last helpswitch;
		};
		/help/i && do {
			print '214-HELP [ <topic> ]';
			print '214-	The HELP command gives help info.';
			last helpswitch;
		};
		/vrfy/i && do {
			print '214-VRFY <recipient>';
			print '214-	Not implemented to protocol.  Gives some sexy';
			print '214-	information.';
			last helpswitch;
		};
		/expn/i && do {
			print '214-EXPN <recipient>';
			print '214-	Same as VRFY in this implementation.';
			last helpswitch;
		};
		print '504 HELP topic unknown';
		next parse_command;
	  };
	  print '214 End of HELP info';
	  next parse_command;
	};
	/^mail from: *(.*)/i && do {
		$from=$1;
		print "250 $from... Sender ok";
		next parse_command;
	};
	/^noop/ && do {
		print "200 OK";
		next parse_command;
	};
	/^quit/i && do {
		print "221 $hostname closing connection";
		exit(0);
	};
	/^rset/i && do {
		print '250 Reset state';
		next parse_command;
	};
	s/^(vrfy|expn) *(.*)/\2/i && do {
		s/@$hostname//;
		if ($pw_uid{$_} eq '') {
			print "550 $_... User unknown";
			next parse_command;
		};
		print "250 $pw_gcos{$_} <$_>";
		next parse_command;
	};
	s/^rcpt to: *(.*)/\1/i && do {
		s/^.*<([^>]*)>.*$/\1/;
		s/@$hostname//;
		if ($pw_uid{$_} eq '') {
			print "550 $_... User unknown";
			next parse_command;
		};
		push(@recipients,$_);
		print "250 $_... Recipient ok";
		next parse_command;
	};
	/^data/i && do {
		if ($from eq '') {
			print '503 Need MAIL command';
			next parse_command;
		};
		if ($#recipients < 0) {
			print '503 Need RCPT (recipient)';
			next parse_command;
		}
		open(BINMAIL,"|/bin/mail @recipients") || die "500 cannot call /bin/mail\r\n221 $hostname stopped";
		$sender = $from;
		$sender =~ s/^.*<([^>]*)>.*$/\1/;
		$sender =~ s/@.*$//;
		print BINMAIL "From $sender $date" || die "500 cannot send data to /bin/mail\r\n221 $hostname stopped";
		print BINMAIL "From: $from" || die "500 cannot send data to /bin/mail\r\n221 $hostname stopped";
		print BINMAIL "Received: $via ($claim)" || die "500 cannot send data to /bin/mail\r\n221 $hostname stopped";
		print BINMAIL "To: @recipients" || die "500 cannot send data to /bin/mail\r\n221 $hostname stopped";
		print '354 Enter mail, end with "." on a line by itself';
		while (<STDIN>) {
			chop;chop;
			/^\.$/ && do {
				close BINMAIL || die "500 cannot close /bin/mail pipe\r\n221 $hostname stopped";
				print '250 Mail accepted';
				$#recipients = 0;
				$from = '';
				next parse_command;
			};
			print BINMAIL || die "500 cannot send data to /bin/mail\r\n221 $hostname stopped";
		}
		close BINMAIL;
		exit 0;
	};
	print "500 Command unrecognized";
};