#!/usr/bin/perl -w

# WARNING!
#
# Before starting to use mephistoles maild, be sure to check
# whether you don't prefer qmail or some other "real" mail daemon.

# ABOUT
#
# This is Mephistoles MAILd, a little insecure mail-server with
# pop3 and smtp support, written entirely in perl (a write-only programming language)!
# The serverframework is based on Mephistoles HTTPd (which in turn
# is based on several other small programs).
# This program is placed under the GNU General Public License (GPL).
# Enjoy and send bugfixes to: Ruwen Böhm <kwench79@yahoo.de> !

# INSTALLATION
#
# Set up a directory for your mail spool (preferably /var/maild/),
# create a user/password file "passwd" in this dir with syntax
# <username> <password>
# for each desired user, and create "hostnames" with
# a list of valid hostnames for this server,
# change (or don't change) some preferences, and your set!
# Simply run maild and have fun!
# 
# PREREQUISITES
#
# Perl5 + standard modules (obviously...)
# MIME::Base64
# Net::DNS
# Digest::MD5

# RANDOM FEATURES (=BUGS AND CAVEATS)
#
# - proprietary logging instead of syslog

# ROADMAP & TODO
#
# - strip module use, so we don't need such a big perl install
# - better check of correct localname when sending mail
# - better MX code that works with chroot() and other security options

# HISTORY (CHANGES SINCE LAST VERSION)
#
# 0.1.0pre2 (2004-09-24)
# - various bugfixes (typo with mboxes, CRLF as terminator in LIST and RETR)
# - documentation! :-)
# - better hostname support
#
# 0.1.0pre1 (2004-09-23): first version :-)

our $rid="Mephistoles MAILd 0.1.0pre2 (2004-09-24)";

use POSIX;
use Socket qw(:DEFAULT :crlf);
use Carp;
use Fcntl;

use strict;

### server configuration ##################################################

our $mroot="/var/maild/";		# document root

our $logfile="/var/log/maild.log";	# where to log
our $logpolicy=3;			# 1: overwrite, 2: backup, 3: add

### server performance and options ########################################

our $children=30;			# limit number of children

our $secure=0;				# use chroot() and new session

our $securedaemon=0;			# drop privileges:
our $daemonuser="nobody";		# run as this user (e.g. www-data)
#$daemongroup="www";			# ... in this group

our $ipignore="";			# drop requests from these IPs
our $ipallow="";			# allow only these IPs

### end of config #########################################################

### subroutines ###########################################################

our %passwd;
our $site="";

### sub: logging functions ################################################

sub logmsg {
	print LOG scalar localtime,": @_\n";
}

### sub: base64 encoding and decoding #####################################

use MIME::Base64;

sub b64e {
	return encode_base64(shift);
}

sub b64d {
	return decode_base64(shift);
}

### sub: string converting / validation ###################################

sub conv {
	my $sr=shift;
	$sr =~ s/\%([A-Fa-f\d]{2})/chr hex $1/eg;
	# nice, eh? replace all occurences with % followed by two
	# numbers and/or characters a-f with the corresponding
	# ASCII-character after hex-converting
	return $sr;
}

sub sanename {		# check whether a string may be passed to a system-call with fs-access
	my $sr=shift;
	return 0 if (!defined $sr);
	return 0 if (length($sr)<1); # string should be 1 char long, at least!
	return 0 if (substr($sr,-1) eq "|"); # a trailing "|" commands perl to use the file as pipe
	return 0 if (index($sr,"\0")>-1); # a NULL byte is not POSIX compliant
	return 0 if (index($sr,"/../")>-1); # we don't want our script to go one dir up!
	return 1;
}

### sub: threading functions ##############################################

sub spawn {
	my $coderef = shift;
		unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
			confess "usage: spawn CODEREF";
		}
	my $pid;
	if (!defined($pid = fork)) {
		logmsg "cannot fork: $!";
		return;
	} elsif ($pid) {
		return; # I'm the parent
	}
	# else I'm the child -- go spawn
	open(STDIN,  "+<&Client")   || die "can't dup client to stdin";
	open(STDOUT, "+>&Client")   || die "can't dup client to stdout";
	select(STDOUT); $|=1;
	exit &$coderef();
	close(STDIN); close(STDOUT);

}

### sub: pop3 server ###################################################

our %mails;
our $tsize=0;

use Digest::MD5;

sub describe {
	my $user=shift;
	my $num=shift;
	if (!sanename($num)) {
		logmsg "invalid msgnum \"$num\"!";
		die "hacker...";
	}
	my $length=-s $main::mroot."/mboxes/$user/$num";
	logmsg "file \"".$main::mroot."/mboxes/$user/$num"."\" has invalid length" unless ($length>0);
	my $uidl;
	if (open(FILH,"<".$main::mroot."/mboxes/$user/$num")) {
		binmode(FILH);
		$uidl=Digest::MD5->new->addfile(*FILH)->hexdigest;
		close(FILH);
	} else {
		logmsg "cannot open file \"".$main::mroot."/mboxes/$user/$num"."\" for MD5 hashing";
		$uidl="DEADBEEF";
	}
	return ($length,$uidl);
}

sub maillist {
	my $user=shift;
	if (!sanename($user)) {
		logmsg "invalid user \"$user\"!";
		die "hacker...";
	}
	opendir(DIR,$main::mroot."/mboxes/$user") || (logmsg "cannot read mbox for $user" && die "no dir");
	my $de;
	while($de=readdir(DIR)) {
		next if (($de eq ".") || ($de eq ".."));
		my ($len,$uidl)=describe($user,$de);
		$mails{$de}{"len"}=$len;
		$mails{$de}{"uidl"}=$uidl;
		$tsize=$tsize+$len;
	}
	closedir(DIR);
}

sub serve_pop3 {
	my $iaddr = shift;
	my $buf="";

	my $state="auth";
	my $user="";

	my %tdel;
	
	my $helo="Mephistoles MAILd pop3 server at $site ready to rock'n'roll! ".rand(1337);	# for APOP
	print "+OK $helo$CR$LF";
	logmsg "$iaddr - pop3 initiated";
	while ($buf = <STDIN>) {
		$buf=~s/$CR?$LF/\n/;	# replace CRLF with LF
		my $pbuf=lc($buf);
		
		my ($cmd,$opt)=(split(/\s+/, $pbuf));

		# commands in all states
		if ($cmd eq "quit") {
			print "+OK See you! ";
			my $key;
			foreach $key (sort (keys %tdel)) {
				print "del$key ";
				if (sanename($key)) { 
					unlink(($main::mroot."/mboxes/$user/".$key));
				}
			}
			print "\n";
			return;
		}
		
		if ($state eq "auth") {	# commands in certain states
			if ($cmd eq "apop") {
				my ($dummy,$uname,$upassenc)=(split(/\s+/,$buf));
				if (defined($passwd{$uname})) {
					my $renc=Digest::MD5->new->md5_hex($helo.$passwd{$uname});
					if ($renc eq $upassenc) {
						maillist($user);
						$state="trans";
						print "+OK Come in, buddy!$CR$LF";
					} else {
						sleep(2);
						print "-ERR No, that's not the password!$CR$LF";
						logmsg "$iaddr - pop3 - wrong password";
					}
				} else {
					sleep(2);
					print "-ERR I don't know that guy!$CR$LF";
					logmsg "$iaddr - pop3 - wrong username";
				}
			} elsif ($cmd eq "user") {
				if (defined($passwd{$opt})) {
					print "+OK Yes, what's the password?$CR$LF";
					$user=$opt;
				} else {
					sleep(2);
					print "-ERR I don't know that guy!$CR$LF";
					logmsg "$iaddr - pop3 - wrong username";
				}
			} elsif ($cmd eq "pass") {
				if (!sanename($user)) {
					print "-ERR It would be helpful to have an username first!$CR$LF";
				} else {
					if ((defined $passwd{$user}) && ($passwd{$user} eq $opt)) {
						maillist($user);
						$state="trans";
						print "+OK Come in, buddy!$CR$LF";
					} else {
						sleep(2);
						print "-ERR No, that's not the password!$CR$LF";
						logmsg "$iaddr - pop3 - wrong password";
					}
				}
			} else {
				print "-ERR Unknown command, what about giving me your username first?$CR$LF";
				logmsg "$iaddr - pop3 - unknown command $cmd in auth-mode";
			}
		} elsif ($state eq "trans") {
			if ($cmd eq "stat") {
				print "+OK ".(keys(%mails))." $tsize\n";
			} elsif ($cmd eq "list") {
				if (sanename($opt)) {
					print "+OK ".$opt." ".$mails{$opt}{"uidl"}."\n";
				} else {
					print "+OK Mailbox has ".(keys(%mails))." messages waiting for you!$CR$LF";
					my $key;
					foreach $key (sort (keys %mails)) {
						print $key." ".$mails{$key}{"len"}."$CR$LF";
					}
					print ".$CR$LF";
				}
			} elsif ($cmd eq "retr") {
				if (sanename($opt)) {
					open(MFH,"<".$main::mroot."/mboxes/$user/".$opt);
					print "+OK Here's the news...$CR$LF";
					while(<MFH>) {
						s/\015?\012/\n/g;
						print $_;
					}
					print "$CR$LF.$CR$LF";
					close(MFH);
				}
			} elsif ($cmd eq "dele") {
				if (defined $mails{$opt}{"len"}) {
					$tdel{$opt}="KILL KILL KILL!!!";
					print "+OK Message \"$opt\" is doomed (marked for extinction)$CR$LF";
				} else {
					print "-ERR Message \"$opt\" is already lost$CR$LF";
				}
			} elsif ($cmd eq "noop") {
				print "+OK Doing nothing...\n";
			} elsif ($cmd eq "top") {
				if (sanename($opt)) {
					open(MFH,"<".$main::mroot."/mboxes/$user/".$opt);
					print "+OK Here's the first part of the message...$CR$LF";
					while(<MFH>) {
						last if (length($_)<3);
						s/\015?\012/\n/g;
						print $_;
					}
					print ".\n";
					close(MFH);
				}				
			} elsif ($cmd eq "uidl") {
				if (sanename($opt)) {
					print "+OK ".$opt." ".$mails{$opt}{"uidl"}."$CR$LF";
				} else {
					print "+OK Mailbox has ".(keys(%mails))." messages waiting for you!$CR$LF";
					my $key;
					foreach $key (sort (keys %mails)) {
						print $key." ".$mails{$key}{"uidl"}."$CR$LF";
					}
					print ".$CR$LF";
				}
			} else {
				print "-ERR Unknown command$CR$LF";
				logmsg "$iaddr - pop3 - unknown command $cmd in trans mode";
			}
		}
	}
}

