3 # Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
4 # This program is free software; you can redistribute it and/or
5 # modify it under the same terms as Perl itself.
11 use vars qw(@ISA $VERSION $debug);
18 @ISA = qw(Net::Cmd IO::Socket::INET);
23 my $type = ref($self) || $self;
30 $host=delete $arg{Host};
32 my $hosts = defined $host ? [ $host ] : $NetConfig{pop3_hosts};
34 my @localport = exists $arg{ResvPort} ? ( LocalPort => $arg{ResvPort} ): ();
37 foreach $h (@{$hosts})
39 $obj = $type->SUPER::new(PeerAddr => ($host = $h),
40 PeerPort => $arg{Port} || 'pop3(110)',
43 Timeout => defined $arg{Timeout}
52 ${*$obj}{'net_pop3_host'} = $host;
55 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
57 unless ($obj->response() == CMD_OK)
63 ${*$obj}{'net_pop3_banner'} = $obj->message;
70 ${*$me}{'net_pop3_host'};
74 ## We don't want people sending me their passwords when they report problems
78 sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; }
82 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
83 my($me,$user,$pass) = @_;
86 ($user, $pass) = $me->_lookup_credentials($user);
95 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
96 my($me,$user,$pass) = @_;
100 if (eval { local $SIG{__DIE__}; require Digest::MD5 }) {
101 $md = Digest::MD5->new();
102 } elsif (eval { local $SIG{__DIE__}; require MD5 }) {
105 carp "You need to install Digest::MD5 or MD5 to use the APOP command";
110 unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0] );
113 ($user, $pass) = $me->_lookup_credentials($user);
116 $md->add($banner,$pass);
119 unless($me->_APOP($user,$md->hexdigest));
121 $me->_get_mailbox_count();
126 @_ == 2 or croak 'usage: $pop3->user( USER )';
127 $_[0]->_USER($_[1]) ? 1 : undef;
132 @_ == 2 or croak 'usage: $pop3->pass( PASS )';
137 unless($me->_PASS($pass));
139 $me->_get_mailbox_count();
144 @_ == 1 or croak 'usage: $obj->reset()';
151 if(defined ${*$me}{'net_pop3_mail'})
154 foreach (@{${*$me}{'net_pop3_mail'}})
156 delete $_->{'net_pop3_deleted'};
163 @_ == 1 or croak 'usage: $obj->last()';
166 unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;
173 @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
177 unless $me->_TOP($_[0], $_[1] || 0);
184 @_ == 1 or croak 'usage: $pop3->popstat()';
188 unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;
195 @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
199 unless $me->_LIST(@_);
203 $me->message =~ /\d+\D+(\d+)/;
207 my $info = $me->read_until_dot
210 my %hash = map { (/(\d+)\D+(\d+)/) } @$info;
217 @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])';
221 unless $me->_RETR(shift);
223 $me->read_until_dot(@_);
228 @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
231 return unless $me->_RETR(shift);
239 @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
241 return 0 unless $me->_DELE(@_);
242 ${*$me}{'net_pop3_deleted'} = 1;
247 @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )';
255 $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0];
259 my $ref = $me->read_until_dot
263 foreach $ln (@$ref) {
264 my($msg,$uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/;
265 $uidl->{$msg} = $uid;
273 @_ == 2 or croak 'usage: $pop3->ping( USER )';
276 return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/;
281 sub _lookup_credentials
283 my ($me, $user) = @_;
287 $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } ||
288 $ENV{NAME} || $ENV{USER} || $ENV{LOGNAME};
290 my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
291 $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
293 my $pass = $m ? $m->password || ""
299 sub _get_mailbox_count
302 my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
303 ? $1 : ($me->popstat)[0];
309 sub _STAT { shift->command('STAT')->response() == CMD_OK }
310 sub _LIST { shift->command('LIST',@_)->response() == CMD_OK }
311 sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK }
312 sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK }
313 sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
314 sub _RSET { shift->command('RSET')->response() == CMD_OK }
315 sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
316 sub _TOP { shift->command('TOP', @_)->response() == CMD_OK }
317 sub _UIDL { shift->command('UIDL',@_)->response() == CMD_OK }
318 sub _USER { shift->command('USER',$_[0])->response() == CMD_OK }
319 sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK }
320 sub _APOP { shift->command('APOP',@_)->response() == CMD_OK }
321 sub _PING { shift->command('PING',$_[0])->response() == CMD_OK }
323 sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
324 sub _LAST { shift->command('LAST')->response() == CMD_OK }
326 sub _CAPA { shift->command('CAPA')->response() == CMD_OK }
340 if(defined fileno($me) and ${*$me}{'net_pop3_deleted'})
348 ## POP3 has weird responses, so we emulate them to look the same :-)
353 my $str = $cmd->getline() or return undef;
356 $cmd->debug_print(0, $str)
359 if ($str =~ s/^\+OK\s*//io) {
362 elsif ($str =~ s/^\+\s*//io) {
366 $str =~ s/^-ERR\s*//io;
369 ${*$cmd}{'net_cmd_resp'} = [$str];
370 ${*$cmd}{'net_cmd_code'} = $code;
378 my ($capa, %capabilities);
380 # Fake a capability here
381 $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/);
383 if ($this->_CAPA()) {
384 $capabilities{CAPA} = 1;
385 $capa = $this->read_until_dot();
386 %capabilities = (%capabilities, map { /^\s*(\S+)\s*(.*)/ } @$capa);
389 # Check AUTH for SASL capabilities
390 if ( $this->command('AUTH')->response() == CMD_OK ) {
391 my $mechanism = $this->read_until_dot();
392 $capabilities{SASL} = join " ", map { m/([A-Z0-9_-]+)/ } @{ $mechanism };
396 return ${*$this}{'net_pop3e_capabilities'} = \%capabilities;
402 ${*$this}{'net_pop3e_capabilities'} || $this->capa;
406 my ($self, $username, $password) = @_;
409 require MIME::Base64;
410 require Authen::SASL;
411 } or $self->set_status(500,["Need MIME::Base64 and Authen::SASL todo auth"]), return 0;
413 my $capa = $self->capa;
414 my $mechanisms = $capa->{SASL} || 'CRAM-MD5';
418 if (ref($username) and UNIVERSAL::isa($username,'Authen::SASL')) {
420 my $user_mech = $sasl->mechanism || '';
421 my @user_mech = split(/\s+/, $user_mech);
422 my %user_mech; @user_mech{@user_mech} = ();
424 my @server_mech = split(/\s+/,$mechanisms);
425 my @mech = @user_mech
426 ? grep { exists $user_mech{$_} } @server_mech
429 $self->set_status(500,
430 [ 'Client SASL mechanisms (',
431 join(', ', @user_mech),
432 ') do not match the SASL mechnism the server announces (',
433 join(', ', @server_mech), ')',
438 $sasl->mechanism(join(" ",@mech));
441 die "auth(username, password)" if not length $username;
442 $sasl = Authen::SASL->new(mechanism=> $mechanisms,
443 callback => { user => $username,
445 authname => $username,
449 # We should probably allow the user to pass the host, but I don't
450 # currently know and SASL mechanisms that are used by smtp that need it
451 my ( $hostname ) = split /:/ , ${*$self}{'net_pop3_host'};
452 my $client = eval { $sasl->client_new('pop',$hostname,0) };
455 my $mech = $sasl->mechanism;
456 $self->set_status(500, [
457 " Authen::SASL failure: $@",
458 '(please check if your local Authen::SASL installation',
459 "supports mechanism '$mech'"
464 my ($token) = $client->client_start
466 my $mech = $client->mechanism;
467 $self->set_status(500, [
468 ' Authen::SASL failure: $client->client_start ',
469 "mechanism '$mech' hostname #$hostname#",
475 # We dont support sasl mechanisms that encrypt the socket traffic.
476 # todo that we would really need to change the ISA hierarchy
477 # so we dont inherit from IO::Socket, but instead hold it in an attribute
479 my @cmd = ("AUTH", $client->mechanism);
482 push @cmd, MIME::Base64::encode_base64($token,'')
483 if defined $token and length $token;
485 while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
487 my ( $token ) = $client->client_step(
488 MIME::Base64::decode_base64(
492 $self->set_status(500, [
493 ' Authen::SASL failure: $client->client_step ',
494 "mechanism '", $client->mechanism ," hostname #$hostname#, ",
500 @cmd = (MIME::Base64::encode_base64(
501 defined $token ? $token : '',
513 return ${*$this}{'net_pop3_banner'};
522 Net::POP3 - Post Office Protocol 3 Client class (RFC1939)
529 $pop = Net::POP3->new('pop3host');
530 $pop = Net::POP3->new('pop3host', Timeout => 60);
532 if ($pop->login($username, $password) > 0) {
533 my $msgnums = $pop->list; # hashref of msgnum => size
534 foreach my $msgnum (keys %$msgnums) {
535 my $msg = $pop->get($msgnum);
537 $pop->delete($msgnum);
545 This module implements a client interface to the POP3 protocol, enabling
546 a perl5 application to talk to POP3 servers. This documentation assumes
547 that you are familiar with the POP3 protocol described in RFC1939.
549 A new Net::POP3 object must be created with the I<new> method. Once
550 this has been done, all POP3 commands are accessed via method calls
557 =item new ( [ HOST ] [, OPTIONS ] 0
559 This is the constructor for a new Net::POP3 object. C<HOST> is the
560 name of the remote host to which an POP3 connection is required.
562 C<HOST> is optional. If C<HOST> is not given then it may instead be
563 passed as the C<Host> option described below. If neither is given then
564 the C<POP3_Hosts> specified in C<Net::Config> will be used.
566 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
567 Possible options are:
569 B<Host> - POP3 host to connect to. It may be a single scalar, as defined for
570 the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
571 an array with hosts to try in turn. The L</host> method will return the value
572 which was used to connect to the host.
574 B<ResvPort> - If given then the socket for the C<Net::POP3> object
575 will be bound to the local port given using C<bind> when the socket is
578 B<Timeout> - Maximum time, in seconds, to wait for a response from the
579 POP3 server (default: 120)
581 B<Debug> - Enable debugging information
587 Unless otherwise stated all methods return either a I<true> or I<false>
588 value, with I<true> meaning that the operation was a success. When a method
589 states that it returns a value, failure will be returned as I<undef> or an
594 =item auth ( USERNAME, PASSWORD )
596 Attempt SASL authentication.
600 Send the USER command.
604 Send the PASS command. Returns the number of messages in the mailbox.
606 =item login ( [ USER [, PASS ]] )
608 Send both the USER and PASS commands. If C<PASS> is not given the
609 C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host
610 and username. If the username is not specified then the current user name
613 Returns the number of messages in the mailbox. However if there are no
614 messages on the server the string C<"0E0"> will be returned. This is
615 will give a true value in a boolean context, but zero in a numeric context.
617 If there was an error authenticating the user then I<undef> will be returned.
619 =item apop ( [ USER [, PASS ]] )
621 Authenticate with the server identifying as C<USER> with password C<PASS>.
622 Similar to L</login>, but the password is not sent in clear text.
624 To use this method you must have the Digest::MD5 or the MD5 module installed,
625 otherwise this method will return I<undef>.
629 Return the sever's connection banner
633 Return a reference to a hash of the capabilities of the server. APOP
634 is added as a pseudo capability. Note that I've been unable to
635 find a list of the standard capability values, and some appear to
636 be multi-word and some are not. We make an attempt at intelligently
637 parsing them, but it may not be correct.
639 =item capabilities ()
641 Just like capa, but only uses a cache from the last time we asked
642 the server, so as to avoid asking more than once.
644 =item top ( MSGNUM [, NUMLINES ] )
646 Get the header and the first C<NUMLINES> of the body for the message
647 C<MSGNUM>. Returns a reference to an array which contains the lines of text
648 read from the server.
650 =item list ( [ MSGNUM ] )
652 If called with an argument the C<list> returns the size of the message
655 If called without arguments a reference to a hash is returned. The
656 keys will be the C<MSGNUM>'s of all undeleted messages and the values will
657 be their size in octets.
659 =item get ( MSGNUM [, FH ] )
661 Get the message C<MSGNUM> from the remote mailbox. If C<FH> is not given
662 then get returns a reference to an array which contains the lines of
663 text read from the server. If C<FH> is given then the lines returned
664 from the server are printed to the filehandle C<FH>.
666 =item getfh ( MSGNUM )
668 As per get(), but returns a tied filehandle. Reading from this
669 filehandle returns the requested message. The filehandle will return
670 EOF at the end of the message and should not be reused.
674 Returns the highest C<MSGNUM> of all the messages accessed.
678 Returns a list of two elements. These are the number of undeleted
679 elements and the size of the mbox in octets.
683 Returns a list of two elements. These are the number of new messages
684 and the total number of messages for C<USER>.
686 =item uidl ( [ MSGNUM ] )
688 Returns a unique identifier for C<MSGNUM> if given. If C<MSGNUM> is not
689 given C<uidl> returns a reference to a hash where the keys are the
690 message numbers and the values are the unique identifiers.
692 =item delete ( MSGNUM )
694 Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages
695 that are marked to be deleted will be removed from the remote mailbox
696 when the server connection closed.
700 Reset the status of the remote POP3 server. This includes resetting the
701 status of all messages to not be deleted.
705 Quit and close the connection to the remote POP3 server. Any messages marked
706 as deleted will be deleted from the remote mailbox.
712 If a C<Net::POP3> object goes out of scope before C<quit> method is called
713 then the C<reset> method will called before the connection is closed. This
714 means that any messages marked to be deleted will not be.
723 Graham Barr <gbarr@pobox.com>
727 Copyright (c) 1995-2003 Graham Barr. All rights reserved.
728 This program is free software; you can redistribute it and/or modify
729 it under the same terms as Perl itself.