#!/usr/bin/perl -w
# getmail3.pl
# written by Jim Leonard (vleonard@infinet.com) 2001 - 2002
# available at http://xuth.net/programming/getmail3.html
# This script is in the public domain.


use strict;
use Socket;
use FileHandle;
use Fcntl ':flock';

sub OK()       {'^\+OK'}
sub ERR()      {'^\-ERR'}
sub DOTEXPR()  {'^\.\015?\012'}

my $defaultFile = 'mail/blahbox';                  # default file to put mail
my $defaultServer = "mail.oh.voyager.net";         # default name of pop server
my $defaultUser = "vleonard";                      # default user name
my $emailAddr = 'vleonard@infinet.com';            # email address of person downloading mail
my $checkDelay = 60;                               # log in to the pop server every 60 seconds
my $popPort = 110;                                 # port to connect to

# when comparing "top"'s of messages for duplicates ignore lines that look like this:
my @ignoreLines = ('^From\s.*?$', '^Status\:.*?$');

STDOUT->autoflush(1);

unlink ("getmail_prev2.log");
rename ("getmail_prev.log", "getmail_prev2.log"); 
rename ("getmail.log", "getmail_prev.log");
open LOGFILE, ">getmail.log" or die "Can't create getmail.log - $!";
LOGFILE->autoflush(1);

my ($file, $server, $user) = @ARGV;
$file = $defaultFile unless defined $file;
$server = $defaultServer unless defined $server;
$user = $defaultUser unless defined $user;
my $passwd;
system "stty -echo";
print "pwd for $user: ";
chomp ($passwd = <STDIN>);
system "stty echo";
print "\n";

# wipe the mail file first
open OUTFILE, ">$file" or die "Can't create $file\n$!";
close OUTFILE;

#time to daemonize
my $pid = fork();
print "failed to fork - $!" unless defined $pid;
exit if $pid;  #quit if we're the parent

my %topHash;  # this stores the "top"s of all of the messages minus a few lines that change per d/l
my %lenHash;  # this stores the number of messages of a given length
my $curMsgCount = 0;
while (1)
{
    $curMsgCount = AppendNewMsgs($curMsgCount, $file, $server, $user, $passwd);
    sleep($checkDelay);
}




