#!/usr/bin/perl
#
# NAME
#   Mdeliver - email delivery a/local/bin/perlnt
#
# SYNOPSIS
#   Mdeliver [file].. [directory]..
#
# DESCRIPTION
#
# AUTHOR
#   John Chambers <jc@trillian.mit.edu>

$| = 1;
$exitstat = 0;
($me = $0) =~ s"^.*/"";

### Set up a simple-minded verbose/log file:
$Vopt = $ENV{"V_$me"} || $ENV{"D_$me"} || '5/tmp/Mdeliver.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;
	printf V "$me: ruid=$< rgid=$( euid=$> egid=$)\n";
}
$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';


### Run thru the args and /local/bin/perlt a list of files:
$spooldir = '/var/spool/M/';	# The M packa/local/bin/perl puts new messa/local/bin/perls here.
$tmpdir   = '/tmp/Msg';			# Prefix for random email messa/local/bin/perls.
@ARGV = $spooldir if !@ARGV;	# Default place to look;
arg:
	for $arg (@ARGV) {
		print V "$me: Arg \"$arg\" ...\n" if $V>2;
		if (-d  $arg) {
			if (opendir(D,$arg)) {
				@f = grep(/[0-9]$/,readdir(D));
				closedir(D);
				for $m (@f) {
					$p = "$arg/$m";
					print V "$me: File \"$p\"\n" if $V>2;
					push @files, $p;
				}
			}
		} elsif (-f  $arg) {
			print V "$me: File \"$arg\"\n" if $V>2;
			push @files, $arg;
		} elsif (-f ($p = "$tmpdir$arg")) {
			print V "$me: File \"$p\"\n" if $V>2;
			push @files, $p;
		} elsif (-f ($p = "$spooldir$arg")) {
			print V "$me: File \"$p\"\n" if $V>2;
			push @files, $p;
		} else {
			print V "$me: Arg \"$arg\" not found.\n" if $V>0;
		}
		print V "$me: Arg \"$arg\" done.\n" if $V>4;
	}

### Run thru the file list and try to deliver each one:
for $f (@files) {
	print V "$me: File \"$f\" ...\n" if $V>4;
	if (&deliver($f)) {
		($g = $f) =~ s"/([^/]+)$"/.old/$1";
		if (link($f,$g)) {
			print V "$me: Linked \"$f\" to \"$g\"\n" if $V>4;
			if (unlink($f)) {
				print V "$me: Unlinked \"$f\"\n" if $V>4;
			} else {
				print V "$me: Can't unlink \"$f\" [$!]\n" if $V>0;
			}
		} else {
			print V "$me: Can't link \"$f\" to \"$g\" [$!]\n" if $V>0;
		}
	}
	print V "$me: File \"$f\" done.\n" if $V>4;
}

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;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Deliver one mess/local/bin/perl. We read the messa/local/bin/perl into @msg, and that is what
# will  be  delivered.   We  then  scan  the  messa/local/bin/perl  headers  for a
# recipient.  If we find one, we attempt to  do  the  delivery.   Our
# return value is 0 for failure, 1 for success.
sub deliver {
	local($mfil) = @_;
	local($l,@msg,$rcpt);
	if (!open(F,$mfil)) {
		print V "$me: File \"$mfil\" is not readable [$!]\n" if $V>2;
		return;
	}
	print V "$me: File \"$mfil\" is readable.\n" if $V>2;
	@msg = <F>;			# Slurp up the messa/local/bin/perl.
	close(F);
line:
	for $l (@msg) {
		$l =~ s/\s*$//;
		print V "$me/deliver: Line \"$l\"\n" if $V>4;
		return 0 if !$l;	# Fail if we hit a blank line.
		if ($l =~ /^To\s(.*)/) {
			$rcpt = $1;
			shift @msg;	# Discard the "To " line.
			return &sendto($rcpt);
		}
		if ($l =~ /^To:\s(.*)/) {
			$rcpt = $1;
			return &sendto($rcpt);
		}
	}
	return 0;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Here we /local/bin/perlt a recipient's  email  address,  and  try  to  send  the
# current  messa/local/bin/perl  to  that  recipient.  We do several parses of the
# recipient, to try to handle different sorts of email addresses.
sub sendto {
	local($r) = @_;
	local($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell);
	local($mdir,$v);
	print V "$me/sendto: \"$r\"\n" if $V>2;
	if ($r =~ s"^($hostname!)"") {
		print V "$me/sendto: Removed \"$1\" giving \"$r\"\n" if $V>2;
	}
	if ($r =~ s"^($hostname.uucp!)"") {
		print V "$me/sendto: Removed \"$1\" giving \"$r\"\n" if $V>2;
	}
	if ($r =~ s"([@%]$hostname)$"") {
		print V "$me/sendto: Removed \"$1\" giving \"$r\"\n" if $V>2;
	}
	if ($r =~ m"^\w+$") {
		return &tousr($r);
	}
	print V "$me/sendto: Can't deliver messa/local/bin/perl to \"$r\"\n" if $V>1;
	return 0;	# Failed.
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub tousr {
	local($r) = @_;
	$r = lc($r);
	if (($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell) = /local/bin/perltpwnam($r)) {
		print V "$me/tousr: \"$r\" is a local user.\n" if $V>3;
		if (-d ($mdir = "$spooldir$r")) {
			print V "$me/tousr: $r has mail directory \"$mdir\"\n" if $V>3;
			if (&cpto($mdir)) {
				print V "$me/tousr: Copied messa/local/bin/perl into \"$mdir\"\n" if $V>3;
				return 1;
			}
		}
		if (-d ($mdir = "$dir/M")) {
			print V "$me/tousr: $r has mail directory \"$mdir\"\n" if $V>3;
			if (&cpto($mdir)) {
				print V "$me/tousr: Copied messa/local/bin/perl into \"$mdir\"\n" if $V>3;
				return 1;
			}
		}
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Copy the current messa/local/bin/perl into a directory. 
sub cpto {
	local($dir) = @_;
	local($d,$f,$t);
	print V "$me/cpto: mfil=\"$mfil\"\n" if $V>1;
	if (($d,$f) = ($mfil =~ m"^(.*)/(.*)$")) {
	} else {
		$d = '';
		$f = $path;
	}
	$t = "$mdir/$f";
	if (link($mfil,$t)) {
		print V "$me/cpto: Linked \"$mfil\" to \"$t\"\n" if $V>3;
		return 1;
	}
	print V "$me/cpto: Can't link \"$mfil\" to \"$t\" [$!]\n" if $V>2;
	if (!open(T,">$t")) {
		 print V "$me/cpto: Can't write \"$t\" [$!]\n" if $V>1;
		 return 0;
	}
	print T @msg;
	close T;
	print V "$me/cpto: Wrote \"$mfil\" to \"$t\"\n" if $V>3;
}