#!/usr/bin/perl -w
# $Id: smtpd.pl,v 1.3 2002/11/27 06:39:40 candy Exp candy $

require 5.003;
use strict;
use POSIX;
use Socket;
use Getopt::Std;

my $hostname; # このホスト名
my $logfile = "smtpd.log";

sub autoflush($$) {
	my($so, $flag) = @_;
	select((select($so), $| = $flag)[0]);
}

sub printlog1($) {
	my($s) = @_;
	if (open(LOGFP, ">>$logfile")) {
		printf(LOGFP $s);
		close(LOGFP);
	}
}

sub binding($$$) {
	my($so, $local, $port) = @_;
	my($err, $proto, $iaddr, $paddr);
	$err = -1;
	$proto = getprotobyname("tcp");
	if ($port !~ /^[0-9]+$/) {
		$port = getservbyname($port, "tcp");
	}
	if ($iaddr = inet_aton($local)) {
		$paddr = sockaddr_in($port, $iaddr);
		if (socket($so, PF_INET, SOCK_STREAM, $proto)) {
			if (bind($so, $paddr)) {
				if (setsockopt($so, SOL_SOCKET, SO_REUSEADDR, 1)) {
					$err = 0;
				}
				else {
					printlog1("setsockopt: $!\n");
				}
			}
			else {
				printlog1("bind: $!\n");
			}
		}
		else {
			printlog1("socket: $!\n");
		}
	}
	else {
		printlog1("inet_aton: $!\n");
	}
	return $err;
}

sub send_line($@) {
	my($so, $form, @arg) = @_;
	my $line = sprintf($form, @arg);
	printf(LOGFP "%s", ">>> $line");
	printf($so $form, @arg);
	return 0;
}

sub get_line($) {
	my($so, $line) = @_;
	if ($line = <$so>) {
		printf(LOGFP "%s", "<<< $line");
	}
	else {
		printf(LOGFP "get_line: $!\n");
	}
	return $line;
}

sub oain($) {
	my($so, $line, $done, $iscmd) = @_;
	my($body);
	send_line($so, "220 %s\r\n", $hostname);
	$done = 0;
	$iscmd = 1;
	while (!$done && ($line = get_line($so))) {
		chomp($line);
		$line =~ s/\r//;
		if ($iscmd) {
			if ($line =~ /^QUIT/i) {
				send_line($so, "221 %s\r\n", $hostname);
				$done = 1;
			} elsif ($line =~ /^HELO/i) {
				send_line($so, "250 %s\r\n", $hostname);
			} elsif ($line =~ /^RSET/i) {
				send_line($so, "250 Reset state\r\n");
			} elsif ($line =~ /^MAIL/i) {
				send_line($so, "250 ok\r\n");
			} elsif ($line =~ /^RCPT/i) {
				send_line($so, "250 ok\r\n");
			} elsif ($line =~ /^DATA/i) {
				send_line($so, "354 go ahead\r\n");
				$iscmd = 0;
				$body = "";
			}
			else {
				send_line($so, "500 unknown\r\n");
			}
		}
		else {
			$body .= $line . "\n";
			if ($line =~ /^\.$/) {
				send_line($so, "250 accepted\r\n");
				$iscmd = 1;
			}
		}
	}
	return 0;
}

sub print_name($) {
	my($so, $sa, $port, $iaddr, $hostname, $address) = @_;
	$sa = getpeername($so);
	($port, $iaddr) = unpack_sockaddr_in($sa);
	$hostname = gethostbyaddr($iaddr, AF_INET);
	$address = inet_ntoa($iaddr);
	printf(LOGFP "%s: Connect from %s:%d [%s]\n", strftime("%Y/%m/%d-%H:%M:%S", localtime()), $address, $port, $hostname);
	return ($iaddr, $port);
}

sub nain($) {
	my($port, $sock, $so) = @_;
	$sock = \*SOCK;
	$so = \*SO;
	$so = \*SO;
	if (binding($sock, "0.0.0.0", $port) == 0) {
		autoflush($sock, 1);
		if (listen($sock, 3)) {
			printlog1("waiting for connection\n");
			while (1) {
				if (accept($so, $sock)) {
					if (open(LOGFP, ">>$logfile")) {
						autoflush($so, 1);
						print_name($so);
						oain($so);
						close($so);
						printf(LOGFP "%s: Connection closed\n",strftime("%Y/%m/%d-%H:%M:%S", localtime()));
						close(LOGFP);
					}
				}
				else {
					printlog1("accept: $!\n");
				}
			}
		}
		else {
			printlog1("listen: $!\n");
		}
	}
	close(SOCK);
	return -1;
}

sub gethostname() {
	my $s = "";
	if (open(P, "hostname|")) {
		$s = <P>;
		chomp($s);
		close(P);
	}
	return $s;
}

sub main() {
	my($ex, $port);
	autoflush(\*STDOUT, 1);
	$port = "smtp";
	getopts("p:");
	if ($main::opt_p) {
		$port = $main::opt_p;
	}
	$hostname = gethostname();
	$ex = nain($port) < 0;
	return $ex;
}

exit(main());