sub install_pop3_server {
	print "Setting up pop3 server...\n";
	# open listening TCP networking socket
	my $proto = getprotobyname('tcp');
	socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "ABORT: socket: $!";
	setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,pack("l", 1))   || die "ABORT: setsockopt: $!";
	bind(Server, sockaddr_in(110, INADDR_ANY))        || die "ABORT: bind: $!";
	listen(Server,SOMAXCONN)                            || die "ABORT: listen: $!";

	logmsg "$rid @ 110 (pop3)";
	$0="pop3 father [accepting connections]";

	my $childcnt=0;

	$SIG{"CHLD"}=sub { while(waitpid(-1,1) > 0) { ; } $childcnt=$childcnt-1; }; # reap and count

	my $cip="";

	while(1) {
		my $paddr = accept(Client,Server);
		next if not $paddr;			# shouldn't happen
	
		my($port,$iaddr) = sockaddr_in($paddr);
		my $name = gethostbyaddr($iaddr,AF_INET);
		$cip=inet_ntoa($iaddr);

		if (index($main::ipignore,$cip)>-1) {	# if this IP is to ignore
			logmsg "blocking req from $cip:$port ($name) - on ignore-list";
			next;
		}
		if (length($main::ipallow)>0) {		# only certain IPs allowed
			if (index($main::ipallow,$cip)==-1) {	# this is not allowed
			logmsg "blocking req from $cip:$port ($name) - not on allowed-list";
				next;
			}
		}
	
		if ($childcnt>$children) {
			logmsg "server load to high - refused connect";
			next;
		}
	
		$childcnt++;  
		
		spawn sub {
			$0="pop3 child [serving $cip]";
			if ($main::securedaemon==1) {
				# permanently drops privs
				($<,$>) = ((scalar getpwnam($main::daemonuser)),(scalar getpwnam($main::daemonuser)));
				# ($(,$)) = (getuinam($daemongroup),getuinam($daemongroup));	# change group???
			}
			select(Client); $| = 1;
			serve_pop3($cip);
			close(Client);
		};
		close(Client);			# child has it's own
		
		# collect our dead children...
		while(waitpid(-1,1) > 0) { ; } # don't loathe SysV, love BSD! 8-)
	}	
}

### sub: smtp server ###################################################

