# Net::POP3.pm
#
-# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# 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.
use Carp;
use Net::Config;
-$VERSION = "2.22"; # $Id: //depot/libnet/Net/POP3.pm#20 $
+$VERSION = "2.28";
@ISA = qw(Net::Cmd IO::Socket::INET);
{
my $self = shift;
my $type = ref($self) || $self;
- my $host = shift if @_ % 2;
- my %arg = @_;
+ 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} ): ();
$obj;
}
+sub host {
+ my $me = shift;
+ ${*$me}{'net_pop3_host'};
+}
+
##
## We don't want people sending me their passwords when they report problems
## now do we :-)
@_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
my($me,$user,$pass) = @_;
- if(@_ <= 2)
- {
- require Net::Netrc;
-
- $user ||= eval { (getpwuid($>))[0] } || $ENV{NAME};
-
- my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
-
- $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
-
- $pass = $m ? $m->password || ""
- : "";
- }
+ if (@_ <= 2) {
+ ($user, $pass) = $me->_lookup_credentials($user);
+ }
$me->user($user) and
$me->pass($pass);
@_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
my($me,$user,$pass) = @_;
my $banner;
-
- unless(eval { require MD5 })
- {
- carp "You need to install MD5 to use the APOP command";
+ my $md;
+
+ 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;
- }
+ }
return undef
unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0] );
- if(@_ <= 2)
- {
- require Net::Netrc;
-
- $user ||= eval { (getpwuid($>))[0] } || $ENV{NAME};
+ if (@_ <= 2) {
+ ($user, $pass) = $me->_lookup_credentials($user);
+ }
- my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
-
- $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
-
- $pass = $m ? $m->password || ""
- : "";
- }
-
- my $md = MD5->new;
$md->add($banner,$pass);
return undef
unless($me->_APOP($user,$md->hexdigest));
- my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
- ? $1 : ($me->popstat)[0];
-
- $ret ? $ret : "0E0";
+ $me->_get_mailbox_count();
}
sub user
return undef
unless($me->_PASS($pass));
- my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
- ? $1 : ($me->popstat)[0];
-
- $ret ? $ret : "0E0";
+ $me->_get_mailbox_count();
}
sub reset
$me->read_until_dot(@_);
}
+sub getfh
+{
+ @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
+ my $me = shift;
+
+ return unless $me->_RETR(shift);
+ return $me->tied_fh;
+}
+
+
+
sub delete
{
@_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
- $_[0]->_DELE($_[1]);
+ my $me = shift;
+ return 0 unless $me->_DELE(@_);
+ ${*$me}{'net_pop3_deleted'} = 1;
}
sub uidl
($1 || 0, $2 || 0);
}
+sub _lookup_credentials
+{
+ my ($me, $user) = @_;
+
+ require Net::Netrc;
+
+ $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } ||
+ $ENV{NAME} || $ENV{USER} || $ENV{LOGNAME};
+
+ my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
+ $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
+
+ my $pass = $m ? $m->password || ""
+ : "";
+
+ ($user, $pass);
+}
+
+sub _get_mailbox_count
+{
+ my ($me) = @_;
+ my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
+ ? $1 : ($me->popstat)[0];
+
+ $ret ? $ret : "0E0";
+}
+
sub _STAT { shift->command('STAT')->response() == CMD_OK }
sub _LIST { shift->command('LIST',@_)->response() == CMD_OK }
sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
sub _LAST { shift->command('LAST')->response() == CMD_OK }
+sub _CAPA { shift->command('CAPA')->response() == CMD_OK }
+
sub quit
{
my $me = shift;
{
my $me = shift;
- if(defined fileno($me))
+ if(defined fileno($me) and ${*$me}{'net_pop3_deleted'})
{
$me->reset;
$me->quit;
## 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 response {
+ my $cmd = shift;
+ my $str = $cmd->getline() or return undef;
+ my $code = "500";
- $cmd->debug_print(0,$str)
- if ($cmd->debug);
+ $cmd->debug_print(0, $str)
+ if ($cmd->debug);
- if($str =~ s/^\+OK\s+//io)
- {
- $code = "200"
+ if ($str =~ s/^\+OK\s*//io) {
+ $code = "200";
}
- else
- {
- $str =~ s/^-ERR\s+//io;
+ elsif ($str =~ s/^\+\s*//io) {
+ $code = "300";
+ }
+ else {
+ $str =~ s/^-ERR\s*//io;
}
- ${*$cmd}{'net_cmd_resp'} = [ $str ];
- ${*$cmd}{'net_cmd_code'} = $code;
+ ${*$cmd}{'net_cmd_resp'} = [$str];
+ ${*$cmd}{'net_cmd_code'} = $code;
+
+ substr($code, 0, 1);
+}
+
+
+sub capa {
+ my $this = shift;
+ my ($capa, %capabilities);
+
+ # Fake a capability here
+ $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/);
+
+ return \%capabilities unless $this->_CAPA();
+
+ $capa = $this->read_until_dot();
+ %capabilities = map { /^\s*(\S+)\s*(.*)/ } @$capa;
+ $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/);
+
+ return ${*$this}{'net_pop3e_capabilities'} = \%capabilities;
+}
+
+sub capabilities {
+ my $this = shift;
+
+ ${*$this}{'net_pop3e_capabilities'} || $this->capa;
+}
+
+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;
+ $sasl->mechanism($mechanisms);
+ }
+ else {
+ die "auth(username, password)" if not length $username;
+ $sasl = Authen::SASL->new(mechanism=> $mechanisms,
+ callback => { user => $username,
+ pass => $password,
+ authname => $username,
+ });
+ }
+
+ # 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 $client = $sasl->client_new('pop3',${*$self}{'net_pop3_host'},0);
+ my $str = $client->client_start;
+
+ # 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($str,'')
+ if defined $str and length $str;
+
+ while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
+ @cmd = (MIME::Base64::encode_base64(
+ $client->client_step(
+ MIME::Base64::decode_base64(
+ ($self->message)[0]
+ )
+ ), ''
+ ));
+ }
- substr($code,0,1);
+ $code == CMD_OK;
+}
+
+sub banner {
+ my $this = shift;
+
+ return ${*$this}{'net_pop3_banner'};
}
1;
=head1 NAME
-Net::POP3 - Post Office Protocol 3 Client class (RFC1081)
+Net::POP3 - Post Office Protocol 3 Client class (RFC1939)
=head1 SYNOPSIS
$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 RFC1081.
+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 EXAMPLES
-
- Need some small examples in here :-)
-
=head1 CONSTRUCTOR
=over 4
-=item new ( [ HOST, ] [ OPTIONS ] )
+=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 a POP3 connection is required.
+name of the remote host to which an POP3 connection is required.
-If C<HOST> is not given, then the C<POP3_Host> specified in C<Net::Config>
-will be used.
+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.
=over 4
+=item auth ( USERNAME, PASSWORD )
+
+Attempt SASL authentication.
+
=item user ( USER )
Send the USER command.
If there was an error authenticating the user then I<undef> will be returned.
-=item apop ( USER, PASS )
+=item apop ( [ USER [, PASS ]] )
Authenticate with the server identifying as C<USER> with password C<PASS>.
-Similar ti L<login>, but the password is not sent in clear text.
+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 ()
-To use this method you must have the MD5 package installed, if you do not
-this method will return I<undef>
+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 ] )
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 reset ()
-Reset the status of the remote POP3 server. This includes reseting the
+Reset the status of the remote POP3 server. This includes resetting the
status of all messages to not be deleted.
=item quit ()
=head1 SEE ALSO
-L<Net::Netrc>
+L<Net::Netrc>,
L<Net::Cmd>
=head1 AUTHOR
=head1 COPYRIGHT
-Copyright (c) 1995-1997 Graham Barr. All rights reserved.
+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.
-=for html <hr>
-
-I<$Id: //depot/libnet/Net/POP3.pm#20 $>
-
=cut