#!/usr/bin/perl
# POPMail (RFC1081) Interface for perl
# Copyright (c) 1993 William M. Perry (wmperry@indiana.edu)
#
# Hacked by Bill Reynolds (bill@goshawk.lanl.gov).
# Date strings are done right.
# Mailboxes are now locked during writing.
# Check the permissions on $HOME/.pop, bailing if it's not 600.
#

$SIG{'INT'} = 'die_gracefully';
$SIG{'QUIT'} = 'die_gracefully';
$SIG{'TERM'} = 'die_gracefully';
$UID = (getpwuid($<))[2];
$LFILE = "/tmp/popm.$UID";

chop( $ARCH = `uname`);

if ($ARCH = "Linux") { $LINUX = 1; } else { $LINUX = 1; }

# Taken from sigrand by Tom Christiansen (tchrist@convex.com)
# fixed for linux by William Perry (wmperry@indiana.edu)
# (Linux .99pl9 returns 0 on zombie pids)
sub justme {
    if (open LFILE) {
	chop($pid = <LFILE>);
	local($stat) = kill(0,$pid);
	if ($LINUX == 1) {
	    if ($stat == 1) {
		die "$0 already running (pid $pid)\n";
	    }
	}
	else {
	    if ($stat == 0) {
		die "$0 already running (pid $pid)\n";
	    }
	}
	close LFILE;
    }
    open (LFILE, ">$LFILE") || die "can't write $LFILE: $!";
    print LFILE "$$\n";
    close LFILE || die "can't close $LFILE: $!";
} 

sub die_gracefully {
    local($msg) = $_[0];

    print STDERR "An error occurred: $msg\n";
    print STDERR "Resetting.\n";
    unlink "$LFILE";
    print S "rset\n";
    print S "quit\n";
    exit(1);
}

sub quit {
    print S "quit\n";
}

sub openserver {
    local($them, $port) = @_;
    
    $AF_INET = 2;
    $SOCK_STREAM = 1;
    
    $sockaddr = 'S n a4 x8';
    $hostname = "localhost";

    ($name, $aliases, $proto) = getprotobyname('tcp');
    ($name, $aliases, $port) = getservbyname($port,'tcp')
	unless $port =~ /^\d+$/;;

    ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
    ($name, $aliases, $type, $len, $thataddr) = gethostbyname($them);

    $this = pack($sockaddr, $AF_INET, 0, $thisaddr);
    $that = pack($sockaddr, $AF_INET, $port, $thataddr);

    if (socket(S,$AF_INET, $SOCK_STREAM, $proto)) { }
    else { &die_gracefully("Can't open socket: $!"); }

    if (bind(S,$this)) {}
    else { &die_gracefully("Can't bind socket: $!"); }
    
    if (connect(S,$that)) {}
    else { &die_gracefully("Can't connect to socket: $!"); }

    select(S); $| = 1; select(stdout);

    print S "user $user\n";
    ($status, $smsg) = &waitfor("^.\(OK\|ERR\)\(.*\)");
    if ($status ne "OK") {
	&die_gracefully($smsg);
    }
    print S "pass $passwd\n";
    ($status, $smsg) = &waitfor("^.\(OK\|ERR\)\(.*\)");
    if ($status ne "OK") {
	&die_gracefully($smsg);
    }
    &waitfor("^.\(OK\|ERR\)\(.*\)");
}

sub nummsgs {
    print S "stat\n";
    local($status, $messages) = &waitfor("^.\(OK\|ERR\)\(.*\)");
    ($msgs,$octets) = split(' ',$messages);
}

sub waitfor {
    local($signal) = $_[0];
    $_ = <S>;
    while (!/$signal/) {
	$_ = <S>;
    }
    ($1,$2);
}

sub retrieve {
    local($msgnum) = @_;
    local($themsg) = "";
    local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);

    @day = ('Mon', 'Tue', 'Wed', 'Thu', 'Fri','Sat', 'Sun');

    @month = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'June', 'Jul',
	      'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

    open(SPOOLOUT,"+>/tmp/poptmp.$$");
    
    
    print S "retr $msgnum\n";
    local($status,$smsg) = &waitfor("^.\(OK\|ERR\)\(.*\)");
    if ($status ne "OK") {
	&die_gracefully($smsg);
    }
    else {
	# 
	# Some mailers are very persnickity about the time string, 
	# hence the goop. BR Wed Sep  8 14:52:34 MDT 1993
	# 
	printf(SPOOLOUT "From popserver %s %s %2d %02d:%02d:%02d GMT 19%02d\n"
	       ,$day[$wday],$month[$mon],$mday,$hour,$min,$sec,$year);
	$_ = <S>;
	while (!/^\.\r*$/) {
	    s/\r//g;
	    print SPOOLOUT $_;
	    $_ = <S>;
	}
	print S "dele $msgnum\n";
	($status, $smsg) = &waitfor("^.\(OK\|ERR\)\(.*\)");
	if ($status ne "OK") {
	    &die_gracefully($smsg);
	}
    }

    open(MBOX, ">>/usr/spool/mail/$user")
	||   &die_gracefully("Can't open mailbox"); 
    
    $LOCK_SH = 1;
    $LOCK_EX = 2;
    $LOCK_NB = 4;
    $LOCK_UN = 8;

    flock(MBOX,$LOCK_EX);
    # and, in case someone appended
    # while we were waiting...
    seek(MBOX, 0, 2);

    seek(SPOOLOUT,0,0);
    while(<SPOOLOUT>){
	print MBOX $_;
    } 
    close SPOOLOUT;
    unlink "/tmp/poptmp.$$";
    flock(MBOX,$LOCK_UN);
    close MBOX;
}

sub get_user_info {
    local($filename) = $ENV{"HOME"} . '/.pop';
    if (-f $filename) {
	open(POPFILE,$filename) || &die_gracefully("Can't Open .pop file! $!");

	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	 $atime,$mtime,$ctime,$blksize,$blocks) = stat POPFILE;

	if($mode != 0100600){
	    &die_gracefully("$HOME/.pop needs permissions rw-------");
	    }

	$_ = <POPFILE>;
	chop;
	($pophost, $popport, $user, $passwd) = split(' ',$_);
	close(POPFILE);
    }
    else {
	print "Username: ";
	$_ = <STDIN>;
	chop;
	$user = $_;
	print "Password: ";
	system('stty -echo');
	$_ = <STDIN>;
	chop;
	$passwd = $_;
	system('stty echo');
	print "\n";
	print "Pop Host: ";
	$_ = <STDIN>;
	chop;
	$pophost = $_;
	print "Pop Port: ";
	$_ = <STDIN>;
	chop;
	$popport = $_;
    }
}

&get_user_info;
$pid = fork();

if ($pid != 0) {
    print "Starting popmail daemon for $user\n";
    exit;
}
else {
    &justme;

    while (1) {
	&openserver($pophost,$popport) && &nummsgs;
	for ($msg = 1; $msg <= $msgs; $msg++) {
	    &retrieve($msg);
	}
	&quit;
	sleep(500);
    }
}