sub place_msg {
	my $box=shift;
	my $mdata=shift;
	
	if (!sanename($box)) {
		logmsg "box $box is invalid";
		return 0;
	}
	if (-e $main::mroot.$box) {
		opendir(DIR,$main::mroot."/".$box) || (logmsg "cannot place mail in $box while reading dir" && die "no dir while spooling mail");
		my $de; my $hc=0;
		while($de=readdir(DIR)) {
			next if (($de eq ".") || ($de eq ".."));
			$hc=$de if ($de>$hc);
		}
		$hc++;
		closedir(DIR);
		open(SFH,">".$main::mroot."/".$box."/".$hc) || (logmsg "cannot place mail $hc in $box" && die "failed to open spool file");
		print SFH $mdata;
		close(SFH);
		logmsg "mail in box $box placed";
		return 1;
	} else {
		logmsg "box $box does not exist";
		if ($box ne "catch-all") {
			place_msg("catch-all",$mdata);
		}
		return 0;
	}
}

sub serve_smtp {
	my $iaddr = shift;
	my $buf="";

	my $state="noauth";
	my $user="";

	my $toa="";	# to address
	my $froma="";	# from address
	my $maild="";	# mail body

	my %tdel;
	
	my $helo="Mephistoles MAILd smtp server at $site ready to rock'n'roll! ".rand(1337);	# for CRAM-MD5
	print "220 $helo$CR$LF";
	logmsg "$iaddr - smtp initiated";
	while ($buf = <STDIN>) {
		$buf=~s/$CR?$LF/\n/;	# replace CRLF with LF
		my $pbuf=lc($buf);
		
		my ($cmd,$opt)=(split(/\s+/, $pbuf));
		
		# commands in all states
		if ($cmd eq "quit") {
			print "221 See you!$CR$LF";
			return;
		}
		
		if ($cmd eq "helo") {
			print "250 Yes, yes... spare me your lies about your hostname and give me mails!$CR$LF";
		}
		if ($cmd eq "ehlo") {
			print "250-$site$CR$LF";
			print "250-AUTH LOGIN PLAIN$CR$LF";		# add MD5
			print "250 AUTH=LOGIN PLAIN$CR$LF";
			#print "250 8BITMIME$CR$LF";
		}
		if ($cmd eq "auth") {
			my $uname; my $upass;
			if ($opt eq "login") {
				print "334 VXNlcm5hbWU6$CR$LF";
				$uname=<STDIN>; $uname=~s/$CR?$LF/\n/; $uname=b64d($uname);
				print "334 UGFzc3dvcmQ6$CR$LF";
				$upass=<STDIN>; $upass=~s/$CR?$LF/\n/; $upass=b64d($upass);
			} elsif ($opt eq "plain") {
				print "334 Friend or foe?$CR$LF";
				$buf=<STDIN>;
				$buf=~s/$CR?$LF/\n/;
				$pbuf=b64d($buf);
				($uname,$upass)=split("\000",substr($pbuf,1))
			} elsif ($opt eq "cram-md5") {		# program me !!! XXX
			} else {
				print "505 Unknown AUTH-method?$CR$LF";
				logmsg "$iaddr - smtp - auth - unknown method $opt";
			}				# fix me !!! XXX
			if (sanename($uname) && (defined $passwd{$uname}) && ($passwd{$uname} eq $upass)) {
				$user=$uname;
				$state="auth";
				print "235 Authorization ok!$CR$LF";
			} else {
				sleep(2);
				print "535 No, that's not the password!$CR$LF";
				logmsg "$iaddr - wrong password $upass for $uname";
			}
		}
		
		if ($cmd eq "mail") {
			# get email from mail
			# first style: MAIL FROM:<address>
			if ($pbuf=~/^(mail)(\s*)(from:)(\s*?)(\<)(.*)(\>)/g) {
				$froma=$6;
				print "250 Spare me the lies about the origin being $froma, give me date instead!$CR$LF";
			} elsif ($pbuf=~/^(mail)(\s*)(from:)(\s*?)(.*)/g) {
				$froma=$5;
				print "250 Spare me the lies about the origin being $froma, give me date instead!$CR$LF";
			} else {
				print "553 I'm to stupid to parse this e-mail address, forgive me and try again!$CR$LF";
			}
		}
		if ($cmd eq "rcpt") {
			# get email from rcpt
			# first style: RCPT TO:<address>
			if ($pbuf=~/^(rcpt)(\s*)(to:)(\s*?)(\<)(.*)(\>)/g) {
				$toa=$6;
				print "250 We'll try to reach this guy called $toa...$CR$LF";
			} elsif ($pbuf=~/^(rcpt)(\s*)(to:)(\s*?)(.*)/g) {
				$toa=$5;
				print "250 We'll try to reach this guy called $toa...!$CR$LF";
			} else {
				print "553 I'm to stupid to parse this e-mail address, forgive me and try again!$CR$LF";
			}
		}
		if ($cmd eq "data") {
			if (sanename($toa)) {
				my ($localp, $hostp) = split(/\@/,$toa);
				if (($state eq "noauth") && (substr($toa,-length($site)) ne $site)) {
					# outbound mail without auth
					print "550 Please authenticate before sending spam!$CR$LF";
				} elsif (($state eq "noauth") && (substr($froma,-length($site)) eq $site)) {
					# mail from local user
					print "550 You shall not lie about your FROM!$CR$LF";
				} else {
					# accept mail
					$maild="Received: server $site accepted mail from $iaddr on ".(scalar localtime);
					print "354 I'm listening...$CR$LF";
					while($buf=<STDIN>) {
						$buf=~s/\015?\012/\n/g;
						last if ($buf eq ".\n");
						$maild.=$buf;
					}
					if (substr($toa,-length($site)) ne $site) {	# outbound
						spawn sub { mx_msg($toa,$maild,$froma) };
					} else {					# inbound
						spawn sub { place_msg("mboxes/".$localp,$maild) };
					}
					print "250 Data read and processed$CR$LF";
				}
			} else {
				print "550 Your receiver has a very strange e-mail address...$CR$LF";
			}
		}
		
	}
}

sub install_smtp_server {
	print "Setting up smtp server...\n";
	# open listening TCP networking socket
	my $proto = getprotobyname('tcp');
	socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "ABORT: socket: $!";
	setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,pack("l", 1))   || die "ABORT: setsockopt: $!";
	bind(Server, sockaddr_in(25, INADDR_ANY))        || die "ABORT: bind: $!";
	listen(Server,SOMAXCONN)                            || die "ABORT: listen: $!";

	logmsg "$rid @ 25 (smtp)";
	$0="smtp father [accepting connections]";

	my $childcnt=0;

	$SIG{"CHLD"}=sub { while(waitpid(-1,1) > 0) { ; } $childcnt=$childcnt-1; }; # reap and count

	my $cip="";

	while(1) {
		my $paddr = accept(Client,Server);
		next if not $paddr;			# shouldn't happen
	
		my($port,$iaddr) = sockaddr_in($paddr);
		my $name = gethostbyaddr($iaddr,AF_INET);
		$cip=inet_ntoa($iaddr);

		if (index($main::ipignore,$cip)>-1) {	# if this IP is to ignore
			logmsg "blocking req from $cip:$port ($name) - on ignore-list";
			next;
		}
		if (length($main::ipallow)>0) {		# only certain IPs allowed
			if (index($main::ipallow,$cip)==-1) {	# this is not allowed
			logmsg "blocking req from $cip:$port ($name) - not on allowed-list";
				next;
			}
		}
	
		if ($childcnt>$children) {
			logmsg "server load to high - refused connect";
			next;
		}
	
		$childcnt++;  
		
		spawn sub {
			$0="smtp child [serving $cip]";
			if ($main::securedaemon==1) {
				# permanently drops privs
				($<,$>) = ((scalar getpwnam($main::daemonuser)),(scalar getpwnam($main::daemonuser)));
				# ($(,$)) = (getuinam($daemongroup),getuinam($daemongroup));	# change group???
			}
			select(Client); $| = 1;
			serve_smtp($cip);
			close(Client);
		};
		close(Client);			# child has it's own
		
		# collect our dead children...
		while(waitpid(-1,1) > 0) { ; } # don't loathe SysV, love BSD! 8-)
	}	
}

### mx ####################################################################

use Net::DNS;

sub cmx_msg {
	my $server=shift;
	my $to=shift;
	my $data=shift;
	my $from=shift;
	
	my $opponent = gethostbyname($server);
	socket(P, AF_INET, SOCK_STREAM, getprotobyname('tcp')) || logmsg "socket";
	bind(P, sockaddr_in(0, INADDR_ANY)) || logmsg "bind";
	connect(P, sockaddr_in(25, $opponent)) || logmsg "connect";
	select(P); $| = 1; select(STDOUT);

	my $buf=<P>;
	if (substr($buf,0,3) ne "220") {
		logmsg "\"$buf\" instead of 220 (greeting)";
		return 0;
	}
	print P "HELO localhost\r\n";
	$buf=<P>;
	if (substr($buf,0,3) ne "250") {
		logmsg "\"$buf\" instead of 250 (helo)";
		return 0;
	}
	print P "MAIL FROM:<$from>\r\n";
	$buf=<P>;
	if (substr($buf,0,3) ne "250") {
		logmsg "\"$buf\" instead of 250 (mail from)";
		return 0;
	}
	print P "RCPT TO:<$to>\r\n";
	$buf=<P>;
	if (substr($buf,0,3) ne "250") {
		logmsg "\"$buf\" instead of 250 (rcpt to)";
		return 0;
	}
	print P "DATA\r\n";
	$buf=<P>;
	if (substr($buf,0,3) ne "354") {
		logmsg "\"$buf\" instead of 354 (data)";
		return 0;
	}
	print P $data;
	print P "\r\n.\r\n";
	$buf=<P>;
	if (substr($buf,0,3) ne "250") {
		logmsg "\"$buf\" instead of 250 (data end)";
		return 0;
	}
	print P "QUIT\r\n";
	$buf=<P>;
	if (substr($buf,0,3) ne "221") {
		logmsg "\"$buf\" instead of 221 (quit)";
		return 0;
	}
	
	close(P);
	return 1;
}

sub mx_msg {
	my $to=shift;
	my $data=shift;
	my $from=shift;

	# mxhost - find mx exchangers for a host
	my ($dummy, $host) = split(/\@/,$to);
	my $res = Net::DNS::Resolver->new();
	my @mx = mx($res, $host)
	or (logmsg("Can't find MX records for $host (".$res->errorstring.")"));

	foreach my $record (@mx) {
		logmsg "now trying: ",$record->preference, " ", $record->exchange;
		if (cmx_msg($record->exchange,$to,$data,$from)) {
			logmsg "mail from $from to $to delivered";
			return 1;
		}
	}
	logmsg "mail delivery from $from to $to failed";
	place_msg("spool",$data);
	return 0
}

### main ##################################################################

$0="$rid [startup]";	# explain, what we're doing

# open logfile
my $buf;
$buf=">".$logfile if (($logpolicy==1) || ($logpolicy==2));
$buf=">>".$logfile if ($logpolicy==3);
system(("cp",$logfile,$logfile.".old")) if ($logpolicy==2); # quick 'n' dirty!
open(LOG,$buf) || print "WARNING! No logging possible because of file error!\n";
select(LOG); $|=1; select(STDOUT);		# no buffering!

# make us secure...

if ($secure==1) {
	chroot($mroot) && ($mroot="/") || warn "warning: couldn't chroot() to $mroot";
	POSIX::setsid() || warn "warning: can't start a new session: $!";
}

((mkdir $mroot) && (logmsg "creating $mroot as mail root")) unless (-e $mroot);
((mkdir $mroot."/spool") && (logmsg "creating $mroot/spool")) unless (-e $mroot."/spool");
((mkdir $mroot."/catch-all") && (logmsg "creating $mroot/catch-all")) unless (-e $mroot."/catch-all");
((mkdir $mroot."/mboxes") && (logmsg "creating $mroot/mboxes/")) unless (-e $mroot."/mboxes");


# read user/passwd
open(P,"<$mroot/passwd") || die "no users/passwords - no mailservice for them!!! Dying...";

while(<P>) {
	chomp;
	my ($u,$p)=split;
	$passwd{$u}=$p;
	if (!sanename($u)) {
		logmsg "invalid username $u in registry";
	} else {
		((mkdir $mroot."/mboxes/".$u) && (logmsg "creating $mroot/mboxes/".$u)) unless (-e $mroot."/mboxes/".$u);
	}
}
close(P);

# read hostnames
open(P,"<$mroot/hostnames") || die "no hostnames - no mailservice on this host!!! Dying...";
$site=<P>; chomp($site);
close(P);

# ideally, the child is now chroot()ed to the document root and can't access
# anything else...

my $pid;
if (!defined($pid = fork)) {
	logmsg "cannot fork pop3 server: pop3 (mailbox) support NOT started: $!";
} elsif (!$pid) {
	install_pop3_server;
}

undef $pid;
if (!defined($pid = fork)) {
	logmsg "cannot fork smtp server: smtp (mail transfer) support NOT started: $!";
} elsif (!$pid) {
	install_smtp_server;
}

### The End.
sleep(1);
exit(0);