Ignore the OS X GNUmakefile*s, and t/test_state.
[p5sagit/p5-mst-13.2.git] / lib / Net / POP3.pm
index 538039e..8381c81 100644 (file)
 # Net::POP3.pm
 #
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
-# reserved. This program is free software; you can redistribute it and/or
+# Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 
 package Net::POP3;
 
-=head1 NAME
+use strict;
+use IO::Socket;
+use vars qw(@ISA $VERSION $debug);
+use Net::Cmd;
+use Carp;
+use Net::Config;
 
-Net::POP3 - Post Office Protocol 3 Client class (RFC1081)
+$VERSION = "2.29";
 
-=head1 SYNOPSIS
+@ISA = qw(Net::Cmd IO::Socket::INET);
 
-    use Net::POP3;
-    
-    # Constructors
-    $pop = Net::POP3->new('pop3host');
-    $pop = Net::POP3->new('pop3host', Timeout => 60);
 
-=head1 DESCRIPTION
+sub new {
+  my $self = shift;
+  my $type = ref($self) || $self;
+  my ($host, %arg);
+  if (@_ % 2) {
+    $host = shift;
+    %arg  = @_;
+  }
+  else {
+    %arg  = @_;
+    $host = delete $arg{Host};
+  }
+  my $hosts = defined $host ? [$host] : $NetConfig{pop3_hosts};
+  my $obj;
+  my @localport = exists $arg{ResvPort} ? (LocalPort => $arg{ResvPort}) : ();
+
+  my $h;
+  foreach $h (@{$hosts}) {
+    $obj = $type->SUPER::new(
+      PeerAddr => ($host = $h),
+      PeerPort => $arg{Port} || 'pop3(110)',
+      Proto => 'tcp',
+      @localport,
+      Timeout => defined $arg{Timeout}
+      ? $arg{Timeout}
+      : 120
+      )
+      and last;
+  }
 
-This module implements a client interface to the POP3 protocol, enabling
-a perl5 application to talk to POP3 servers. This documentation assumes
-that you are familiar with the POP3 protocol described in RFC1081.
+  return undef
+    unless defined $obj;
 
-A new Net::POP3 object must be created with the I<new> method. Once
-this has been done, all POP3 commands are accessed via method calls
-on the object.
+  ${*$obj}{'net_pop3_host'} = $host;
 
-=head1 EXAMPLES
+  $obj->autoflush(1);
+  $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
 
-    Need some small examples in here :-)
+  unless ($obj->response() == CMD_OK) {
+    $obj->close();
+    return undef;
+  }
 
-=head1 CONSTRUCTOR
+  ${*$obj}{'net_pop3_banner'} = $obj->message;
 
-=over 4
+  $obj;
+}
 
-=item new ( HOST, [ OPTIONS ] )
 
-This is the constructor for a new Net::POP3 object. C<HOST> is the
-name of the remote host to which a POP3 connection is required.
+sub host {
+  my $me = shift;
+  ${*$me}{'net_pop3_host'};
+}
 
-C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
-Possible options are:
+##
+## We don't want people sending me their passwords when they report problems
+## now do we :-)
+##
 
-B<Timeout> - Maximum time, in seconds, to wait for a response from the
-POP3 server (default: 120)
 
-B<Debug> - Enable debugging information
+sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; }
 
-=back
 
-=head1 METHODS
+sub login {
+  @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
+  my ($me, $user, $pass) = @_;
 
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, falure will be returned as I<undef> or an
-empty list.
+  if (@_ <= 2) {
+    ($user, $pass) = $me->_lookup_credentials($user);
+  }
 
-=over 4
+  $me->user($user)
+    and $me->pass($pass);
+}
 
-=item user ( USER )
 
-Send the USER command.
+sub apop {
+  @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
+  my ($me, $user, $pass) = @_;
+  my $banner;
+  my $md;
 
-=item pass ( PASS )
+  if (eval { local $SIG{__DIE__}; require Digest::MD5 }) {
+    $md = Digest::MD5->new();
+  }
+  elsif (eval { local $SIG{__DIE__}; require MD5 }) {
+    $md = MD5->new();
+  }
+  else {
+    carp "You need to install Digest::MD5 or MD5 to use the APOP command";
+    return undef;
+  }
 
-Send the PASS command. Returns the number of messages in the mailbox.
+  return undef
+    unless ($banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0]);
 
