#!/usr/pkg/bin/perl
use Net::POP3;
use strict;
use Getopt::Long ;
Getopt::Long::Configure("no_ignore_case");

my %opt=();
my @servers=();
my $RCFILE='getmailrc';

sub usage(){
	print STDERR "Usage:\n";
	print STDERR "  getmail [options]\n";
	print STDERR "  -s servers - comma separated list of servers\n";
	print STDERR "  -o regex - Only use the specified server\n";
	print STDERR "  -f|full - show full message (ie. including header)\n";
	print STDERR "  -h - show help\n";
	print STDERR "  -p page - use specified pager\n";
	print STDERR "  -d dir - directory\n";
	print STDERR "  -v - verbose\n";
	print STDERR "  -r x - repeat every x sec\n";
	print STDERR "  -i - interactive\n";
	print STDERR "  -R|rows x - screen height (for internal pager)\n";
	print STDERR "  -a|all  - Fetch all messages\n";
	print STDERR "  -l|list - List mode\n";
	print STDERR "  -n|number - Show number of messages - don't download\n";
	print STDERR "  -D|delete - Delete all messages on server!!\n";
	print STDERR "  -DS|delorsave - Delete all messages on server if all seen, otherwise \nsave unseen messages\n";
	print STDERR "  -DO|delold - Delete all old messages on server\n";
	print STDERR "  -P|print - Print messages on server to console\n";
	print STDERR "  -S|save - Save messages on server\n";
	print STDERR "  -L|local - View locally saved messages\n";
	print STDERR "  -m mbox - mailbox/directory to save messages to\n";
	print STDERR "  -N|noupdate - Don't update list of seen messages\n";
	print STDERR "  -c|clear - clear all locks\n";
	print STDERR "  -w|web - Use mail2web + lynx to retrieve mails\n";
	print STDERR "  -x|expunge - clear out saved mail\n";
	print STDERR "	-fromregex regex - only show mails whose from line matches regex\n";
	print STDERR "	-subjregex regex - only show mails whose subject line matches regex\n";
	exit 1;
}

sub dprint(@){
	if($opt{'v'}){
		print @_;
	}
}

sub savemsg($@){
	my ($uid,@msgarr) = @_;
	if (! -d $opt{'m'}){
		open (TMP,">>$opt{'m'}")||die "Cannot open $opt{'m'}\n";
	}else{
		open (TMP, ">$opt{'m'}/$uid")||die "Cannot open message file $uid\n";
		print "Writing msg to $opt{'m'}/$uid\n";
	}
	print TMP fromLine();
	print TMP @msgarr;
	print TMP "\n\n";
	close TMP;

}
sub printmsg(@){
	my @msgarr = @_;
	if ($opt{'p'} && $opt{'p'} ne 'internal' ){
		open (TMP,"|$opt{'p'}")||die "Cannot open /tmp/ian.msg";
		if ($opt{'f'}){
			print TMP @msgarr;
		}else{
			my $skipheaders=1;
			foreach (@msgarr){
				if ( /^\s*$/){
					$skipheaders=0;
				}
				if (! $skipheaders){
					print TMP $_;
				}
			}

		}
		close TMP;
	}else {
		# use default
		my $line=0;
		my $skipheaders=1;
		foreach (@msgarr){
			if ( /^\s*$/){
				$skipheaders=0;
			}
			if (! $skipheaders){
				print $_;
				$line++;
				if ($line==$opt{'R'}){
					<STDIN>;
					$line=0;
				}
			}

		}


	}
	if ($opt{'P'}){
		last;
	}
}

