#!/usr/bin/perl -w
#
# $Id: popmail,v 1.18 1999/04/01 16:49:33 ejb Exp $
# $Source: /home/ejb/scripts/RCS/popmail,v $
# $Author: ejb $
#
# POPMail (RFC1081) interface for perl.  Append pop mail from given
# location to local mailbox.
#

require 5.004;
use strict;
use IO::Socket;

my $whoami = ($0 =~ m,([^/]*)$,) ? $1 : $0;
my $verbose = 0;
my $no_delete = 0;

package POP;
use vars qw($pkgname $f_connection $f_mailbox $f_sizes);
use vars qw($maildir $me $def_mailbox);

$pkgname = "POP";

$f_connection = "connection";
$f_mailbox = "mailbox";
$f_sizes = "sizes";

$maildir = ((-d "/var/mail/.") ? "/var/mail" :
	    (-d "/usr/mail/.") ? "/usr/mail" :
	    (-d "/var/spool/mail/.") ? "/var/spool/mail" :
	    "/usr/spool/mail");
$me = $ENV{'USER'} || $ENV{'LOGNAME'} || ((getpwuid($<))[0]) ||
    die "$whoami: unknown user\n";
$def_mailbox = "$maildir/$me";

sub new
{
    shift;
    my $rep = +{ $pkgname => {} };
    my ($host, $port, $mailbox) = @_;
    ($mailbox eq "") && ($mailbox = $def_mailbox);
    
    $rep->{$pkgname}{$f_connection} = undef;

    my $init = "";
    my $proxy = $ENV{'POP_PROXY'} || "";
    if ($proxy ne "")
    {
	$init = "c $host $port";
	$host = $proxy;
	$port = "telnet";
    }

    my $connection = new IO::Socket::INET(PeerAddr => $host,
					  PeerPort => $port);

    $rep->{$pkgname}{$f_connection} = $connection;
    $rep->{$pkgname}{$f_mailbox} = $mailbox;
    $rep->{$pkgname}{$f_sizes} = [];

    bless $rep;

    $rep->send($init);

    $rep;
}

sub connected
{
    my $rep = shift;
    defined($rep->{$pkgname}{$f_connection});
}

sub assert_connected
{
    my $rep = shift;
    $rep->connected() || die "$whoami: not connected\n";
}

sub connection
{
    my $rep = shift;
    $rep->assert_connected();
    $rep->{$pkgname}{$f_connection};
}

sub mailbox
{
    my $rep = shift;
    $rep->{$pkgname}{$f_mailbox};
}

sub sizes
{
    my $rep = shift;
    $rep->{$pkgname}{$f_sizes};
}

sub send
{
    my $rep = shift;
    $rep->assert_connected();
    my $msg = shift;
    my $c = $rep->connection();

    $c->print("$msg\n") if $msg ne "";
    if ($verbose >= 2)
    {
	$msg =~ s/^pass (.*)$/pass xxxx/;
	print $msg, "\n";
    }
    my ($status, $status_msg);
    my $found = 0;
    my ($l);
    while (1)
    {
	$l = $c->getline();
	last if ! defined($l);
	print $l if $verbose >= 2;
	if ($l =~ m/[+-](OK|ERR)\s*(.*)\r*$/)
	{
	    ($status, $status_msg) = ($1, $2);
	    $found = 1;
	    last;
	}
    }
    die "$whoami: no response code\n" if ! $found;
    ($status ne "OK") && die "$whoami: $status_msg\n";
    $status_msg;
}

sub list
{
    my $rep = shift;
    $rep->assert_connected();
    my $c = $rep->connection();

    $c->print("list\n");
    if ($verbose >= 2)
    {
	print "list\n";
    }
    my ($status, $status_msg);
    my $found = 0;
    my ($l);
    while (1)
    {
	$l = $c->getline();
	last if ! defined($l);
	print $l if $verbose >= 2;
	if ($l =~ m/[+-](OK|ERR)\s*(.*)\r*$/)
	{
	    ($status, $status_msg) = ($1, $2);
	    $found = 1;
	    last;
	}
    }
    die "$whoami: no response code\n" if ! $found;
    ($status ne "OK") && die "$whoami: $status_msg\n";
    my $sizes = $rep->sizes();
    my $n = 1;
    while (1)
    {
	$l = $c->getline();
	last if ! defined($l);
	last if $l =~ m/^\./;
	print $l if $verbose >= 2;
	if ($l =~ m/^(\d+) (\d+)/)
	{
	    my ($msgnum, $size) = ($1, $2);
	    if ($msgnum != $n)
	    {
		die "$whoami: sequence error in output of LIST command\n";
	    }
	    ++$n;
	    push(@$sizes, $size);
	}
	else
	{
	    die "$whoami: invalid response to LIST command: $l";
	}
    }
}

sub login
{
    my $rep = shift;
    my ($user, $pass, $host) = @_;
    $rep->send("user $user");
    if ($pass eq "")
    {
	my $t = $|;
	$| = 1;
	system("stty -echo");
	print "Enter POP password for $user\@$host: ";
	$| = $t;
	$pass = <STDIN>;
	print "\n";
	system("stty echo");
	exit 0 unless defined $pass;
	chop($pass);
    }
    $rep->send("pass $pass");
    $rep->list();
}

sub num_messages
{
    my $rep = shift;
    my $result = $rep->send("stat");
    my($messages, $octets) = split(' ', $result);
    if ($messages > 0)
    {
	print +("You have $messages message" .
		(($messages == 1) ? "" : "s") .
		" ($octets bytes).\n");
    }
    else
    {
	print "You have no new messages.\n";
    }
    $messages;
}

sub retrieve
{
    my $rep = shift;
    $rep->assert_connected();
    my $c = $rep->connection();

    my ($msgnum, $num_msgs) = @_;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,@trash) = gmtime(time);
    @trash = ();

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

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

    my @msg = ();
    my @hdr = ();
    my $in_hdr = 1;

    $rep->send("retr $msgnum");

    # 
    # Date strings code stolen from Bill Reynolds' (bill@goshawk.lanl.gov)
    # modification of William M. Perry's (wmperry@indiana.edu) pop
    # program.
    #
    # Some mailers are very persnickity about the time string, 
    # hence the goop. BR Wed Sep  8 14:52:34 MDT 1993
    # 
    push(@msg, 
	 sprintf("From popserver %s %s %2d %02d:%02d:%02d GMT 19%02d\n",
		 $day[$wday],$month[$mon],$mday,$hour,$min,$sec,$year));
    my $l;
    while (1)
    {
	$l = $c->getline();
	last if ! defined($l);
	last if ($l =~ m/^\.\r*$/);
	$l =~ s/\r//g;
	push(@msg, $l);
	if ($in_hdr)
	{
	    if ($l ne "")
	    {
		push(@hdr, $l);
	    }
	    else
	    {
		$in_hdr = 0;
	    }
	}
    }

    &show_from_info($msgnum, $num_msgs, @hdr) if $verbose >= 1;

    my $mailbox = $rep->mailbox();
    open(MAILBOX, ">>$mailbox") || die "$whoami: can't open $mailbox: $!\n";
    
    for (@msg)
    {
	print MAILBOX;
    }
    if ($msg[-1] ne "\n")
    {
	print MAILBOX "\n";
    }
    if (! close MAILBOX)
    {
	warn "$whoami: can't close mailbox; not deleting message\n";
	return;
    }

    $rep->send("dele $msgnum") unless $no_delete;
}

sub show_from_info
{
    my ($msgnum, $num_msgs, @lines) = @_;

    my $width = length($num_msgs);
    my $num = sprintf("%${width}d. ", $msgnum);
    my $blanks = ' ' x length($num);
    my $first = 1;
    my $l;

    foreach $l (@lines)
    {
	$l =~ s/\r//g;
	if ($l =~ m/^(From|Subject):/i)
	{
	    print +($first ? $num : $blanks);
	    $first = 0;
	    print $l;
	}
    }
}

sub from
{
    my $rep = shift;
    $rep->assert_connected();
    my $c = $rep->connection();

    my ($msgnum, $num_msgs) = @_;
    $rep->send("top $msgnum 0");

    my $l;
    my @lines;
    while (1)
    {
	$l = $c->getline();
	last if ! defined($l);
	last if ($l =~ m/^\.\r*$/);
	push(@lines, $l);
    }
    &show_from_info($msgnum, $num_msgs, @lines);
}

sub DESTROY
{
    my $rep = shift;
    if ($rep->connected())
    {
	$rep->send("quit");
    }
}

package main;

my $list = 0;
my $user = "";
my $host = "";
my $pass = "";
my $login = "";
my $mailbox = "";
my $maxsize = 0;

&usage if (@ARGV < 1);
while (@ARGV)
{
    my $arg = shift(@ARGV);
    if ($arg eq "-v")
    {
	$verbose = 1;
    }
    elsif ($arg eq "-vv")
    {
	$verbose = 2;
    }
    elsif ($arg eq "-l")
    {
	$list = 1;
    }
    elsif ($arg eq "-n")
    {
	$no_delete = 1;
    }
    elsif ($arg eq "-p")
    {
	&usage if (@ARGV < 1);
	$pass = shift(@ARGV);
    }
    elsif ($arg eq "-m")
    {
	&usage if (@ARGV < 1);
	$mailbox = shift(@ARGV);
    }
    elsif ($arg eq "-maxsize")
    {
	&usage if (@ARGV < 1);
	$maxsize = shift(@ARGV);
    }
    else
    {
	&usage if ($login ne "");
	$login = $arg;
    }
}    

&usage if ($login eq "");
&usage if ($login !~ m/^([^\@]+)\@([^\@]+)$/);

$SIG{'INT'} = $SIG{'HUP'} = $SIG{'TERM'} = sub { exit 0; };
END { &cleanup; }

($user, $host) = ($1, $2);

# hardcode port number; some people don't have pop3 in services file
my $port = 110;

my $s = new POP($host, $port, $mailbox);
print "$whoami: connected to $host.\n" if $verbose >= 1;
print "$whoami: not deleting messages after download\n" if $no_delete;
$s->login($user, $pass, $host);

my $msgs = $s->num_messages();
my $sizes = $s->sizes();
my $msg;
for ($msg = 1; $msg <= $msgs; $msg++)
{
    if ($list)
    {
	$s->from($msg, $msgs);
    }
    else
    {
	my $size = $sizes->[$msg - 1];
	if ($maxsize && ($size > $maxsize))
	{
	    print "skipping message $msg ($size > $maxsize)\n";
	}
	else
	{
	    $s->retrieve($msg, $msgs);
	}
    }
}

sub cleanup
{
    system("stty echo");
}

sub usage
{
    print STDERR <<EOF;
Usage: $whoami user\@host [ -v ] [ -p pass ] [ -l ] [ -n ] [-m mailbox]
  -v is verbose -- show exchange with POP server
  -p pass supplies a password; otherwise user is prompted
  -l means list only
  -n means do not delete messages from the server after downloading
  -m mailbox allows specification of other than default mailbox for
     messages to be appended to
  -maxsize n means do not download messages larger than n bytes
EOF
    ;
    exit 1;
}