-=item login ( [ USER [, PASS ]] )
+  if (@_ <= 2) {
+    ($user, $pass) = $me->_lookup_credentials($user);
+  }
 
-Send both the the USER and PASS commands. If C<PASS> is not given the
-C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host
-and username. If the username is not specified then the current user name
-will be used.
+  $md->add($banner, $pass);
 
-Returns the number of messages in the mailbox.
+  return undef
+    unless ($me->_APOP($user, $md->hexdigest));
 
-=item top ( MSGNUM [, NUMLINES ] )
+  $me->_get_mailbox_count();
+}
 
-Get the header and the first C<NUMLINES> of the body for the message
-C<MSGNUM>. Returns a reference to an array which contains the lines of text
-read from the server.
 
-=item list ( [ MSGNUM ] )
+sub user {
+  @_ == 2 or croak 'usage: $pop3->user( USER )';
+  $_[0]->_USER($_[1]) ? 1 : undef;
+}
 
-If called with an argument the C<list> returns the size of the messsage
-in octets.
 
-If called without arguments the a refererence to a hash is returned. The
-keys will be the C<MSGNUM>'s of all undeleted messages and the values will
-be their size in octets.
+sub pass {
+  @_ == 2 or croak 'usage: $pop3->pass( PASS )';
 
-=item get ( MSGNUM )
+  my ($me, $pass) = @_;
 
-Get the message C<MSGNUM> from the remote mailbox. Returns a reference to an
-array which contains the lines of text read from the server.
+  return undef
+    unless ($me->_PASS($pass));
 
-=item last ()
+  $me->_get_mailbox_count();
+}
 
-Returns the highest C<MSGNUM> of all the messages accessed.
 
-=item popstat ()
+sub reset {
+  @_ == 1 or croak 'usage: $obj->reset()';
 
-Returns an array of two elements. These are the number of undeleted
-elements and the size of the mbox in octets.
+  my $me = shift;
 
-=item delete ( MSGNUM )
+  return 0
+    unless ($me->_RSET);
 
-Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages
-that are marked to be deleted will be removed from the remote mailbox
-when the server connection closed.
+  if (defined ${*$me}{'net_pop3_mail'}) {
+    local $_;
+    foreach (@{${*$me}{'net_pop3_mail'}}) {
+      delete $_->{'net_pop3_deleted'};
+    }
+  }
+}
 
-=item reset ()
 
-Reset the status of the remote POP3 server. This includes reseting the
-status of all messages to not be deleted.
+sub last {
+  @_ == 1 or croak 'usage: $obj->last()';
 
-=item quit ()
+  return undef
+    unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;
 
-Quit and close the connection to the remote POP3 server. Any messages marked
-as deleted will be deleted from the remote mailbox.
+  return $1;
+}
 
-=back
 
-=head1 NOTES
+sub top {
+  @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
+  my $me = shift;
 
-If a C<Net::POP3> object goes out of scope before C<quit> method is called
-then the C<reset> method will called before the connection is closed. This
-means that any messages marked to be deleted will not be.
+  return undef
+    unless $me->_TOP($_[0], $_[1] || 0);
 
-=head1 SEE ALSO
+  $me->read_until_dot;
+}
 
-L<Net::Netrc>
-L<Net::Cmd>
 
-=head1 AUTHOR
+sub popstat {
+  @_ == 1 or croak 'usage: $pop3->popstat()';
+  my $me = shift;
 
-Graham Barr <Graham.Barr@tiuk.ti.com>
+  return ()
+    unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;
 
-=head1 REVISION
+  ($1 || 0, $2 || 0);
+}
 
-$Revision: 2.1 $
-$Date: 1996/07/26 06:44:44 $
 
-The VERSION is derived from the revision by changing each number after the
-first dot into a 2 digit number so
+sub list {
+  @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
+  my $me = shift;
 
-       Revision 1.8   => VERSION 1.08
-       Revision 1.2.3 => VERSION 1.0203
+  return undef
+    unless $me->_LIST(@_);
 
-=head1 COPYRIGHT
+  if (@_) {
+    $me->message =~ /\d+\D+(\d+)/;
+    return $1 || undef;
+  }
 
-Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
-software; you can redistribute it and/or modify it under the same terms
-as Perl itself.
+  my $info = $me->read_until_dot
+    or return undef;
 
-=cut
+  my %hash = map { (/(\d+)\D+(\d+)/) } @$info;
 
-use strict;
-use IO::Socket;
-use vars qw(@ISA $VERSION $debug);
-use Net::Cmd;
-use Carp;
+  return \%hash;
+}
 
-$VERSION = do{my @r=(q$Revision: 2.1 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
 
-@ISA = qw(Net::Cmd IO::Socket::INET);
+sub get {
+  @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])';
+  my $me = shift;
 
-sub new
-{
- my $self = shift;
- my $type = ref($self) || $self;
- my $host = shift;
- my %arg  = @_; 
- my $obj = $type->SUPER::new(PeerAddr => $host, 
-                            PeerPort => $arg{Port} || 'pop3(110)',
-                            Proto    => 'tcp',
-                            Timeout  => defined $arg{Timeout}
-                                               ? $arg{Timeout}
-                                               : 120
-                           ) or return undef;
-
- ${*$obj}{'net_pop3_host'} = $host;
-
- $obj->autoflush(1);
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-
- unless ($obj->response() == CMD_OK)
-  {
-   $obj->close();
-   return undef;
-  }
+  return undef
+    unless $me->_RETR(shift);
 
- $obj;
+  $me->read_until_dot(@_);
 }
 
-##
-## We don't want people sending me their passwords when they report problems
-## now do we :-)
-##
 
-sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; }
+sub getfh {
+  @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
+  my $me = shift;
 
-sub login
-{
- @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
- my($me,$user,$pass) = @_;
+  return unless $me->_RETR(shift);
+  return $me->tied_fh;
+}
 
- if(@_ < 2)
-  {
-   require Net::Netrc;
 
-   $user ||= (getpwuid($>))[0];
+sub delete {
+  @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
+  my $me = shift;
+  return 0 unless $me->_DELE(@_);
+  ${*$me}{'net_pop3_deleted'} = 1;
+}
 
-   my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
 
-   $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
+sub uidl {
+  @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )';
+  my $me = shift;
+  my $uidl;
 
-   $pass = $m ? $m->password || ""
-              : "";
+  $me->_UIDL(@_)
+    or return undef;
+  if (@_) {
+    $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0];
   }
-
- $me->user($user) and
-    $me->pass($pass);
+  else {
+    my $ref = $me->read_until_dot
+      or return undef;
+    my $ln;
+    $uidl = {};
+    foreach $ln (@$ref) {
+      my ($msg, $uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/;
+      $uidl->{$msg} = $uid;
+    }
+  }
+  return $uidl;
 }
 
-sub user
-{
- @_ == 2 or croak 'usage: $pop3->user( USER )';
- $_[0]->_USER($_[1]);
+
+sub ping {
+  @_ == 2 or croak 'usage: $pop3->ping( USER )';
+  my $me = shift;
+
+  return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/;
+
+  ($1 || 0, $2 || 0);
 }
 
-sub pass
-{
- @_ == 2 or croak 'usage: $pop3->pass( PASS )';
 
- my($me,$pass) = @_;
+sub _lookup_credentials {
+  my ($me, $user) = @_;
 
- return undef
-   unless($me->_PASS($pass));
+  require Net::Netrc;
 
- $me->message =~ /(\d+)\s+message/io;
+       $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] }
+    || $ENV{NAME}
+    || $ENV{USER}
+    || $ENV{LOGNAME};
 
- ${*$me}{'net_pop3_count'} = $1 || 0;
-}
+  my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'}, $user);
+  $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
 
-sub reset
-{
- @_ == 1 or croak 'usage: $obj->reset()';
-
- my $me = shift;
-
- return 0 
-   unless($me->_RSET);
-  
- if(defined ${*$me}{'net_pop3_mail'})
-  {
-   local $_;
-   foreach (@{${*$me}{'net_pop3_mail'}})
-    {
-     delete $_->{'net_pop3_deleted'};
-    }
-  }
+  my $pass = $m
+    ? $m->password || ""
+    : "";
+
+  ($user, $pass);
 }
 
-sub last
-{
- @_ == 1 or croak 'usage: $obj->last()';
 
- return undef
-    unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;
+sub _get_mailbox_count {
+  my ($me) = @_;
+  my $ret = ${*$me}{'net_pop3_count'} =
+    ($me->message =~ /(\d+)\s+message/io) ? $1 : ($me->popstat)[0];
 
- return $1;
+  $ret ? $ret : "0E0";
 }
 
-sub top
-{
- @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
- my $me = shift;
 
- return undef
-    unless $me->_TOP($_[0], $_[1] || 0);
+sub _STAT { shift->command('STAT')->response() == CMD_OK }
+sub _LIST { shift->command('LIST', @_)->response() == CMD_OK }
+sub _RETR { shift->command('RETR', $_[0])->response() == CMD_OK }
+sub _DELE { shift->command('DELE', $_[0])->response() == CMD_OK }
+sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
+sub _RSET { shift->command('RSET')->response() == CMD_OK }
+sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
+sub _TOP  { shift->command('TOP', @_)->response() == CMD_OK }
+sub _UIDL { shift->command('UIDL', @_)->response() == CMD_OK }
+sub _USER { shift->command('USER', $_[0])->response() == CMD_OK }
+sub _PASS { shift->command('PASS', $_[0])->response() == CMD_OK }
+sub _APOP { shift->command('APOP', @_)->response() == CMD_OK }
+sub _PING { shift->command('PING', $_[0])->response() == CMD_OK }
 
- $me->read_until_dot;
-}
 
-sub popstat
-{
- @_ == 1 or croak 'usage: $pop3->popstat()';
- my $me = shift;
+sub _RPOP { shift->command('RPOP', $_[0])->response() == CMD_OK }
+sub _LAST { shift->command('LAST')->response() == CMD_OK }
 
- return ()
-    unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;
 
- ($1 || 0, $2 || 0);
+sub _CAPA { shift->command('CAPA')->response() == CMD_OK }
+
+
+sub quit {
+  my $me = shift;
+
+  $me->_QUIT;
+  $me->close;
 }
 
-sub list
-{
- @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
- my $me = shift;
 
- return undef
-    unless $me->_LIST(@_);
+sub DESTROY {
+  my $me = shift;
 
- if(@_)
-  {
-   $me->message =~ /\d+\D+(\d+)/;
-   return $1 || undef;
+  if (defined fileno($me) and ${*$me}{'net_pop3_deleted'}) {
+    $me->reset;
+    $me->quit;
   }
- my $info = $me->read_until_dot;
- my %hash = ();
- map { /(\d+)\D+(\d+)/; $hash{$1} = $2; } @$info;
-
- return \%hash;
 }
 
-sub get
-{
- @_ == 2 or croak 'usage: $pop3->get( MSGNUM )';
- my $me = shift;
+##
+## POP3 has weird responses, so we emulate them to look the same :-)
+##
+
 
- return undef
-    unless $me->_RETR(@_);
+sub response {
+  my $cmd  = shift;
+  my $str  = $cmd->getline() or return undef;
+  my $code = "500";
 
- $me->read_until_dot;
-}
+  $cmd->debug_print(0, $str)
+    if ($cmd->debug);
 
-sub delete
-{
- @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
- $_[0]->_DELE($_[1]);
+  if ($str =~ s/^\+OK\s*//io) {
+    $code = "200";
+  }
+  elsif ($str =~ s/^\+\s*//io) {
+    $code = "300";
+  }
+  else {
+    $str =~ s/^-ERR\s*//io;
+  }
+
+  ${*$cmd}{'net_cmd_resp'} = [$str];
+  ${*$cmd}{'net_cmd_code'} = $code;
+
+  substr($code, 0, 1);
 }
 
-sub _USER { shift->command('USER',$_[0])->response() == CMD_OK }
-sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK }
-sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
-sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK }
-sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK }
-sub _TOP  { shift->command('TOP', @_)->response() == CMD_OK }
-sub _LIST { shift->command('LIST',@_)->response() == CMD_OK }
-sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
-sub _RSET { shift->command('RSET')->response() == CMD_OK }
-sub _LAST { shift->command('LAST')->response() == CMD_OK }
-sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
-sub _STAT { shift->command('STAT')->response() == CMD_OK }
 
-sub close
-{
- my $me = shift;
+sub capa {
+  my $this = shift;
+  my ($capa, %capabilities);
 
- return 1
-   unless (ref($me) && defined fileno($me));
+  # Fake a capability here
+  $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/);
 
- $me->_QUIT && $me->SUPER::close;
+  if ($this->_CAPA()) {
+    $capabilities{CAPA} = 1;
+    $capa = $this->read_until_dot();
+    %capabilities = (%capabilities, map {/^\s*(\S+)\s*(.*)/} @$capa);
+  }
+  else {
+
+    # Check AUTH for SASL capabilities
+    if ($this->command('AUTH')->response() == CMD_OK) {
+      my $mechanism = $this->read_until_dot();
+      $capabilities{SASL} = join " ", map {m/([A-Z0-9_-]+)/} @{$mechanism};
+    }
+  }
+
+  return ${*$this}{'net_pop3e_capabilities'} = \%capabilities;
 }
 
-sub quit    { shift->close }
 
-sub DESTROY
-{
- my $me = shift;
+sub capabilities {
+  my $this = shift;
 
- if(fileno($me))
-  {
-   $me->reset;
-   $me->quit;
-  }
+  ${*$this}{'net_pop3e_capabilities'} || $this->capa;
 }
 
-##
-## POP3 has weird responses, so we emulate them to look the same :-)
-##
 
-sub response
-{
- my $cmd = shift;
- my $str = $cmd->getline() || return undef;
- my $code = "500";
+sub auth {
+  my ($self, $username, $password) = @_;
+
+  eval {
+    require MIME::Base64;
+    require Authen::SASL;
+  } or $self->set_status(500, ["Need MIME::Base64 and Authen::SASL todo auth"]), return 0;
+
+  my $capa       = $self->capa;
+  my $mechanisms = $capa->{SASL} || 'CRAM-MD5';
+
+  my $sasl;
+
+  if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) {
+    $sasl = $username;
+    my $user_mech = $sasl->mechanism || '';
+    my @user_mech = split(/\s+/, $user_mech);
+    my %user_mech;
+    @user_mech{@user_mech} = ();
+
+    my @server_mech = split(/\s+/, $mechanisms);
+    my @mech = @user_mech
+      ? grep { exists $user_mech{$_} } @server_mech
+      : @server_mech;
+    unless (@mech) {
+      $self->set_status(
+        500,
+        [ 'Client SASL mechanisms (',
+          join(', ', @user_mech),
+          ') do not match the SASL mechnism the server announces (',
+          join(', ', @server_mech), ')',
+        ]
+      );
+      return 0;
+    }
 
- $cmd->debug_print(0,$str)
-   if ($cmd->debug);
+    $sasl->mechanism(join(" ", @mech));
+  }
+  else {
+    die "auth(username, password)" if not length $username;
+    $sasl = Authen::SASL->new(
+      mechanism => $mechanisms,
+      callback  => {
+        user     => $username,
+        pass     => $password,
+        authname => $username,
+      }
+    );
+  }
 
- if($str =~ s/^\+OK\s+//io)
-  {
-   $code = "200"
+  # We should probably allow the user to pass the host, but I don't
+  # currently know and SASL mechanisms that are used by smtp that need it
+  my ($hostname) = split /:/, ${*$self}{'net_pop3_host'};
+  my $client = eval { $sasl->client_new('pop', $hostname, 0) };
+
+  unless ($client) {
+    my $mech = $sasl->mechanism;
+    $self->set_status(
+      500,
+      [ " Authen::SASL failure: $@",
+        '(please check if your local Authen::SASL installation',
+        "supports mechanism '$mech'"
+      ]
+    );
+    return 0;
   }
- else
-  {
-   $str =~ s/^\+ERR\s+//io;
+
+  my ($token) = $client->client_start
+    or do {
+    my $mech = $client->mechanism;
+    $self->set_status(
+      500,
+      [ ' Authen::SASL failure:  $client->client_start ',
+        "mechanism '$mech' hostname #$hostname#",
+        $client->error
+      ]
+    );
+    return 0;
+    };
+
+  # We dont support sasl mechanisms that encrypt the socket traffic.
+  # todo that we would really need to change the ISA hierarchy
+  # so we dont inherit from IO::Socket, but instead hold it in an attribute
+
+  my @cmd = ("AUTH", $client->mechanism);
+  my $code;
+
+  push @cmd, MIME::Base64::encode_base64($token, '')
+    if defined $token and length $token;
+
+  while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
+
+    my ($token) = $client->client_step(MIME::Base64::decode_base64(($self->message)[0])) or do {
+      $self->set_status(
+        500,
+        [ ' Authen::SASL failure:  $client->client_step ',
+          "mechanism '", $client->mechanism, " hostname #$hostname#, ",
+          $client->error
+        ]
+      );
+      return 0;
+    };
+
+    @cmd = (MIME::Base64::encode_base64(defined $token ? $token : '', ''));
   }
 
- ${*$cmd}{'net_cmd_resp'} = [ $str ];
- ${*$cmd}{'net_cmd_code'} = $code;
+  $code == CMD_OK;
+}
+
+
+sub banner {
+  my $this = shift;
 
- substr($code,0,1);
+  return ${*$this}{'net_pop3_banner'};
 }
 
 1;
+
+__END__
+
+=head1 NAME
+
+Net::POP3 - Post Office Protocol 3 Client class (RFC1939)
+
+=head1 SYNOPSIS
+
+    use Net::POP3;
+
+    # Constructors
+    $pop = Net::POP3->new('pop3host');
+    $pop = Net::POP3->new('pop3host', Timeout => 60);
+
+    if ($pop->login($username, $password) > 0) {
+      my $msgnums = $pop->list; # hashref of msgnum => size
+      foreach my $msgnum (keys %$msgnums) {
+        my $msg = $pop->get($msgnum);
+        print @$msg;
+        $pop->delete($msgnum);
+      }
+    }
+
+    $pop->quit;
+
+=head1 DESCRIPTION
+
+This module implements a client interface to the POP3 protocol, enabling
+a perl5 application to talk to POP3 servers. This documentation assumes
+that you are familiar with the POP3 protocol described in RFC1939.
+
+A new Net::POP3 object must be created with the I<new> method. Once
+this has been done, all POP3 commands are accessed via method calls
+on the object.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ HOST ] [, OPTIONS ] 0
+
+This is the constructor for a new Net::POP3 object. C<HOST> is the
+name of the remote host to which an POP3 connection is required.
+
+C<HOST> is optional. If C<HOST> is not given then it may instead be
+passed as the C<Host> option described below. If neither is given then
+the C<POP3_Hosts> specified in C<Net::Config> will be used.
+
+C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
+Possible options are:
+
+B<Host> - POP3 host to connect to. It may be a single scalar, as defined for
+the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
+an array with hosts to try in turn. The L</host> method will return the value
+which was used to connect to the host.
+
+B<ResvPort> - If given then the socket for the C<Net::POP3> object
+will be bound to the local port given using C<bind> when the socket is
+created.
+
+B<Timeout> - Maximum time, in seconds, to wait for a response from the
+POP3 server (default: 120)
+
+B<Debug> - Enable debugging information
+
+=back
+
+=head1 METHODS
+
+Unless otherwise stated all methods return either a I<true> or I<false>
+value, with I<true> meaning that the operation was a success. When a method
+states that it returns a value, failure will be returned as I<undef> or an
+empty list.
+
+=over 4
+
+=item auth ( USERNAME, PASSWORD )
+
+Attempt SASL authentication.
+
+=item user ( USER )
+
+Send the USER command.
+
+=item pass ( PASS )
+
+Send the PASS command. Returns the number of messages in the mailbox.
+
+=item login ( [ USER [, PASS ]] )
+
+Send both the USER and PASS commands. If C<PASS> is not given the
+C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host
+and username. If the username is not specified then the current user name
+will be used.
+
+Returns the number of messages in the mailbox. However if there are no
+messages on the server the string C<"0E0"> will be returned. This is
+will give a true value in a boolean context, but zero in a numeric context.
+
+If there was an error authenticating the user then I<undef> will be returned.
+
+=item apop ( [ USER [, PASS ]] )
+
+Authenticate with the server identifying as C<USER> with password C<PASS>.
+Similar to L</login>, but the password is not sent in clear text.
+
+To use this method you must have the Digest::MD5 or the MD5 module installed,
+otherwise this method will return I<undef>.
+
+=item banner ()
+
+Return the sever's connection banner
+
+=item capa ()
+
+Return a reference to a hash of the capabilities of the server.  APOP
+is added as a pseudo capability.  Note that I've been unable to
+find a list of the standard capability values, and some appear to
+be multi-word and some are not.  We make an attempt at intelligently
+parsing them, but it may not be correct.
+
+=item  capabilities ()
+
+Just like capa, but only uses a cache from the last time we asked
+the server, so as to avoid asking more than once.
+
+=item top ( MSGNUM [, NUMLINES ] )
+
+Get the header and the first C<NUMLINES> of the body for the message
+C<MSGNUM>. Returns a reference to an array which contains the lines of text
+read from the server.
+
+=item list ( [ MSGNUM ] )
+
+If called with an argument the C<list> returns the size of the message
+in octets.
+
+If called without arguments a reference to a hash is returned. The
+keys will be the C<MSGNUM>'s of all undeleted messages and the values will
+be their size in octets.
+
+=item get ( MSGNUM [, FH ] )
+
+Get the message C<MSGNUM> from the remote mailbox. If C<FH> is not given
+then get returns a reference to an array which contains the lines of
+text read from the server. If C<FH> is given then the lines returned
+from the server are printed to the filehandle C<FH>.
+
+=item getfh ( MSGNUM )
+
+As per get(), but returns a tied filehandle.  Reading from this
+filehandle returns the requested message.  The filehandle will return
+EOF at the end of the message and should not be reused.
+
+=item last ()
+
+Returns the highest C<MSGNUM> of all the messages accessed.
+
+=item popstat ()
+
+Returns a list of two elements. These are the number of undeleted
+elements and the size of the mbox in octets.
+
+=item ping ( USER )
+
+Returns a list of two elements. These are the number of new messages
+and the total number of messages for C<USER>.
+
+=item uidl ( [ MSGNUM ] )
+
+Returns a unique identifier for C<MSGNUM> if given. If C<MSGNUM> is not
+given C<uidl> returns a reference to a hash where the keys are the
+message numbers and the values are the unique identifiers.
+
+=item delete ( MSGNUM )
+
+Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages
+that are marked to be deleted will be removed from the remote mailbox
+when the server connection closed.
+
+=item reset ()
+
+Reset the status of the remote POP3 server. This includes resetting the
+status of all messages to not be deleted.
+
+=item quit ()
+
+Quit and close the connection to the remote POP3 server. Any messages marked
+as deleted will be deleted from the remote mailbox.
+
+=back
+
+=head1 NOTES
+
+If a C<Net::POP3> object goes out of scope before C<quit> method is called
+then the C<reset> method will called before the connection is closed. This
+means that any messages marked to be deleted will not be.
+
+=head1 SEE ALSO
+
+L<Net::Netrc>,
+L<Net::Cmd>
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995-2003 Graham Barr. All rights reserved.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut