3 # Versions up to 2.29 Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>.
5 # Changes in Version 2.29_01 onwards Copyright (C) 2013-2015 Steve Hay. All
7 # This module is free software; you can redistribute it and/or modify it under
8 # the same terms as Perl itself, i.e. under the terms of either the GNU General
9 # Public License or the Artistic License, as specified in the F<LICENCE> file.
23 our $VERSION = "3.07";
25 # Code for detecting if we can use SSL
26 my $ssl_class = eval {
27 require IO::Socket::SSL;
28 # first version with default CA on most platforms
29 no warnings 'numeric';
30 IO::Socket::SSL->VERSION(2.007);
31 } && 'IO::Socket::SSL';
33 my $nossl_warn = !$ssl_class &&
34 'To use SSL please install IO::Socket::SSL with version>=2.007';
36 # Code for detecting if we can use IPv6
37 my $family_key = 'Domain';
38 my $inet6_class = eval {
39 require IO::Socket::IP;
40 no warnings 'numeric';
41 IO::Socket::IP->VERSION(0.20) || die;
42 $family_key = 'Family';
43 } && 'IO::Socket::IP' || eval {
44 require IO::Socket::INET6;
45 no warnings 'numeric';
46 IO::Socket::INET6->VERSION(2.62);
47 } && 'IO::Socket::INET6';
50 sub can_ssl { $ssl_class };
51 sub can_inet6 { $inet6_class };
53 our @ISA = ('Net::Cmd', $inet6_class || 'IO::Socket::INET');
57 my $type = ref($self) || $self;
65 $host = delete $arg{Host};
67 my $hosts = defined $host ? [$host] : $NetConfig{pop3_hosts};
72 die $nossl_warn if !$ssl_class;
76 $arg{Timeout} = 120 if ! defined $arg{Timeout};
78 foreach my $h (@{$hosts}) {
79 $obj = $type->SUPER::new(
80 PeerAddr => ($host = $h),
81 PeerPort => $arg{Port} || 'pop3(110)',
83 $family_key => $arg{Domain} || $arg{Family},
84 LocalAddr => $arg{LocalAddr},
85 LocalPort => exists($arg{ResvPort}) ? $arg{ResvPort} : $arg{LocalPort},
86 Timeout => $arg{Timeout},
94 ${*$obj}{'net_pop3_arg'} = \%arg;
95 ${*$obj}{'net_pop3_host'} = $host;
97 Net::POP3::_SSL->start_SSL($obj,%arg) or return;
101 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
103 unless ($obj->response() == CMD_OK) {
108 ${*$obj}{'net_pop3_banner'} = $obj->message;
116 ${*$me}{'net_pop3_host'};
120 ## We don't want people sending me their passwords when they report problems
125 sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; }
129 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
130 my ($me, $user, $pass) = @_;
133 ($user, $pass) = $me->_lookup_credentials($user);
137 and $me->pass($pass);
142 $ssl_class or die $nossl_warn;
143 $self->_STLS or return;
144 Net::POP3::_SSL->start_SSL($self,
145 %{ ${*$self}{'net_pop3_arg'} }, # (ssl) args given in new
152 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
153 my ($me, $user, $pass) = @_;
157 if (eval { local $SIG{__DIE__}; require Digest::MD5 }) {
158 $md = Digest::MD5->new();
160 elsif (eval { local $SIG{__DIE__}; require MD5 }) {
164 carp "You need to install Digest::MD5 or MD5 to use the APOP command";
169 unless ($banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0]);
172 ($user, $pass) = $me->_lookup_credentials($user);
175 $md->add($banner, $pass);
178 unless ($me->_APOP($user, $md->hexdigest));
180 $me->_get_mailbox_count();
185 @_ == 2 or croak 'usage: $pop3->user( USER )';
186 $_[0]->_USER($_[1]) ? 1 : undef;
191 @_ == 2 or croak 'usage: $pop3->pass( PASS )';
193 my ($me, $pass) = @_;
196 unless ($me->_PASS($pass));
198 $me->_get_mailbox_count();
203 @_ == 1 or croak 'usage: $obj->reset()';
210 if (defined ${*$me}{'net_pop3_mail'}) {
212 foreach (@{${*$me}{'net_pop3_mail'}}) {
213 delete $_->{'net_pop3_deleted'};
220 @_ == 1 or croak 'usage: $obj->last()';
223 unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;
230 @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
234 unless $me->_TOP($_[0], $_[1] || 0);
241 @_ == 1 or croak 'usage: $pop3->popstat()';
245 unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;
252 @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
256 unless $me->_LIST(@_);
259 $me->message =~ /\d+\D+(\d+)/;
263 my $info = $me->read_until_dot
266 my %hash = map { (/(\d+)\D+(\d+)/) } @$info;
273 @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])';
277 unless $me->_RETR(shift);
279 $me->read_until_dot(@_);
284 @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
287 return unless $me->_RETR(shift);
293 @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
295 return 0 unless $me->_DELE(@_);
296 ${*$me}{'net_pop3_deleted'} = 1;
301 @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )';
308 $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0];
311 my $ref = $me->read_until_dot
314 foreach my $ln (@$ref) {
315 my ($msg, $uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/;
316 $uidl->{$msg} = $uid;
324 @_ == 2 or croak 'usage: $pop3->ping( USER )';
327 return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/;
333 sub _lookup_credentials {
334 my ($me, $user) = @_;
338 $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] }
343 my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'}, $user);
344 $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
354 sub _get_mailbox_count {
356 my $ret = ${*$me}{'net_pop3_count'} =
357 ($me->message =~ /(\d+)\s+message/io) ? $1 : ($me->popstat)[0];
363 sub _STAT { shift->command('STAT' )->response() == CMD_OK }
364 sub _LIST { shift->command('LIST', @_)->response() == CMD_OK }
365 sub _RETR { shift->command('RETR', $_[0])->response() == CMD_OK }
366 sub _DELE { shift->command('DELE', $_[0])->response() == CMD_OK }
367 sub _NOOP { shift->command('NOOP' )->response() == CMD_OK }
368 sub _RSET { shift->command('RSET' )->response() == CMD_OK }
369 sub _QUIT { shift->command('QUIT' )->response() == CMD_OK }
370 sub _TOP { shift->command( 'TOP', @_)->response() == CMD_OK }
371 sub _UIDL { shift->command('UIDL', @_)->response() == CMD_OK }
372 sub _USER { shift->command('USER', $_[0])->response() == CMD_OK }
373 sub _PASS { shift->command('PASS', $_[0])->response() == CMD_OK }
374 sub _APOP { shift->command('APOP', @_)->response() == CMD_OK }
375 sub _PING { shift->command('PING', $_[0])->response() == CMD_OK }
376 sub _RPOP { shift->command('RPOP', $_[0])->response() == CMD_OK }
377 sub _LAST { shift->command('LAST' )->response() == CMD_OK }
378 sub _CAPA { shift->command('CAPA' )->response() == CMD_OK }
379 sub _STLS { shift->command("STLS", )->response() == CMD_OK }
393 if (defined fileno($me) and ${*$me}{'net_pop3_deleted'}) {
400 ## POP3 has weird responses, so we emulate them to look the same :-)
406 my $str = $cmd->getline() or return;
409 $cmd->debug_print(0, $str)
412 if ($str =~ s/^\+OK\s*//io) {
415 elsif ($str =~ s/^\+\s*//io) {
419 $str =~ s/^-ERR\s*//io;
422 ${*$cmd}{'net_cmd_resp'} = [$str];
423 ${*$cmd}{'net_cmd_code'} = $code;
431 my ($capa, %capabilities);
433 # Fake a capability here
434 $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/);
436 if ($this->_CAPA()) {
437 $capabilities{CAPA} = 1;
438 $capa = $this->read_until_dot();
439 %capabilities = (%capabilities, map {/^\s*(\S+)\s*(.*)/} @$capa);
443 # Check AUTH for SASL capabilities
444 if ($this->command('AUTH')->response() == CMD_OK) {
445 my $mechanism = $this->read_until_dot();
446 $capabilities{SASL} = join " ", map {m/([A-Z0-9_-]+)/} @{$mechanism};
450 return ${*$this}{'net_pop3e_capabilities'} = \%capabilities;
457 ${*$this}{'net_pop3e_capabilities'} || $this->capa;
462 my ($self, $username, $password) = @_;
465 require MIME::Base64;
466 require Authen::SASL;
467 } or $self->set_status(500, ["Need MIME::Base64 and Authen::SASL todo auth"]), return 0;
469 my $capa = $self->capa;
470 my $mechanisms = $capa->{SASL} || 'CRAM-MD5';
474 if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) {
476 my $user_mech = $sasl->mechanism || '';
477 my @user_mech = split(/\s+/, $user_mech);
479 @user_mech{@user_mech} = ();
481 my @server_mech = split(/\s+/, $mechanisms);
482 my @mech = @user_mech
483 ? grep { exists $user_mech{$_} } @server_mech
488 [ 'Client SASL mechanisms (',
489 join(', ', @user_mech),
490 ') do not match the SASL mechnism the server announces (',
491 join(', ', @server_mech), ')',
497 $sasl->mechanism(join(" ", @mech));
500 die "auth(username, password)" if not length $username;
501 $sasl = Authen::SASL->new(
502 mechanism => $mechanisms,
506 authname => $username,
511 # We should probably allow the user to pass the host, but I don't
512 # currently know and SASL mechanisms that are used by smtp that need it
513 my ($hostname) = split /:/, ${*$self}{'net_pop3_host'};
514 my $client = eval { $sasl->client_new('pop', $hostname, 0) };
517 my $mech = $sasl->mechanism;
520 [ " Authen::SASL failure: $@",
521 '(please check if your local Authen::SASL installation',
522 "supports mechanism '$mech'"
528 my ($token) = $client->client_start
530 my $mech = $client->mechanism;
533 [ ' Authen::SASL failure: $client->client_start ',
534 "mechanism '$mech' hostname #$hostname#",
541 # We don't support sasl mechanisms that encrypt the socket traffic.
542 # todo that we would really need to change the ISA hierarchy
543 # so we don't inherit from IO::Socket, but instead hold it in an attribute
545 my @cmd = ("AUTH", $client->mechanism);
548 push @cmd, MIME::Base64::encode_base64($token, '')
549 if defined $token and length $token;
551 while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
553 my ($token) = $client->client_step(MIME::Base64::decode_base64(($self->message)[0])) or do {
556 [ ' Authen::SASL failure: $client->client_step ',
557 "mechanism '", $client->mechanism, " hostname #$hostname#, ",
564 @cmd = (MIME::Base64::encode_base64(defined $token ? $token : '', ''));
574 return ${*$this}{'net_pop3_banner'};
578 package Net::POP3::_SSL;
579 our @ISA = ( $ssl_class ? ($ssl_class):(), 'Net::POP3' );
580 sub starttls { die "POP3 connection is already in SSL mode" }
582 my ($class,$pop3,%arg) = @_;
583 delete @arg{ grep { !m{^SSL_} } keys %arg };
584 ( $arg{SSL_verifycn_name} ||= $pop3->host )
585 =~s{(?<!:):[\w()]+$}{}; # strip port
586 $arg{SSL_hostname} = $arg{SSL_verifycn_name}
587 if ! defined $arg{SSL_hostname} && $class->can_client_sni;
588 $arg{SSL_verifycn_scheme} ||= 'pop3';
589 my $ok = $class->SUPER::start_SSL($pop3,%arg);
590 $@ = $ssl_class->errstr if !$ok;
603 Net::POP3 - Post Office Protocol 3 Client class (RFC1939)
610 $pop = Net::POP3->new('pop3host');
611 $pop = Net::POP3->new('pop3host', Timeout => 60);
612 $pop = Net::POP3->new('pop3host', SSL => 1, Timeout => 60);
614 if ($pop->login($username, $password) > 0) {
615 my $msgnums = $pop->list; # hashref of msgnum => size
616 foreach my $msgnum (keys %$msgnums) {
617 my $msg = $pop->get($msgnum);
619 $pop->delete($msgnum);
627 This module implements a client interface to the POP3 protocol, enabling
628 a perl5 application to talk to POP3 servers. This documentation assumes
629 that you are familiar with the POP3 protocol described in RFC1939.
630 With L<IO::Socket::SSL> installed it also provides support for implicit and
631 explicit TLS encryption, i.e. POP3S or POP3+STARTTLS.
633 A new Net::POP3 object must be created with the I<new> method. Once
634 this has been done, all POP3 commands are accessed via method calls
637 The Net::POP3 class is a subclass of Net::Cmd and (depending on avaibility) of
638 IO::Socket::IP, IO::Socket::INET6 or IO::Socket::INET.
645 =item new ( [ HOST ] [, OPTIONS ] )
647 This is the constructor for a new Net::POP3 object. C<HOST> is the
648 name of the remote host to which an POP3 connection is required.
650 C<HOST> is optional. If C<HOST> is not given then it may instead be
651 passed as the C<Host> option described below. If neither is given then
652 the C<POP3_Hosts> specified in C<Net::Config> will be used.
654 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
655 Possible options are:
657 B<Host> - POP3 host to connect to. It may be a single scalar, as defined for
658 the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
659 an array with hosts to try in turn. The L</host> method will return the value
660 which was used to connect to the host.
662 B<Port> - port to connect to.
663 Default - 110 for plain POP3 and 995 for POP3s (direct SSL).
665 B<SSL> - If the connection should be done from start with SSL, contrary to later
666 upgrade with C<starttls>.
667 You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will
668 usually use the right arguments already.
670 B<LocalAddr> and B<LocalPort> - These parameters are passed directly
671 to IO::Socket to allow binding the socket to a specific local address and port.
672 For compatibility with older versions B<ResvPort> can be used instead of
675 B<Domain> - This parameter is passed directly to IO::Socket and makes it
676 possible to enforce IPv4 connections even if L<IO::Socket::IP> is used as super
677 class. Alternatively B<Family> can be used.
679 B<Timeout> - Maximum time, in seconds, to wait for a response from the
680 POP3 server (default: 120)
682 B<Debug> - Enable debugging information
688 Unless otherwise stated all methods return either a I<true> or I<false>
689 value, with I<true> meaning that the operation was a success. When a method
690 states that it returns a value, failure will be returned as I<undef> or an
693 C<Net::POP3> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
694 be used to send commands to the remote POP3 server in addition to the methods
701 Returns the value used by the constructor, and passed to IO::Socket::INET,
702 to connect to the host.
704 =item auth ( USERNAME, PASSWORD )
706 Attempt SASL authentication.
710 Send the USER command.
714 Send the PASS command. Returns the number of messages in the mailbox.
716 =item login ( [ USER [, PASS ]] )
718 Send both the USER and PASS commands. If C<PASS> is not given the
719 C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host
720 and username. If the username is not specified then the current user name
723 Returns the number of messages in the mailbox. However if there are no
724 messages on the server the string C<"0E0"> will be returned. This is
725 will give a true value in a boolean context, but zero in a numeric context.
727 If there was an error authenticating the user then I<undef> will be returned.
729 =item starttls ( SSLARGS )
731 Upgrade existing plain connection to SSL.
732 You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will
733 usually use the right arguments already.
735 =item apop ( [ USER [, PASS ]] )
737 Authenticate with the server identifying as C<USER> with password C<PASS>.
738 Similar to L</login>, but the password is not sent in clear text.
740 To use this method you must have the Digest::MD5 or the MD5 module installed,
741 otherwise this method will return I<undef>.
745 Return the sever's connection banner
749 Return a reference to a hash of the capabilities of the server. APOP
750 is added as a pseudo capability. Note that I've been unable to
751 find a list of the standard capability values, and some appear to
752 be multi-word and some are not. We make an attempt at intelligently
753 parsing them, but it may not be correct.
755 =item capabilities ()
757 Just like capa, but only uses a cache from the last time we asked
758 the server, so as to avoid asking more than once.
760 =item top ( MSGNUM [, NUMLINES ] )
762 Get the header and the first C<NUMLINES> of the body for the message
763 C<MSGNUM>. Returns a reference to an array which contains the lines of text
764 read from the server.
766 =item list ( [ MSGNUM ] )
768 If called with an argument the C<list> returns the size of the message
771 If called without arguments a reference to a hash is returned. The
772 keys will be the C<MSGNUM>'s of all undeleted messages and the values will
773 be their size in octets.
775 =item get ( MSGNUM [, FH ] )
777 Get the message C<MSGNUM> from the remote mailbox. If C<FH> is not given
778 then get returns a reference to an array which contains the lines of
779 text read from the server. If C<FH> is given then the lines returned
780 from the server are printed to the filehandle C<FH>.
782 =item getfh ( MSGNUM )
784 As per get(), but returns a tied filehandle. Reading from this
785 filehandle returns the requested message. The filehandle will return
786 EOF at the end of the message and should not be reused.
790 Returns the highest C<MSGNUM> of all the messages accessed.
794 Returns a list of two elements. These are the number of undeleted
795 elements and the size of the mbox in octets.
799 Returns a list of two elements. These are the number of new messages
800 and the total number of messages for C<USER>.
802 =item uidl ( [ MSGNUM ] )
804 Returns a unique identifier for C<MSGNUM> if given. If C<MSGNUM> is not
805 given C<uidl> returns a reference to a hash where the keys are the
806 message numbers and the values are the unique identifiers.
808 =item delete ( MSGNUM )
810 Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages
811 that are marked to be deleted will be removed from the remote mailbox
812 when the server connection closed.
816 Reset the status of the remote POP3 server. This includes resetting the
817 status of all messages to not be deleted.
821 Quit and close the connection to the remote POP3 server. Any messages marked
822 as deleted will be deleted from the remote mailbox.
826 Returns whether we can use IPv6.
830 Returns whether we can use SSL.
836 If a C<Net::POP3> object goes out of scope before C<quit> method is called
837 then the C<reset> method will called before the connection is closed. This
838 means that any messages marked to be deleted will not be.
848 Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
850 Steve Hay E<lt>F<shay@cpan.org>E<gt> is now maintaining libnet as of version
855 Versions up to 2.29 Copyright (c) 1995-2004 Graham Barr. All rights reserved.
856 Changes in Version 2.29_01 onwards Copyright (C) 2013-2015 Steve Hay. All
859 This module is free software; you can redistribute it and/or modify it under the
860 same terms as Perl itself, i.e. under the terms of either the GNU General Public
861 License or the Artistic License, as specified in the F<LICENCE> file.