#main
{

	GetOptions(\%opt,
			   's|server=s',
			   'L|local',
			   'p|pager=s',
			   'e|email=s',
			   'f|full',
			   'd|dir=s',
			   'R|rows=s',
			   'r|repeat=s',
			   'm|mbox=s',
			   'h|help',
			   'D|delete',
			   'DS|delorsave',
			   'P|print',
			   'S|save',
			   'v|verbose',
			   'i|interactive',
			   'a|all',
			   'n|number',
			   'N|noupdate',
			   'c|clear',
			   'k|kill',
			   'w|web',
			   'x|expunge',
			   'o|only=s',
			   'fromregex=s',
			   'subjregex=s',
			   'l|list');

	if($opt{'h'}){
		usage();
	}


	if ($opt{'s'}){
		@servers=split(/,/,$opt{'s'});
	}


	if ($opt{'l'}){
		dprint "List mode\n";
		$opt{'a'} = 1;
		$opt{'doall'} = 'n';
	}


	if ($opt{'D'}){
		dprint "Deleting messages\n";
		$opt{'doall'} = 'd';
	}

	if ($opt{'P'}){
		dprint "Printing all messages\n";
		$opt{'doall'} = 'v';
		$opt{'p'} = 'internal';
		$opt{'rows'} = -99;
	}
	if($opt{'e'}){
		dprint "Emailing all to $opt{'e'}\n";
		$opt{'doall'}='v';
		$opt{p}="mail $opt{'e'}";
		$opt{'f'} = 1;
	}
	if($opt{'S'}){
		dprint "Saving messages\n";
		$opt{'doall'} = 's';
	}



	if ($opt{'a'}){
		dprint "Ignoring seen messages\n";
	}
	if (! $opt{'d'}){
		$opt{'d'}=$ENV{'GETMAILDIR'};
	}
	if (! $opt{'d'}){
		$opt{'d'}="$ENV{'HOME'}/.getmail";
	}
	if (  $opt{'d'} && ! -d $opt{'d'}){
		mkdir ($opt{'d'},0777);
	}
	chdir $opt{'d'};
	dprint "Using home directory $opt{'d'}\n";
	dprint `pwd`;

	if ($opt{'r'}){
		# this implies we must be saving the messages
		$opt{'doall'} = 's';
		$opt{'i'} = 0;
		# write pid file so this can be killed!
		open PID,">getmail.lock.$$" or die "Cannot open lock file\n";
		print PID $$;
		close PID;

	}
	getFileOptions();
	if ($opt{'k'}){
		opendir DIR,"$opt{'d'}";
		my @locks = grep /^getmail.lock/, readdir (DIR);
		closedir (DIR);
		foreach (@locks){
			print "Removing lock $_\n";
			unlink $_;
			my ($pid)=/^getmail.lock.(\d+)/;
			if ($^O !~ /win/i){
				system "kill -14 $pid";
			}
		}
		exit 0;
	}
	if ($opt{'c'}){
		opendir DIR,"$opt{'d'}";
		my @locks = grep /lock$/, readdir (DIR);
		closedir (DIR);
		foreach (@locks){
			print "Removing lock $_\n";
			unlink $_;
		}
	}
	if (!$opt{'p'}){
		$opt{'p'}=$ENV{'PAGER'};
	}
	if (!$opt{'R'}){
		$opt{'R'}=20;
	}
	if ($opt{'o'}){
		@servers = grep /$opt{'o'}/, @servers;
	}
	if (! $opt{'m'}){
		$opt{'m'} = "mail.saved";
	}

	if ($opt{'x'}){
		print "Expunging saved messages\n";
		if (! -d $opt{'m'}){
			unlink ($opt{'m'});
		}else{
			opendir (DIR,$opt{'m'});
			foreach (readdir(DIR)){
				unlink("$opt{'m'}/$_");
			}
		}
		exit 0;
	}
	if ($opt{'L'}){
		print "Viewing local saved messages\n";
		if (! -d $opt{'m'}){
			open (IN,$opt{'m'});
			my @msg=<IN>;
			close(IN);
			printmsg(@msg);
		}else{
			opendir (DIR,$opt{'m'});
			foreach (grep !/^\./,readdir(DIR)){
				open(IN,"$opt{'m'}/$_");
				my @msg=<IN>;
				close(IN);
				printmsg(@msg);
			}
			closedir(DIR);
		}
		exit 0;
	}

	if(@servers == 0){
		{
			print "No servers specified\n";
			usage();
		}
	}

	dprint "Options chosen:-\n";
	foreach (keys %opt){
		dprint "$_=$opt{$_}\n";
	}

	do{
		foreach  (@servers){
			dprint "Checking $_\n";
			getmail($_);
		}
		if ($opt{'r'}){
			my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
			print "$hour:$min - Sleeping $opt{'r'} secs\n";
			print "This should be backgrounded, and killed using getmail -k!\n";

			sleep $opt{'r'};
			# die now if lock file no longer exists
			if (! -f "getmail.lock.$$"){
				print "Lockfile removed - exiting\n";
				last;
			}
		}
	}until (!$opt{'r'});
	print "getmail finished\n";
}

sub fromLine(){
	my @weekdays = qw{ Mon Tue Wed Thur Fri Sat Sun};
	my @months = qw {Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
	if ($sec<10) {
		$sec = "0$sec";
	}
	if ($min<10) {
		$min = "0$min";
	}
	if ($hour<10) {
		$hour = "0$hour";
	}
	if ($mday < 10){
		$mday = " $mday";
	}
	$year +=1900;
	return "From MAILER-DAEMON $weekdays[$wday] $months[$mon] $mday $hour:$min:$sec $year\n";


}

sub getFileOptions(){
        if (! open IN,$RCFILE){
                dprint "$RCFILE not found\n";
                return;
        }
        foreach (<IN>){
                # trim whitespace
                s/^\s+//;
                s/\s+$//;
                s/\s*=\s*/=/;
                if (/^PAGER=(.+)$/ && !$opt{'p'}){
                        $opt{'p'}=$1;
                }
                if (/^ROWS=(.+)$/ && !$opt{'R'}){
                        $opt{'R'}=$1;
                }

                if (/^SERVER=(.+)$/ && ! $opt{'s'}){
                        push@servers,($1);
                }

                if (/^FULL$/){
                        $opt{'f'}=1;
                }
                if (/^WEB$/){
                        $opt{'w'}=1;
                }
                if (/^MAILBOX=(.+)$/ && ! $opt{'m'}){
                        $opt{'m'}=$1;
                }

        }
        close IN;
}

sub getwebmsg($)
{
	my ($murl) = @_;
	chomp $murl;
	$murl =~s/^\s*\d*\.//;
	$murl=~s/readmsg.asp/msgsrc.asp/;
	dprint ("Running 'lynx -dump \"$murl\"'\n");
	my @thismsg=`lynx -dump "$murl"` ;
	dprint("Got ".scalar(@thismsg)." lines\n");
	my @out=();
	my $print=0;
	my $hdr=0;
	my $started=0;
	foreach (@thismsg){
		if(!$started){
			if (/go back/){
				$started=1;
				$hdr=1;
			}
			next;
		}
		if(!$print){
			if(/^\s*$/){
				# skip blank lines
				next;
			}else{
				$print=1;
			}
		}
		if(/^\s*go back\s*/){
			# skip back link
			next;
		}
		if ($hdr){
			if (/^\s*$/){
				$hdr=0;
			}else{
				s/^\s+//;
			}
		}
		if (/^References$/){
			last;
		}
		if ($print){
			s/\[\d+\]//g;
			push @out,$_;
		}
	}
	my $ref= \@out;
	return $ref;

}

sub getmail($)
{
		my ($constr)=@_;
		my ($user,$pass,$server)= ($constr =~ /^(.+):(.+)@(.+)$/);
		my (%uids, @olduids,@newuids);

		@newuids=();
		if ($opt{'i'}){
				print "Check $server?";
				my $ok = <STDIN>;
				chomp $ok;
				if ($ok=~ /n/i){
						return;
				}

		}
		if ($pass eq 'ASK'){
				if ($^O !~ /win/i){
						system ("stty -echo");
				}
				print "Password for $user\@$server:";
				$pass=<STDIN>;
				chomp $pass;
				if ($^O !~ /win/i){
						system ("stty echo");
				}else{
						system ("cls");
				}
				print "\n";
		}

		while (-f "$server.lock"){
				print "Sleeping for 5 sec while waiting for lock to clear...\n";
				sleep 5;
		}

		#write lockfile
		open (LOCK,">$server.lock");
		print LOCK $$;
		close LOCK;

		dprint "Logging in to $server as $user (using $pass)\n";
		my (@mailurls,$cmd,$delconf);
		my($x, $pop ,$msgs,$msgref,@headerarr,@msgarr,$todo);
		print("Logging in to $server\n");
		if (!$opt{'w'}){
				$pop=Net::POP3->new($server, 'Timeout' => 300);
				if (! $pop){
						print STDERR ("Could not log in to $server\n");
						return;
				}
				$msgs=$pop->login($user,$pass);
				if ( $msgs eq '0E0' ){
						$msgs =0;
				}
		}else{
				$cmd=qq{lynx -dump "http://mail2pda.com/cgi-bin/listmsg.asp?SERVER=$server&UNAME=$user&PASSWORD=$pass&listdirection=1"};
				dprint ("Running '$cmd'\n");
				my @output=`$cmd`;
				dprint("Got ".scalar(@output)." lines\n");
				my (undef,$listall) = grep /listmsgall/,@output;
				chomp $listall;
				$listall =~s/^\s*\d*\.//;
				$cmd=qq{lynx -dump "$listall"};
				dprint ("Running '$cmd'\n");
				@output=`$cmd`;
				dprint("Got ".scalar(@output)." lines\n");
				@mailurls = grep /readmsg.asp/,@output;
				$delconf = $listall;
				$delconf =~ s/listmsgall/delall2/;
				$msgs=scalar(@mailurls);

		}
		print "$msgs messages seen\n";

		# now get old messages
		my $old;
		$old = open (OLD,"$user-$server");
		if ($old && !$opt{'a'} && ! $opt{'D'}){
				@olduids=<OLD>;
				close OLD;
				dprint "Checking for old ids\n";
				dprint @olduids;
		}
		else{
				@olduids=();
				dprint "Not checking for old ids\n";
		}
		if (!$opt{'n'}){
				if($opt{'DS'}){
						print "Messages previously seen:".scalar(@olduids)."\n";
						if($msgs==@olduids){
								print "No new messages - deleting\n";
								$opt{'doall'} = 'd';
								$opt{'D'} = 1;
								@olduids=();
						}elsif($msgs>0){
								print "New messages - saving\n";
								$opt{'S'}=1;
								$opt{'doall'}='s';
						}
				}
				if ($opt{'D'}){
						my $answer;
						if($opt{'DS'}) {
								$answer='y';
						}else{

								print "Delete ALL mail in $server (y/n)?";
								$answer = <STDIN>;
								chomp $answer;
						}
						if ($answer !~ /^y$/i){
								print "Skipping ...\n";
								#remove lockfile
								unlink ("$server.lock");
								if (!$opt{'w'}){
										$pop->close();
								}
								return;
						}
						if ($opt{'w'}){
								chomp $delconf;
								$delconf=~s/^\s*\d*\.//;
								# convert so we do a full delete
								my $delmail=$delconf;
								#$delmail =~ s/delconf/delmail/;
								#$delmail.="&so=1&da=A";
								dprint ("Running 'lynx -dump \"$delconf\"'\n");
								my @delout=`lynx -dump "$delconf"`;
								dprint ("Got ".scalar(@delout)." lines\n");
								print grep /deleted/,@delout;
								#remove lockfile
								unlink ("$server.lock");
								# and uids file
								unlink ("$user-$server");
								return;


						}
				}
				#uids for webmail sorted as we read msgs
				if (!$opt{'w'}){
						%uids=%{$pop->uidl()};
				}
				if($opt{'w'} && @olduids==$msgs){
						print "All messages seen - skipping\n";
						unlink ("$server.lock");
						return;
				}
				my @msglist=();
				for($x=1;$x<=$msgs;$x++){
						if (!$opt{'w'} && grep /^$uids{$x}$/, @olduids){
								print "Message $x seen - skipping\n";
								next;
						}
						if (!$opt{'w'}){
								$msgref= $pop->top($x);
						}else{
								$msgref=getwebmsg($mailurls[$x-1]);
						}

						if ( $opt{'l'}){
								my ($title) =  grep /^Subject/,@{$msgref};
								chomp $title;
								$title =~ s/^Subject\s*:\s*//i;


								my ($fromline) = grep /^From/,@{$msgref};
								chomp $fromline;
								$fromline =~ s/^From\s*:\s*//i;
								push @msglist, "$x)'$title' from $fromline\n";
						}else{
								print "Message $x of $msgs:\n";
								# todo only get the first few for -w
								my ($from, $to, $date, $subject);
								my ($from) =  grep /^From/,@{$msgref};
								chomp $from;
								$from =~ s/^From\s*:\s*//i;
								if($opt{'fromregex'} && $from!~$opt{'fromregex'}){
										print "Fails from regex - skipping\n";
										next;
								}
								my ($to) =  grep /^To/,@{$msgref};
								chomp $to;
								$to =~ s/^To\s*:\s*//i;
								my ($subject) =  grep /^Subject/,@{$msgref};
								chomp $subject;
								$subject =~ s/^Subject\s*:\s*//i;
								if($opt{'subjregex'} && $subject!~$opt{'subjregex'}){
										print "Fails subject regex - skipping\n";
										next;
								}
								my ($date) =  grep /^Date/,@{$msgref};
								chomp $date;
								$date =~ s/^Date\s*:\s*//i;
								if($opt{'w'}){

										#my $thisuid="$from -> $to : $subject : $date";
										my ($thisuid)=grep /^Message-Id/i,@{$msgref};
										chomp $thisuid;
										$thisuid =~ s/^Message-Id:\s*//i;
										dprint ("UID:$thisuid\n");
										#if($thisuid eq " ->  :  : "){
										if(!$thisuid){
												print "Message $x not retrieved - skipping\n";
												next;
										}
										$uids{$x} = $thisuid;
										if (grep (/^\Q$thisuid\E$/, @olduids)){
												print "Message $x seen - skipping\n";
												next;
										}
										else{
												push @newuids,$thisuid;
										}
								}
								print "To: $to\n";
								print "From: $from\n";
								print "Subject: $subject\n";
								print "Date: $date\n";
								
								$todo="";
								while($todo !~ /^[ndq]$/i)
								{

										if ($opt{'doall'}){
												$todo = $opt{'doall'};
										}else{
												print "View/Next/Delete/Save/Quit? ";
												$todo=<STDIN>;
												chomp $todo;
												$todo = lc($todo);
										}
										dprint "Todo: '$todo'\n";
										if($todo eq "d")
										{
												if ($opt{'w'}){
														print "Sorry - can't delete individual messages with -w\n";
												}else{
														print "Deleting ...\n";
														$pop->delete($x);
												}
										}
										last if ($todo =~ /^[qnd]$/i);
										if ($todo eq 'v')
										{
												if ($opt{'w'}){
														@msgarr=@{$msgref};
												}else{
														@msgarr=@{$pop->get($x)};
												}
												printmsg(@msgarr);
										}elsif ($todo eq "s"){
												print "Saving message...\n";
												if ($opt{'w'}){
														@msgarr=@{$msgref};
												}else{
														@msgarr=@{$pop->get($x)};
												}
												savemsg($uids{$x},@msgarr);

										}

										if($opt{'doall'}){
												last;
										}

								}
								if($opt{'doall'}){
										next;
								}
								if ($todo eq 'q'){
										if ($opt{'w'}){
												print "Skipping all future messages\n";
												$opt{'doall'}='n';
										}else{
												last;
										}
								}
						}
				}

				if ($opt{'l'} && !$opt{'w'}){
						print @msglist;

						while (1){
								print "? ";
								$todo = <STDIN>;
								chomp $todo;
								if ( $todo eq "q" ){
										last;
								}
								elsif ($todo eq "?" || $todo eq ""){
										print " ? - help\n";
										print " q - quit\n";
										print " l - list messages\n";
										print " n - view msg n\n";
										print " dn - delete msg n\n";
										print " sn - delete msg n\n";
										next;
								}
								elsif ($todo eq "l"){
										print @msglist;
										next;
								}elsif ($todo =~ /^(\d+)-(\d+)l/){
										my $msgstart = $1;
										my $msgend = $2;
										print "Listing messages $msgstart to $msgend\n";
										for (my $m = $msgstart;$m<=$msgend;$m++){
												print ($msglist[$m-1]);
										}
										next;

								}
								# dodgy special case for multiple deletes
								elsif ($todo =~ /^(\d+)-(\d+)d/){
										my $msgstart = $1;
										my $msgend = $2;
										print "Deleting messages $msgstart to $msgend\n";
										for (my $m = $msgstart;$m<=$msgend;$m++){
												if (! $msglist [$m -1] ||
														$msglist [$m -1] =~ /^\d+ \) DELETED/) {
														print "Invalid message no $m\n";
														next;
												}else{
														print "Deleting message $m\n";
														$pop->delete($m);
														$msglist[$m-1] = "$m ) DELETED\n";
												}
										}
								}
								elsif ($todo =~ /^(\d+)(.?)/){
										my ($msgnum,$action)=($1,$2);

										if (! $msglist [$msgnum -1] ||
												$msglist [$msgnum -1] =~ /^\d+ \) DELETED/) {
												print "Invalid message no $msgnum\n";
												next;
										}
										elsif (!$action || $action eq "v"){
												my @msgarr = @{ $pop->get($msgnum) };
												printmsg(@msgarr);
										}elsif ($action eq "d"){
												$pop->delete($msgnum);
												$msglist[$msgnum-1] = "$msgnum ) DELETED\n";
										}elsif ($action eq "s"){
												my @msgarr = @{ $pop->get($msgnum) };
												savemsg ($uids{$msgnum},@msgarr);
										}
										else{
												print "Do what to message $msgnum?\n";
												next;
										}
								}
								else{
										print "Unknown command:$todo\n";
										print "Enter ? for help\n";
										next;
								}
								print @msglist;

						}


				}

        if (!$opt{'w'}){
						$pop->quit();
        }
        if (! $opt{'N'} && scalar($msgs)>0){
						open (OLD,">$user-$server");
						my(@saveuids);
						dprint @newuids;
						if($opt{'w'}){
								if($msgs==@newuids){
										@saveuids=@newuids;
								}else{
										@saveuids=@olduids;
										push @saveuids,@newuids;
								}
						}else{
								@saveuids=(values %uids);
						}
						foreach (@saveuids){
								next if (/^\s*$/);
								chomp;
								print OLD "$_\n";
								dprint "Adding $_ to old uid list\n";
						}
						close OLD;
				}
				#remove lockfile
				unlink ("$server.lock");
		}
}