#!/usr/bin/perl
#!/home/jmc/bin/perl
#
# NAME
#   Rmail - relay mail
#
# SYNOPSIS
#   Rmail recipient.. <message
#
# DESCRIPTION
#   This is a plug-in replacement for the /bin/rmail that is on  your
#   system.   If  you  are  having  trouble  getting  email delivered
#   properly because you can't make head nor  tail  outta  all  those
#   crazy  config files that packages like sendmail or smail foist on
#   you, give this one a try.
#
#   This program has no config files.  All the configging is done  in
#   the code, mostly by tweaking the startup lines. In any case, it's
#   a self-contained perl program, so you can figure it out.  Add the
#   usual "-dw" options to the above #! line, as usual.
#
#   The default behavior is to attempt to parse the recipient(s) into
#   a machine name and a remainder.  Then we check on various ways to
#   deliver  the  mail to the machine, and if we find one, we send it
#   to an appropriate mail package, with instructions to  deliver  it
#   to the remainder of the recipient's address.
#
#   If  that  doesn't work, or there are no recipients on the command
#   line, we grovel through the message's header lines,  and  try  to
#   find a recipient there.
#
# AUTHOR
#   John Chambers <jc@trillian.mit.edu>

# First, out of sheer paranoia (and hard experience), we grab the new
# message and stuff it into a tmp file. This is an attempt to prevent
# perl and uuxqt from teaming up and discarding the message.
@msg = <STDIN>;		# Slurp up the message.
if (open(TMP,">/tmp/Msg$$")) {
	print TMP @msg;
	close TMP;
}

### Set up a simple-minded verbose/log file:
$| = 1;
$exitstat = 0;
($me = $0) =~ s"^.*/"";
$Vopt = $ENV{"V_$me"} || $ENV{"D_$me"} || '4/tmp/Rmail.log';
if (($V,$Vfil) = ($Vopt =~ /^(\d)(.*)/)) {
	open(V,">>$Vfil") || die "$0: Can't write \"$Vfil\" ($!)\n";
} else {$V = 1; open(V,">&STDERR")}
select V; $| = 1;
if ($V>1) {
	($ss,$mm,$hh,$DD,$MM,$YY) = gmtime;
	printf V "\n$me: Started %04d/%02d/%02d %02d:%02d:%02d.\n",1900+$YY,$MM+1,$DD,$hh,$mm,$ss;
}
$ENV{PATH} = "/home/jc/mail:/home/jc/bin:/home/jc/sh:/sbin:/bin:/usr/bin:/usr/sbin:/usr/lib/uucp";
($hostname = `/bin/hostname`) =~ s/\s+//g;
#$owner = $ENV{LOGNAME} || $ENV{USER} || 'mail';
$owner = 'mail';

### The group that should own mail-related files:
$mgrp = 'mail';

### The smarthost is where we send messages that we can't deliver:
$smarthost = 'trillian.mit.edu';

### Here's where we deliver email:
$maildir = '/var/spool/M';
if (! -d $maildir) {		# If the mail directory doesn't exist,
	if (!mkdir($maildir,0775)) {	# Create it.
		$errmsg = "$me: Can't mkdir(\"$maildir\",0775) [$!]\n";
		print V $errmsg;
		die $errmsg;
	}
	print V "$me: Directory \"$maildir\" created.\n" if $V>1;
}

### This says whether we should create a mailbox as a file or directory:
$mboxdir = 1;		# 0=file 1=directory

### This is the uux command to use:
$uux = '/usr/bin/uux';

### Read the message and put it into a local file.
$fline = "From $owner\n"
	unless $msg[0] =~ /^From/;
($ss,$mm,$hh,$DD,$MM,$YY) = gmtime(time);
$n = 0;
do {
	$n ++;
	$msgid = sprintf("%04d%02d%02d%02d%02d%02d%02d",1900+$YY,1+$MM,$DD,$hh,$mm,$ss,$n);
	$msgfn = "$maildir/$msgid";
} until (! -f $msgfn);
print V "$me: Message file \"$msgfn\"\n" if $V>1;
if (!open(F,">$msgfn")) {
	$errmsg = "$me: Can't write \"$msgfn\" [$!]\n";
	print V $errmsg;
#	die $errmsg;
}
print F "From: $hostname!$owner\n" if $fline;
print F @msg;
close F;

for $u (`uuname`) {	# Our uucp neighbors.
	$u =~ s/\s+//g;
	$uu{$u} = 1 if $u;
}

for $r (@ARGV) {	# Run thru the list of recipients.
	print V "$me: Recipient=\"$r\"\n" if $V>1;
	&rcpt($r);
}

