#!/afs/athena/contrib/perl/perl

require "open2.pl";

package popmail;

$ENV{'MAILHOST'} = "dt";

$debug = 1; 

sub cmd 
{
    local ($command, $expect_multiple) = @_;
    local ($response_line, $text, $/);
    print "--> $command\n" if $debug;
    print WTR $command, "\n";
    $/ = "\r\n";
    $response_line = <RDR>;
    print "<--- $response_line" if $debug;
    if ($response_line =~ /^-ERR/) { # Error
	return (0, $response_line, $text);
    }
    if ($expect_multiple) {
	$/ = "\r\n\.\r\n";
	$text = <RDR>;
	print "<-- $text" if $debug;
    }
    return (1, $response_line, $text);
}

sub abort 
{
    kill ($pid);
    exit 1;
}

sub parse_response 
{
    local ($response) = @_;
    if ($response =~ /^(\+OK|\-ERR) (.*)\r?\n/) {
	return $2;	
    } 
    else {
	print STDERR "Invalid response from server: $response";
	&abort ();
    }
} 

sub clean_text 
{
    local ($text) = @_;
    $text =~ tr/\r//;
    return $text;
}

sub user 
{
    local ($user) = @_;
    $user || ($user = $ENV{'USER'} || (getpwuid ($<))[0]);
    local ($status, $response, $text) = &cmd ("USER " . $user, 0);
    local ($msg);
    $msg = &parse_response ($response);
    print "$msg\n" if $debug;
    return ($status, $msg); 	
}

sub pass 
{
    local ($pass) = @_;
    $pass || ($pass = $ENV{'USER'} || (getpwuid ($<))[0]);
    local ($status, $response, $text) = &cmd ("PASS " . $pass, 0);
    local ($msg);
    $msg = &parse_response ($response);
    print "$msg\n" if $debug;
    return ($status, $msg); 	
}

sub list 
{
    local ($msgno) = @_;
    local ($status, $response, $text);
    if ($msgno) {
	($status, $response, $text) = &cmd ("LIST $msgno", 0);
    }
    else { 
	($status, $response, $text) = &cmd ('LIST', 1);
    }
    local ($msg);
    $msg = &parse_response ($response);
    print "$msg\n" if $debug;
    local (%sizes);
    if ($msgno) {
	%sizes = split (/\s+/, $msg);
    }
    else {
	%sizes = split (/\s+/, $text);
    }
    return ($status, $msg, %sizes);
}

sub quit 
{
    local ($status, $response, $text) = &cmd ('QUIT', 0);
    local ($msg);
    $msg = &parse_response ($response);
    print "$msg\n" if $debug;
    return ($status, $msg); 	
}

sub init
{
 $pid = &main'open2 ('RDR', 'WTR', 'kpoptcp');
 local ($response);
 $response = <RDR>;

 return &parse_response ($response);
}

$greeting = &popmail'init ();
print "greeting = $greeting\n";
&popmail'user ();
&popmail'pass ();
($status, $msg, %sizes) = &popmail'list (2);
print "status is $status\n";
print "msg is $msg\n";
print join ("\n", %sizes);
print "\n";
&popmail'quit ();