sub BEGIN 
{
    my $sockOpened = 0;
    my $mailfileOpened = 0;
    my $curMsgCount;
    
sub errlog
{
    close SOCK if $sockOpened;
    close MAILFILE if $mailfileOpened;
    logmsg(@_);
    return $curMsgCount;
}

sub AppendNewMsgs
{
    my ($file, $server, $user, $passwd);
    local *SOCK;
    local *MAILFILE;
    $sockOpened = 0;
    $mailfileOpened = 0;
    
    ($curMsgCount, $file, $server, $user, $passwd) = @_;
    my $port = $popPort;
    my $count = $curMsgCount;
    
    my $fetchedmsgs = 0;
    my $iaddr = inet_aton($server);
    my $paddr = sockaddr_in($port, $iaddr);
    my $proto = getprotobyname('tcp');

	
    socket(SOCK, PF_INET, SOCK_STREAM, $proto) or return errlog("can't open socket: $!\n");
    $sockOpened = 1;
    connect(SOCK, $paddr) or return errlog("Can't connect: $!\n");
    
    SOCK->autoflush(1);
    my ($match, $lines);
    
    # wait for ok from connect
    return errlog("no initial +ok\n") unless (1 == Wait(OK, ERR));
    print SOCK "USER $user\n";
    return errlog("no +ok, user\n") unless (1 == Wait(OK, ERR));
    print SOCK "PASS $passwd\n";
    return errlog("no +ok, pass\n") unless (1 == Wait(OK, ERR));

    #perform a stat
    print SOCK "STAT\n";
    ($match, $lines) = Wait(OK, ERR);
    return errlog("no +ok, stat\n") unless 1 == $match;
    return errlog("Can't get num msgs\n") if $lines !~ /^\+OK\s+(\d+)\s+/;
    logmsg ("statline - $lines"); 
    my $numMsgs = $1;
    #print "There are $numMsgs messages, wuz $curMsgCount\n";
    return $numMsgs if $numMsgs <= $curMsgCount;

    # if there are potentially more messages get a 'list' and create %tempLenHash
    print SOCK "LIST\n";
    return errlog ("no +ok, list\n") unless (1 == Wait(OK, ERR));
    my $listLines;
    ($match, $listLines) = Wait(DOTEXPR);
    return errlog ("no ., list\n") unless (1 == $match);
    my %tempLenHash = ();
    foreach my $listLine (split("\n", $listLines))
    {
	last if $listLine =~ /^\./;
	return errlog("bad list line: $listLine\n") unless $listLine =~ /^(\d+)\s+(\d+)\s?$/;
	$tempLenHash{$2}++;
    }

    #print "working on new messages...";    
    open MAILFILE, ">>$file" or return errlog("Can't append to $file\n$!\n");
    $mailfileOpened = 1;
    flock(MAILFILE, LOCK_EX);
    seek(MAILFILE, 0, 2);
    
    # go through each list entry and compare tempLenHash and lenHash for it's len
    # if lenHash is greater for that len see if this message has been seen before
    # if not then get it!
    foreach my $listLine (split("\n", $listLines))
    {
	last if $listLine =~ /^\./;
	return errlog("bad list line: $listLine\n") unless $listLine =~ /^(\d+)\s+(\d+)\s?$/;
	my ($mailNum, $len) = ($1, $2);
	next if (exists($lenHash{$len}) && ($lenHash{$len} == $tempLenHash{$len}));
	print SOCK "TOP $mailNum\n";
	return errlog("no +ok, retrieving top of msg $mailNum\n") unless 1 == Wait(OK, ERR);
	my $topLines;
	($match, $topLines) = Wait(DOTEXPR);
	return errlog("no end of top of msg $mailNum\n") unless 1 == $match;
	$topLines =~ s/\015//g;  # get rid of any CR's
	foreach my $ignoreLine (@ignoreLines)
	{
	    $topLines =~ s/$ignoreLine//gm;
	}
	next if exists $topHash{$topLines};

	# if here then it's time to get the message
	print SOCK "RETR $mailNum\n";
	return errlog("no +ok, retrieving msg $mailNum\n") unless 1 == Wait(OK, ERR);
	($match, $lines) = Wait(DOTEXPR);
	return errlog("no end of msg $mailNum\n") unless 1 == $match;
	$lines =~ s/\015//g;
	my ($from, $date);
	if ($lines =~ /^From\:\s+(.+)$/m)
	{ $from = $1 } else { $from = "UNKNOWN" }
	$from =~ s/\012//g;
	
	$date = FindDate($lines);
	    
	print MAILFILE "From $emailAddr $date\n";
	print MAILFILE $lines;
	print MAILFILE "\n\n";
	$curMsgCount++;
	$fetchedmsgs++;
	$topHash{$topLines} = 1;
	$lenHash{$len}++;
        #print "ok  ";
    }

    logmsg ("fetched $fetchedmsgs messages\n");
    #print ("fetched $fetchedmsgs messages\n");
    print SOCK "quit\n";
    die ("no +ok, quit") unless (1 == Wait(OK, ERR));
    flock(MAILFILE, LOCK_UN);
    close (SOCK);
    $sockOpened = 0;
    close (MAILFILE);
    $mailfileOpened = 0;
    return $curMsgCount;
} 

}  #sub BEGIN


sub Wait
{
    my @patterns = @_;
    my $lines = '';
    while (1) {
	my $line = <SOCK>;
	unless (defined($line))
	{
	    return (0, $lines) if wantarray;
	    return 0;
	}
#	print $line;
	$lines .= $line;
	my $patCount = 0;
	foreach my $pattern (@patterns)
	{
	    $patCount += 1;
	    if ($line =~ /$pattern/)
	    {
		return ($patCount, $lines) if wantarray;
		return $patCount;
	    }
	}
    }
}

sub logmsg
{
    my $curTime = localtime;
    print LOGFILE "$curTime - ";
    print LOGFILE @_;
}

# in my case the first date in the message is when I d/l it from the pop server
# the second is when the mail server got it.  I think this is the one I like best.
# hopefully my regex is proper.
sub FindDate
{
    my ($message) = @_;
    my $months = "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec";
    my $days = "Sun Mon Tue Wed Thu Fri Sat";

    my $numFound = 0;

    my $date = "Mon Jul 23 16:11:23 2001";  # if I can't get anything

    foreach my $line (split("\n", $message))
    {
#	print "$line";
	if  ($line =~ /\s(\w{3})\s(\w{3})\s([\s\d]\d\s[\s\d]\d\:\d{2}\:\d{2}\s\d{4})/)
	{
	    my ($dow, $month, $rest) = ($1, $2, $3);
	    next if (-1 == index($days, $dow));
	    next if (-1 == index($months, $month));
	    $date = "$dow $month $rest";
	    return $date if (++$numFound == 2);
	}

	if ($line =~ /\s(\w{3})\,\s?([\d\s]\d)\s(\w{3})\s(\d{4})\s(\d{2}\:\d{2}\:\d{2})/)
	{
	    my ($dow, $day, $month, $year, $time) = ($1, $2, $3, $4, $5);
	    next if (-1 == index($days, $dow));
	    next if (-1 == index($months, $month));
	    $date = "$dow $month $day $time $year";
	    return $date if (++$numFound == 2);
	}
    }
    return $date;
}