if ($V>1) {
	($ss,$mm,$hh,$DD,$MM,$YY) = gmtime;
	printf V "$me: Done %04d/%02d/%02d %02d:%02d:%02d.\n",1900+$YY,$MM+1,$DD,$hh,$mm,$ss;
}
exit $exitstat;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub appendmsg {
	local($fnam) = @_;
	print V "$me: Append to $fnam ...\n" if $V>3;
	if (!open(F,">>$fnam")) {
		print V "$me: Can't append to $$fnam ($!)\n" if $V>0;
		return 0;
	}
	$LOCK_SH = 1;
	$LOCK_EX = 2;
	$LOCK_NB = 4;
	$LOCK_UN = 8;
	flock(F,$LOCK_EX);
	seek(F,0,2);
	print F "From: $hostname!$owner\n" if $fline;
	print F @msg, "\n\n"; 
	flock(F,$LOCK_UN);
	close F;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Local mail delivery.  We check for a couple of possibilities.   The #
# favorite  is if the user has a M directory, in which case, we write #
# the message into a file in that directory.                          #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub localmail {
	local($user) = @_;
	local($mbox,$mfil);
	local($lgin,$pass,$uid,$gid,$qta,$cmt,$gcos,$hdir,$shl);
	if (($lgin,$pass,$uid,$gid,$qta,$cmt,$gcos,$hdir,$shl) = getpwnam($user)) {
		if (-d "$hdir/M") {
			$mfil = "$hdir/M/$msgid";
			if (open(MF,">$mfil")) {
				print MF "From: $user\n" if $fline;
				print MF @msg;
				print V "$me:  Wrote \"$mfil\".\n";
				close MF;
				return;
			}
		}
	}
	# We can't give it directly to the user, so we try to put it into
	# a directory under $maildir that's named for the user.
	$mbox = "$maildir/$user";
	$mfil = "$maildir/$user/$msgid";
	if (-d $mbox) {
		print V "$me: $mbox is a directory.\n" if $V>2;
		if (link($msgfn,$mfil)) {
			 print V "$me: Linked \"$msgfn\" to \"$mfil\".\n";
		} else {
			$errmsg = "$me: Can't link \"$msgfn\" to \"$mfil\" [$!]\n";
			 print V $errmsg;
		}
	} elsif (-f $mbox) {
		print V "$me: $mbox is a file.\n" if $V>2;
		&appendmsg($mbox);
	} else {
		print V "$me: $mbox does not exist.\n" if $V>2;
		if ($mboxdir) {	# Create mailbox directory.
			print V "$me: Create $mbox directory ...\n" if $V>2;
			if (!mkdir($mbox,0770)) {
				print V "$me: Can't make $mbox directory ($!)\n" if $V>0;
				system "mailfile $user $mbox";	# Set mail dir ownership.
				return 0;
			}
			&newmailmsg($mbox);
		} else {		# Create mailbox file.
			print V "$me: Create $mbox file ...\n" if $V>2;
			if (!open(M,">$mbox")) {
				print V "$me: Can't create $mbox ($!)\n" if $V>0;
				return 0;
			}
			print V "$me: Change owner to $user group to $mgrp ...\n" if $V>2;
			system "chgrp $mgrp $mbox";
			system "chown $user $mbox";
			system "chmod o-rwx $mbox";
			close M;
			&appendmsg($mbox);
		}
	} 
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub rcpt {
	local($addr) = @_;
	if ($addr =~ /^\w+$/) {
		print V "$me: $addr is a simple name.\n" if $V>2;
		&localmail($addr);
		return 1;
	}
	if (($host,$rmdr) = ($addr =~ /^([-_.A-Za-z0-9]+)!(.+)/)) {
		print V "$me: !-addr host=\"$host\" rmdr=\"$rmdr\"\n" if $V>2;
		if ($host eq $hostname) {
			print V "$me: $host is this machine.\n" if $V>1; 
			return &rcpt($rmdr);
		}
		if ($host eq "$hostname.uucp") {
			print V "$me: $host is this machine.\n" if $V>1; 
			return &rcpt($rmdr);
		}
		if ($uu{$host}) {
			print V "$me: !-addr host=\"$host\" is neighbor.\n" if $V>2; 
			return &uumail($host,$rmdr);
		} else {
			print V "$me: !-addr host=\"$host\" is unknown.\n" if $V>2;
			return 0;
		}
	}
	print V "$me: Can't handle \"$addr\"\n" if $V>0;
	return 0;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub uumail {
	local($uusys,$uuadr) = @_;
	print V "$me: Sending message to $uusys for $uuadr\n" if $V>1;
	$uucmd = "$uux - -r $uusys!rmail '($uuadr)' ";
#	$uucmd = "$uux -r - $uusys!rmail $uuadr";
	print V "$me: $uucmd\n" if $V>1;
	if (!open(U,"| $uucmd")) {
		print V "$me: Can't run \"$uucmd\" ($!)\n" if $V>0;
		$exitstat = $!;
		return 0;
	}
	if ($msg[0] =~ /^From /) {
		$from = shift @msg;
		print U $from;
	} else {
		print U "From $hostname!$owner\n";
	}
	for $line (@msg ) {
		$line =~ s/^From />From /;
		print U $line;
	}
	close U;
	return 1;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #