X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNet%2FPOP3.pm;h=146041624e73fac748f4e759e222c8c9eeefd0fa;hb=9c36735de2bc373cab0c4275429b13fc1c754d20;hp=538039e5cdb14cd12302ec9dcb77589f1d7a110f;hpb=7e1af8bca57f405a8444b575a870918a6d88fc5c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Net/POP3.pm b/lib/Net/POP3.pm index 538039e..1460416 100644 --- a/lib/Net/POP3.pm +++ b/lib/Net/POP3.pm @@ -1,170 +1,19 @@ # Net::POP3.pm # -# Copyright (c) 1995 Graham Barr . All rights -# reserved. This program is free software; you can redistribute it and/or +# Copyright (c) 1995-1997 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. package Net::POP3; -=head1 NAME - -Net::POP3 - Post Office Protocol 3 Client class (RFC1081) - -=head1 SYNOPSIS - - use Net::POP3; - - # Constructors - $pop = Net::POP3->new('pop3host'); - $pop = Net::POP3->new('pop3host', Timeout => 60); - -=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. - -A new Net::POP3 object must be created with the I 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 ] ) - -This is the constructor for a new Net::POP3 object. C is the -name of the remote host to which a POP3 connection is required. - -C are passed in a hash like fasion, using key and value pairs. -Possible options are: - -B - Maximum time, in seconds, to wait for a response from the -POP3 server (default: 120) - -B - Enable debugging information - -=back - -=head1 METHODS - -Unless otherwise stated all methods return either a I or I -value, with I meaning that the operation was a success. When a method -states that it returns a value, falure will be returned as I or an -empty list. - -=over 4 - -=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 the USER and PASS commands. If C is not given the -C uses C 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. - -=item top ( MSGNUM [, NUMLINES ] ) - -Get the header and the first C of the body for the message -C. 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 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's of all undeleted messages and the values will -be their size in octets. - -=item get ( MSGNUM ) - -Get the message C from the remote mailbox. Returns a reference to an -array which contains the lines of text read from the server. - -=item last () - -Returns the highest C of all the messages accessed. - -=item popstat () - -Returns an array of two elements. These are the number of undeleted -elements and the size of the mbox in octets. - -=item delete ( MSGNUM ) - -Mark message C 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 reseting 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 object goes out of scope before C method is called -then the C method will called before the connection is closed. This -means that any messages marked to be deleted will not be. - -=head1 SEE ALSO - -L -L - -=head1 AUTHOR - -Graham Barr - -=head1 REVISION - -$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 - - Revision 1.8 => VERSION 1.08 - Revision 1.2.3 => VERSION 1.0203 - -=head1 COPYRIGHT - -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. - -=cut - use strict; use IO::Socket; use vars qw(@ISA $VERSION $debug); use Net::Cmd; use Carp; +use Net::Config; -$VERSION = do{my @r=(q$Revision: 2.1 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r}; +$VERSION = "2.23"; # $Id: //depot/libnet/Net/POP3.pm#22 $ @ISA = qw(Net::Cmd IO::Socket::INET); @@ -172,15 +21,27 @@ sub new { my $self = shift; my $type = ref($self) || $self; - my $host = shift; + my $host = shift if @_ % 2; my %arg = @_; - my $obj = $type->SUPER::new(PeerAddr => $host, - PeerPort => $arg{Port} || 'pop3(110)', - Proto => 'tcp', - Timeout => defined $arg{Timeout} + 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 - ) or return undef; + ) and last; + } + + return undef + unless defined $obj; ${*$obj}{'net_pop3_host'} = $host; @@ -193,6 +54,8 @@ sub new return undef; } + ${*$obj}{'net_pop3_banner'} = $obj->message; + $obj; } @@ -208,28 +71,49 @@ sub login @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )'; my($me,$user,$pass) = @_; - if(@_ < 2) - { - require Net::Netrc; + if (@_ <= 2) { + ($user, $pass) = $me->_lookup_credentials($user); + } - $user ||= (getpwuid($>))[0]; + $me->user($user) and + $me->pass($pass); +} - my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user); +sub apop +{ + @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )'; + my($me,$user,$pass) = @_; + my $banner; + 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; + } - $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'}); + return undef + unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0] ); - $pass = $m ? $m->password || "" - : ""; - } + if (@_ <= 2) { + ($user, $pass) = $me->_lookup_credentials($user); + } - $me->user($user) and - $me->pass($pass); + $md->add($banner,$pass); + + return undef + unless($me->_APOP($user,$md->hexdigest)); + + $me->_get_mailbox_count(); } sub user { @_ == 2 or croak 'usage: $pop3->user( USER )'; - $_[0]->_USER($_[1]); + $_[0]->_USER($_[1]) ? 1 : undef; } sub pass @@ -241,9 +125,7 @@ sub pass return undef unless($me->_PASS($pass)); - $me->message =~ /(\d+)\s+message/io; - - ${*$me}{'net_pop3_count'} = $1 || 0; + $me->_get_mailbox_count(); } sub reset @@ -254,7 +136,7 @@ sub reset return 0 unless($me->_RSET); - + if(defined ${*$me}{'net_pop3_mail'}) { local $_; @@ -310,61 +192,137 @@ sub list $me->message =~ /\d+\D+(\d+)/; return $1 || undef; } - - my $info = $me->read_until_dot; - my %hash = (); - map { /(\d+)\D+(\d+)/; $hash{$1} = $2; } @$info; + + my $info = $me->read_until_dot + or return undef; + + my %hash = map { (/(\d+)\D+(\d+)/) } @$info; return \%hash; } sub get { - @_ == 2 or croak 'usage: $pop3->get( MSGNUM )'; + @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])'; my $me = shift; return undef - unless $me->_RETR(@_); + unless $me->_RETR(shift); - $me->read_until_dot; + $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]); } -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 uidl +{ + @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )'; + my $me = shift; + my $uidl; + + $me->_UIDL(@_) or + return undef; + if(@_) + { + $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0]; + } + 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 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 _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 _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 _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 } -sub close +sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK } +sub _LAST { shift->command('LAST')->response() == CMD_OK } + +sub quit { my $me = shift; - return 1 - unless (ref($me) && defined fileno($me)); - - $me->_QUIT && $me->SUPER::close; + $me->_QUIT; + $me->close; } -sub quit { shift->close } - sub DESTROY { my $me = shift; - if(fileno($me)) + if(defined fileno($me)) { $me->reset; $me->quit; @@ -390,7 +348,7 @@ sub response } else { - $str =~ s/^\+ERR\s+//io; + $str =~ s/^-ERR\s+//io; } ${*$cmd}{'net_cmd_resp'} = [ $str ]; @@ -400,3 +358,188 @@ sub response } 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); + +=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 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 ] ) + +This is the constructor for a new Net::POP3 object. C is the +name of the remote host to which a POP3 connection is required. + +If C is not given, then the C specified in C +will be used. + +C are passed in a hash like fashion, using key and value pairs. +Possible options are: + +B - If given then the socket for the C object +will be bound to the local port given using C when the socket is +created. + +B - Maximum time, in seconds, to wait for a response from the +POP3 server (default: 120) + +B - Enable debugging information + +=back + +=head1 METHODS + +Unless otherwise stated all methods return either a I or I +value, with I meaning that the operation was a success. When a method +states that it returns a value, failure will be returned as I or an +empty list. + +=over 4 + +=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 is not given the +C uses C 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 will be returned. + +=item apop ( [ USER [, PASS ]] ) + +Authenticate with the server identifying as C with password C. +Similar to L, 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. + +=item top ( MSGNUM [, NUMLINES ] ) + +Get the header and the first C of the body for the message +C. 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 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's of all undeleted messages and the values will +be their size in octets. + +=item get ( MSGNUM [, FH ] ) + +Get the message C from the remote mailbox. If C is not given +then get returns a reference to an array which contains the lines of +text read from the server. If C is given then the lines returned +from the server are printed to the filehandle C. + +=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 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. + +=item uidl ( [ MSGNUM ] ) + +Returns a unique identifier for C if given. If C is not +given C 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 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 reseting 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 object goes out of scope before C method is called +then the C method will called before the connection is closed. This +means that any messages marked to be deleted will not be. + +=head1 SEE ALSO + +L, +L + +=head1 AUTHOR + +Graham Barr + +=head1 COPYRIGHT + +Copyright (c) 1995-1997 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
+ +I<$Id: //depot/libnet/Net/POP3.pm#22 $> + +=cut