Mail-POP3Client-2.21/000755 000766 000024 00000000000 14236310001 014121 5ustar00ssdstaff000000 000000 Mail-POP3Client-2.21/FAQ000644 000766 000024 00000007614 14235104075 014476 0ustar00ssdstaff000000 000000 Frequently Asked Questions Regarding Mail::POP3Client ============================================================== 1. Does the module handle attachments? 2. How do I install it if my ISP won't? 3. Can I check to see if I have new mail? 4. How do I tell if the connection worked or not? 5. My ID and password are correct, why can't I connect? 6. Can't use an undefined value as a symbol reference [...] during global destruction. 6. Can't use an undefined value as a symbol reference [...] during global destruction. 7. How do I use an SSL connection? Answers ============================================================== 1. Does the module handle attachments? The module downloads messages in raw format. It does not do anything special with attachments. To do that, use MIME::Parser or something equivalent. MIME::Parser has a method called parse_data that accepts an array of lines. Pass it the results of the Body method as follows: my $parser = new MIME::Parser; $parser->output_dir( $dir ); my @lines = $pop->Body( $n ); $parser->parse_data( @lines ); Or you can write straight to a temp file and have the parser process that. my $io = new IO::File; if ($io->open( "> $dir/raw-message.$n")) { $pop3->HeadAndBodyToFile( $io, $n ); $io->close; print "Parsing $dir/raw-message.$n...\n"; $parser->parse( IO::File->new( "$dir/raw-message.$n") ); } See the perldoc for MIME::Parser for more details. 2. How do I install it if my ISP won't? You have 2 choices. You can go through the installation process using a prefix option to the make command like this: % perl Makefile.PL prefix=/some/other/directory then just make; make install as above. Or you can create a directory called Mail somewhere and just put POP3Client.pm in there. You will then have to put this directory into your include path (@INC) either on the command line or in your code (i.e. use lib '/path/to/directory'; ). You need to include the directory above Mail and case does matter. Choice 1 is better because you can track what modules you have installed but if you don't have command line access you'll have to go with choice 2. 3. Can I check to see if I have new mail? Not directly. You'd have to keep track of the messages read from the last connection (using Uidl). It's not something the protocol supports. Some mail servers may add a header when a message is retrieved. Try looking at the Status header. 4. How do I tell if the connection worked or not? Check the Count() method. A value of -1 means that the connection failed. You will have access to the other methods on the object to see the Message, etc. This will be changed sometime in the future so that the constructor (or the Connect() method) will return undef or 0 on failure. 5. My ID and password are correct, why can't I connect? Add AUTH_MODE => 'PASS' to the constructor. Some servers state that they support APOP authentication, but it may not work for all accounts. 6. Can't use an undefined value as a symbol reference [...] during global destruction. First, add 'use strict' and -w and fix all of the warnings in your script. If this error still occurs, please send me the type of server you are using (telnet to port 110 on the server and send me the first line it sends you). Some POP3 servers drop the connection after a failed authentication. The servers I have tested against do not appear to do this. Another possibility that has been suggested is a situation with redundant POP servers using DNS round robin. If the first address IO::Socket connects to is down, the module will fail to connect. 7. How do I use an SSL connection? (Thanks to Jamie LeTual) my $socket = IO::Socket::SSL->new( PeerAddr => 'pop.host.com', PeerPort => 993, Proto => 'tcp') || die "Ack! No socket!"; my $pop = Mail::POP3Client->new(); $pop->User('jamie'); $pop->Pass('secret'); $pop->Socket($socket); $pop->Connect();Mail-POP3Client-2.21/Changes000644 000766 000024 00000015264 14236307675 015453 0ustar00ssdstaff000000 000000 Revision history for Perl extension Mail::POP3Client. This is version 2.21 of Mail::POP3Client. 2.21 2022/05/09 + version bump, update Changes 2.20 2022/05/04 + UTF8 support (from eady@gal...) 2.19 2013/19/03 + RT82713 - version number contains a space. 2.18 2008/02/11 + update message ID regular expression for Dovecot APOP authentication. + Allow calling scripts to set $\ without negative affects. 2.17 2005/08/19 + undef $me->{SOCKET} on close. + Check $@ after eval of require IO::Socket::SSL 2.16 2004/03/13 + Correct documentation errors for Connect(). + Fix problem with servers not returning an empty line after headers when message body is blank. 2.15 2003/10/17 + Create a method to set AuthMode (Jamie Le Tual) + Force Mime::Base64::encode base64 result into a single line (Jamie Le Tual) + Documenation updates 2.14 2003/03/22 + Fixed problem when using SSL connection with SSL socket passed in via Socket(); + Added Mail::IMAPClient compatibility calls + Fixed issue with ListArray when POP3 server uses a tab as separator 2.13 2003/01/09 + Added XTND command - submitted by Chris Moates + Added documentation to POD regarding return value of new. + Allow Socket to set the socket (for use with SSL) -submitted by Jamie LeTual . 2.12 2002/09/21 + changed calls to _sockread to check for undef on return value. + removed unused call to inet_aton (support perl 5.8.0) 2.11 2002/06/17 + CRAM-MD5 Authentication support (Ville Skytta) + CAPA support (Ville Skytta) + fixed perldoc regarding return value of Connect() 2.10 2001/09/08 + Corrected problem where login was not attempted if password was empty string. 2.9 2001/08/18 + Fixed bad value for VERSION. 2.8 2001/08/15 + add patch for setting LOCALADDR for multi-address machines. + add transaction log (reference request/response chain array as @{$pop->{tranlog}}) + remove AutoLoader from @ISA + changed HeadAndBodyToFile to return 1 on success and 0 on failure + patch to handle servers that do not return +OK as banner (RFC 1939 does not appear to allow this) + patch to fix problem of response on QUIT command (in Close) being ignored. + Fixed documentation on Head and HeadAndBody. Preview lines argument was in the wrong one. 2.7 2000/03/25 + clarify documentation regarding APOP. + Add support for BEST mode when authenticating. BEST will attempt APOP and drop back to PASS on failure. This is the default for version 2.7 so if you only want APOP, you must specify that. + Fixed problem with some servers not liking 'LIST ' as a command. + Added BodyToFile and HeadAndBodyToFile, which will write their output to the given file handle. 2.6 2000/02/15 + some servers were not sending any message after the +OK for DELE and RSET. Changed regexps to account for this. 2.5 1999/12/19 + Added ListArray to return an indexed array of results of the List command. Indexes are the server's message numbers, beginning at 1. Additional info supplied by the server beyond message size may be lost. The RFC discourages servers from sending this info. + yet another EOF fix (this one for Head(msgnum,linecount)) where the read would end prematurely if the message had a line with a period at the beginning of a line (would return less than the number of lines requested). 2.4 1999/11/20 + fixed problem created by previous fix. Lines that had only a . on them were treated as the end of message (since the test was after stripping the . added by the POP3 server). Thanks to Christophe Wolfhugel at oleane dot net. 2.3 1999/10/11 + fixed problem where lines beginning with '.' in a mail message were not having the extra '.' removed. The POP3 server adds this '.' to escape the original '.' so that it is not interpreted as the end of message marker. Pointed out by Jim Osborne at Wingra dot com. 2.2 1999/10/10 + fixed problem with MacPerl and lingering CR/LF chars on the socket. 2.1 1999/08/19 + moved all socket IO to 2 methods to allow debug to print all socket IO. (mitra at earth dot path dot net) + fixed some places where you could get an empty string returned as an error when calling from an array context. Now returns nothing (false for both array and scalar context). + defaults to APOP (digest) as authentication mode. Will switch to PASS (cleartext) if server does not claim to support APOP. This will mean less passwords sent in cleartext. + fixed example in the Synopsis section (missing argument to Head). + added a simple documentation line for Uidl 2.00 1999/04/29 - major rebuild, including: + changed to hash-style constructor. See the inline doco. This will be the only supported constructor in later versions. + changed underlying socket code to use IO::Socket. Timeout settings on the socket are now supported so you can make sure that POP accesses do not hang. + added tests (use POPTESTACCOUNT environment variable to use: '% POPTESTACCOUNT=userid:password:host make test') + module passes strict + you can construct a Mail::POP3Client object which does not auto-connect (by not passing in a USER and PASSWORD) and then connect manually 1.23 1999/04/16 + fixed bug in Head when optional number of lines is not passed, set to zero if undefined or non-numeric (submitted by Bjoern Kriews ) 1.22 1999/04/15 + change Retrieve to return HeadAndBody. It was using too much memory by building both an array and a string to return. 1.21 1999/04/08 + add SYNOPSIS info for perldoc. + add support for previewing messages using second integer argument to Head, as in $pop->Head( 0, 10 ), which would get the headers and the first 10 lines of the body for message 0. Contributed by Dennis Moroney + convert prints to carps. + change local to my. 1.19 198/12/04 + added basic APOP support patches from Gerhard Gonter . Login does not currently auto-detect APOP on the server. 1.18 1998/12/04 + fixed typo in Body ($$line = ...) + remove set of $\ + once again, fix the distribution (this time I built it on a Unix box. Thanks to Terry Sigle.) 1.17 1998/11 + fixed newline/carriage return problem in distribution. 1.16 1998/09 + replaced all occurences of chop with chomp. Should make it more compatible on machines like the Mac. + Removed all uses of $_ =. Uses locally declared variables now. + Now compiles with no warnings. Mail-POP3Client-2.21/MANIFEST000644 000766 000024 00000000232 14233302713 015257 0ustar00ssdstaff000000 000000 Changes FAQ lib/Mail/POP3Client.pm Makefile.PL MANIFEST META.json META.yml Module meta-data (added by MakeMaker) README t/pod.t t/poptest.t t/version.t Mail-POP3Client-2.21/t/000755 000766 000024 00000000000 14236310001 014364 5ustar00ssdstaff000000 000000 Mail-POP3Client-2.21/README000644 000766 000024 00000003470 14233302713 015015 0ustar00ssdstaff000000 000000 WHAT IS IT? This is a POP3 client module for perl5. It provides an object-oriented interface to a POP3 server. It can be used to write perl-based biff clients, mail readers, or whatever. See the inline POD doco for more details. (perldoc Mail::POP3Client) HOW DO I INSTALL/TEST IT? To install Mail::POP3Client: % perl Makefile.PL % make % make test % make install NOTE: if you want to test against a real mailbox, set the environment variable POPTESTACCOUNT to some POP3 account in the following format: user:password:host. % export POPTESTACCOUNT=jsmith:secret:pop3.my.do.main % make test On Win32 ActiveState perl, you can install it using the Perl Package Manager (ppm). HOW DO I USE THIS WHEN MY ISP WON'T INSTALL IT FOR ME? You have 2 choices. You can go through the installation process using a prefix option to the make command like this: % perl Makefile.PL prefix=/some/other/directory then just make; make install as above. Or you can create a directory called Mail somewhere and just put POP3Client.pm in there. You will then have to put this directory into your include path (@INC) either on the command line or in your code (i.e. use lib '/path/to/directory'; ). You need to include the directory above Mail and case does matter. Choice 1 is better because you can track what modules you have installed but if you don't have command line access you'll have to go with choice 2. WHERE IS THE DOCUMENTATION? The documentation is in the code in POD format. To read it, use 'perldoc Mail::POP3Client' or you can extract it to html using pod2html. I'M SURE MY USERNAME AND PASSWORD ARE CORRECT BUT IT WON'T CONNECT. WHAT'S WRONG? Most likely, the server is claiming to support APOP, but for some reason, doesn't. Try adding 'AUTH_MODE=>PASS' to the constructor. Written by Sean Dowd Mail-POP3Client-2.21/META.yml000644 000766 000024 00000001162 14236310001 015372 0ustar00ssdstaff000000 000000 --- abstract: 'Perl 5 module to talk to a POP3 (RFC1939) server' author: - 'Sean Dowd ' build_requires: {} configure_requires: ExtUtils::MakeMaker: '6.30' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.62, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Mail-POP3Client no_index: directory: - t - inc requires: perl: '5.006001' resources: repository: https://github.com/ssdowd/mail-pop3client version: '2.21' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Mail-POP3Client-2.21/lib/000755 000766 000024 00000000000 14236310001 014667 5ustar00ssdstaff000000 000000 Mail-POP3Client-2.21/Makefile.PL000644 000766 000024 00000001474 14233302713 016111 0ustar00ssdstaff000000 000000 use strict; use warnings; use 5.006001; use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Mail::POP3Client', 'ABSTRACT' => 'Perl 5 module to talk to a POP3 (RFC1939) server', 'AUTHOR' => 'Sean Dowd ', 'DISTNAME' => "Mail-POP3Client", 'VERSION_FROM' => 'lib/Mail/POP3Client.pm', 'LICENSE' => 'perl', 'MIN_PERL_VERSION' => '5.6.1', 'BUILD_REQUIRES' => {}, 'CONFIGURE_REQUIRES' => { "ExtUtils::MakeMaker" => "6.30" }, 'LIBS' => [''], # e.g., '-lm' 'dist' => { COMPRESS => "gzip -9f", SUFFIX => "gz", }, "test" => { "TESTS" => "t/*.t" }, META_MERGE => { resources => { repository => 'https://github.com/ssdowd/mail-pop3client', }, }, ); Mail-POP3Client-2.21/META.json000644 000766 000024 00000002000 14236310001 015532 0ustar00ssdstaff000000 000000 { "abstract" : "Perl 5 module to talk to a POP3 (RFC1939) server", "author" : [ "Sean Dowd " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.62, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Mail-POP3Client", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : {} }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.30" } }, "runtime" : { "requires" : { "perl" : "5.006001" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/ssdowd/mail-pop3client" } }, "version" : "2.21", "x_serialization_backend" : "JSON::PP version 4.06" } Mail-POP3Client-2.21/lib/Mail/000755 000766 000024 00000000000 14236310001 015551 5ustar00ssdstaff000000 000000 Mail-POP3Client-2.21/lib/Mail/POP3Client.pm000644 000766 000024 00000125172 14236307570 020020 0ustar00ssdstaff000000 000000 #****************************************************************************** # # Description: POP3Client module - acts as interface to POP3 server # Author: Sean Dowd # # Copyright (c) 1999-2022 Sean Dowd. All rights reserved. # This module is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. # #****************************************************************************** package Mail::POP3Client; use strict; use warnings; use Carp; use IO::Socket qw(SOCK_STREAM); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); require Exporter; @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw(); $VERSION = '2.21'; # Preloaded methods go here. #****************************************************************************** #* constructor #* new Mail::POP3Client( USER => user, #* PASSWORD => pass, #* HOST => host, #* AUTH_MODE => [BEST|APOP|CRAM-MD5|PASS], #* TIMEOUT => 30, #* LOCALADDR => 'xxx.xxx.xxx.xxx[:xx]', #* DEBUG => 1 ); #* OR (deprecated) #* new Mail::POP3Client( user, pass, host [, port, debug, auth_mode, local_addr]) #****************************************************************************** sub new { my $classname = shift; my $self = { DEBUG => 0, SERVER => "pop3", PORT => 110, COUNT => -1, SIZE => -1, ADDR => "", STATE => 'DEAD', MESG => 'OK', BANNER => '', MESG_ID => '', AUTH_MODE => 'BEST', EOL => "\015\012", TIMEOUT => 60, STRIPCR => 0, LOCALADDR => undef, SOCKET => undef, USESSL => 0, }; $self->{tranlog} = (); $^O =~ /MacOS/i && ($self->{STRIPCR} = 1); bless( $self, $classname ); $self->_init( @_ ); if ( defined($self->User()) && defined($self->Pass()) ) { $self->Connect(); } return $self; } #****************************************************************************** #* initialize - check for old-style params #****************************************************************************** sub _init { my $self = shift; # if it looks like a hash if ( @_ && (scalar( @_ ) % 2 == 0) ) { # ... and smells like a hash... my %hashargs = @_; if ( ( defined($hashargs{USER}) && defined($hashargs{PASSWORD}) ) || defined($hashargs{HOST}) ) { # ... then it must be a hash! Push all values into my internal hash. foreach my $key ( keys %hashargs ) { $self->{$key} = $hashargs{$key}; } } else {$self->_initOldStyle( @_ );} } else {$self->_initOldStyle( @_ );} } #****************************************************************************** #* initialize using the old positional parameter style new - deprecated #****************************************************************************** sub _initOldStyle { my $self = shift; $self->User( shift ); $self->Pass( shift ); my $host = shift; $host && $self->Host( $host ); my $port = shift; $port && $self->Port( $port ); my $debug = shift; $debug && $self->Debug( $debug ); my $auth_mode = shift; $auth_mode && ($self->{AUTH_MODE} = $auth_mode); my $localaddr = shift; $localaddr && ($self->{LOCALADDR} = $localaddr); } #****************************************************************************** #* What version are we? #****************************************************************************** sub Version { return $VERSION; } #****************************************************************************** #* Is the socket alive? #****************************************************************************** sub Alive { my $me = shift; $me->State =~ /^AUTHORIZATION$|^TRANSACTION$/i; } # end Alive #****************************************************************************** #* What's the frequency Kenneth? #****************************************************************************** sub State { my $me = shift; my $stat = shift or return $me->{STATE}; $me->{STATE} = $stat; } # end Stat #****************************************************************************** #* Got anything to say? #****************************************************************************** sub Message { my $me = shift; my $msg = shift or return $me->{MESG}; $me->{MESG} = $msg; } # end Message #****************************************************************************** #* set/query debugging #****************************************************************************** sub Debug { my $me = shift; my $debug = shift or return $me->{DEBUG}; $me->{DEBUG} = $debug; } # end Debug #****************************************************************************** #* set/query the port number #****************************************************************************** sub Port { my $me = shift; my $port = shift or return $me->{PORT}; $me->{PORT} = $port; } # end port #****************************************************************************** #* set the host #****************************************************************************** sub Host { my $me = shift; my $host = shift or return $me->{HOST}; # $me->{INTERNET_ADDR} = inet_aton( $host ) or # $me->Message( "Could not inet_aton: $host, $!") and return; $me->{HOST} = $host; } # end host #****************************************************************************** #* set the local address #****************************************************************************** sub LocalAddr { my $me = shift; my $addr = shift or return $me->{LOCALADDR}; $me->{LOCALADDR} = $addr; } #****************************************************************************** #* query the socket to use as a file handle - allows you to set the #* socket too to allow SSL (thanks to Jamie LeTual) #****************************************************************************** sub Socket { my $me = shift; my $socket = shift or return $me->{'SOCKET'}; $me->{'SOCKET'} = $socket; } sub AuthMode { my $me = shift; my $mode = shift; return $me->{'AUTH_MODE'} unless $mode; $me->{'AUTH_MODE'} = $mode; } #****************************************************************************** #* set/query the USER #****************************************************************************** sub User { my $me = shift; my $user = shift or return $me->{USER}; $me->{USER} = $user; } # end User #****************************************************************************** #* set/query the password #****************************************************************************** sub Pass { my $me = shift; my $pass = shift or return $me->{PASSWORD}; $me->{PASSWORD} = $pass; } # end Pass sub Password { Pass(@_); } #****************************************************************************** #* #****************************************************************************** sub Count { my $me = shift; my $c = shift; if (defined $c and length($c) > 0) { $me->{COUNT} = $c; } else { return $me->{COUNT}; } } # end Count #****************************************************************************** #* set/query the size of the mailbox #****************************************************************************** sub Size { my $me = shift; my $c = shift; if (defined $c and length($c) > 0) { $me->{SIZE} = $c; } else { return $me->{SIZE}; } } # end Size #****************************************************************************** #* #****************************************************************************** sub EOL { my $me = shift; return $me->{'EOL'}; } #****************************************************************************** #* #****************************************************************************** sub Close { my $me = shift; # only send the QUIT message is the socket is still connected. Some # POP3 servers close the socket after a failed authentication. It # is unclear whether the RFC allows this or not, so we'll attempt to # check the condition of the socket before sending data here. if ($me->Alive() && $me->Socket() && $me->Socket()->connected() ) { $me->_sockprint( "QUIT", $me->EOL ); # from Patrick Bourdon - need this because some servers do not # delete in all cases. RFC says server can respond (in UPDATE # state only, otherwise always OK). my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for QUIT"); # XXX: Should add the following? #$me->State('DEAD'); undef $me->{SOCKET}; return 0; } $me->Message( $line ); close( $me->Socket() ) or $me->Message("close failed: $!") and do { undef $me->{SOCKET}; return 0; }; $me->State('DEAD'); undef $me->{SOCKET}; $line =~ /^\+OK/i || return 0; } 1; } # end Close sub close { Close(@_); } sub logout { Close(@_); } #****************************************************************************** #* #****************************************************************************** sub DESTROY { my $me = shift; $me->Close; } # end DESTROY #****************************************************************************** #* Connect to the specified POP server #****************************************************************************** sub Connect { my ($me, $host, $port) = @_; $host and $me->Host($host); $port and $me->Port($port); $me->Close(); my $s = $me->{SOCKET}; $s || do { if ( $me->{USESSL} ) { if ( $me->Port() == 110 ) { $me->Port( 995 ); } eval { require IO::Socket::SSL; }; $@ and $me->Message("Could not load IO::Socket::SSL: $@") and return 0; $s = IO::Socket::SSL->new( PeerAddr => $me->Host(), PeerPort => $me->Port(), Proto => "tcp", Type => SOCK_STREAM, LocalAddr => $me->LocalAddr(), Timeout => $me->{TIMEOUT} ) or $me->Message( "could not connect SSL socket [$me->{HOST}, $me->{PORT}]: $!" ) and return 0; $me->{SOCKET} = $s; } else { $s = IO::Socket::INET->new( PeerAddr => $me->Host(), PeerPort => $me->Port(), Proto => "tcp", Type => SOCK_STREAM, LocalAddr => $me->LocalAddr(), Timeout => $me->{TIMEOUT} ) or $me->Message( "could not connect socket [$me->{HOST}, $me->{PORT}]: $!" ) and return 0; $me->{SOCKET} = $s; } }; $s->autoflush( 1 ); defined(my $msg = $me->_sockread()) or $me->Message("Could not read") and return 0; chomp $msg; $me->{BANNER}= $msg; # add check for servers that return -ERR on connect (not in RFC1939) $me->Message($msg); $msg =~ /^\+OK/i || return 0; my $atom = qr([-_\w!#$%&'*+/=?^`{|}~]+); $me->{MESG_ID}= $1 if ($msg =~/(<$atom(?:\.$atom)*\@$atom(?:\.$atom)*>)/o); $me->Message($msg); $me->State('AUTHORIZATION'); defined($me->User()) and defined($me->Pass()) and $me->Login(); } # end Connect sub connect { Connect(@_); } #****************************************************************************** #* login to the POP server. If the AUTH_MODE is set to BEST, and the server #* appears to support APOP, it will try APOP, if that fails, then it will try #* SASL CRAM-MD5 if the server appears to support it, and finally PASS. #* If the AUTH_MODE is set to APOP, and the server appears to support APOP, it #* will use APOP or it will fail to log in. Likewise, for AUTH_MODE CRAM-MD5, #* no PASS-fallback is made. Otherwise password is sent in clear text. #****************************************************************************** sub Login { my $me= shift; return 1 if $me->State eq 'TRANSACTION'; # Already logged in if ($me->{AUTH_MODE} eq 'BEST') { my $retval; if ($me->{MESG_ID}) { $retval = $me->Login_APOP(); return($retval) if ($me->State eq 'TRANSACTION'); } my $has_cram_md5 = 0; foreach my $capa ($me->Capa()) { $capa =~ /^SASL.*?\sCRAM-MD5\b/ and $has_cram_md5 = 1 and last; } if ($has_cram_md5) { $retval = $me->Login_CRAM_MD5(); return($retval) if ($me->State() eq 'TRANSACTION'); } } elsif ($me->{AUTH_MODE} eq 'APOP') { return(0) if (!$me->{MESG_ID}); # fail if the server does not support APOP return($me->Login_APOP()); } elsif ($me->{AUTH_MODE} eq 'CRAM-MD5') { return($me->Login_CRAM_MD5()); } elsif ($me->{AUTH_MODE} ne 'PASS') { $me->Message("Programing error. AUTH_MODE (".$me->{AUTH_MODE}.") not BEST | APOP | CRAM-MD5 | PASS."); return(0); } return($me->Login_Pass()); } sub login { Login(@_); } #****************************************************************************** #* login to the POP server using APOP (md5) authentication. #****************************************************************************** sub Login_APOP { my $me = shift; eval { require Digest::MD5; }; $@ and $me->Message("APOP failed: $@") and return 0; my $hash = Digest::MD5::md5_hex($me->{MESG_ID} . $me->Pass()); $me->_checkstate('AUTHORIZATION', 'APOP') or return 0; $me->_sockprint( "APOP " , $me->User , ' ', $hash, $me->EOL ); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for APOP"); $me->State('AUTHORIZATION'); return 0; } chomp $line; $me->Message($line); # some servers will close here... $me->NOOP() || do { $me->State('DEAD'); undef $me->{SOCKET}; $me->Message("APOP failed: server has closed the socket"); return 0; }; $line =~ /^\+OK/ or $me->Message("APOP failed: $line") and return 0; $me->State('TRANSACTION'); $me->POPStat() or return 0; } #****************************************************************************** #* login to the POP server using CRAM-MD5 (RFC 2195) authentication. #****************************************************************************** sub Login_CRAM_MD5 { my $me = shift; eval { require Digest::HMAC_MD5; require MIME::Base64; }; $@ and $me->Message("AUTH CRAM-MD5 failed: $@") and return 0; $me->_checkstate('AUTHORIZATION', 'AUTH') or return 0; $me->_sockprint('AUTH CRAM-MD5', $me->EOL()); my $line = $me->_sockread(); chomp $line; $me->Message($line); if ($line =~ /^\+ (.+)$/) { my $hmac = Digest::HMAC_MD5::hmac_md5_hex(MIME::Base64::decode($1), $me->Pass()); (my $response = MIME::Base64::encode($me->User() . " $hmac")) =~ s/[\r\n]//g; $me->_sockprint($response, $me->EOL()); $line = $me->_sockread(); chomp $line; $me->Message($line); $line =~ /^\+OK/ or $me->Message("AUTH CRAM-MD5 failed: $line") and return 0; } else { $me->Message("AUTH CRAM-MD5 failed: $line") and return 0; } $me->State('TRANSACTION'); $me->POPStat() or return 0; } #****************************************************************************** #* login to the POP server using simple (cleartext) authentication. #****************************************************************************** sub Login_Pass { my $me = shift; $me->_checkstate('AUTHORIZATION', 'USER') or return 0; $me->_sockprint( "USER " , $me->User() , $me->EOL ); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for USER"); $me->State('AUTHORIZATION'); return 0; } chomp $line; $me->Message($line); $line =~ /^\+/ or $me->Message("USER failed: $line") and $me->State('AUTHORIZATION') and return 0; $me->_sockprint( "PASS " , $me->Pass() , $me->EOL ); $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for PASS"); $me->State('AUTHORIZATION'); return 0; } chomp $line; $me->Message($line); $line =~ /^\+OK/ or $me->Message("PASS failed: $line") and $me->State('AUTHORIZATION') and return 0; $me->State('TRANSACTION'); ($me->POPStat() >= 0) or return 0; } # end Login #****************************************************************************** #* Get the Head of a message number. If you give an optional number #* of lines you will get the first n lines of the body also. This #* allows you to preview a message. #****************************************************************************** sub Head { my $me = shift; my $num = shift; my $lines = shift; $lines ||= 0; $lines =~ /\d+/ || ($lines = 0); my $header = ''; $me->_checkstate('TRANSACTION', 'TOP') or return; $me->_sockprint( "TOP $num $lines", $me->EOL ); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for TOP"); return; } chomp $line; $line =~ /^\+OK/ or $me->Message("Bad return from TOP: $line") and return; $line =~ /^\+OK (\d+) / and my $buflen = $1; while (1) { $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for TOP"); return; } last if $line =~ /^\.\s*$/; $line =~ s/^\.\././; $header .= $line; } return wantarray ? split(/\r?\n/, $header) : $header; } # end Head #****************************************************************************** #* Get the header and body of a message #****************************************************************************** sub HeadAndBody { my $me = shift; my $num = shift; my $mandb = ''; $me->_checkstate('TRANSACTION', 'RETR') or return; $me->_sockprint( "RETR $num", $me->EOL ); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for RETR"); return; } chomp $line; $line =~ /^\+OK/ or $me->Message("Bad return from RETR: $line") and return; $line =~ /^\+OK (\d+) / and my $buflen = $1; while (1) { $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for RETR"); return; } last if $line =~ /^\.\s*$/; # convert any '..' at the start of a line to '.' $line =~ s/^\.\././; $mandb .= $line; } return wantarray ? split(/\r?\n/, $mandb) : $mandb; } # end HeadAndBody sub message_string { HeadAndBody(@_); } #****************************************************************************** #* get the head and body of a message and write it to a file handle. #* Sends the raw data: does no CR/NL stripping or mapping. #****************************************************************************** sub HeadAndBodyToFile { local ($, , $\); my $me = shift; my $fh = shift; my $num = shift; my $body = ''; $me->_checkstate('TRANSACTION', 'RETR') or return; $me->_sockprint( "RETR $num", $me->EOL ); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for RETR"); return 0; } chomp $line; $line =~ /^\+OK/ or $me->Message("Bad return from RETR: $line") and return 0; $line =~ /^\+OK (\d+) / and my $buflen = $1; while (1) { $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for RETR"); return 0; } last if $line =~ /^\.\s*$/; # convert any '..' at the start of a line to '.' $line =~ s/^\.\././; print $fh $line; } return 1; } # end BodyToFile #****************************************************************************** #* get the body of a message #****************************************************************************** sub Body { my $me = shift; my $num = shift; my $body = ''; $me->_checkstate('TRANSACTION', 'RETR') or return; $me->_sockprint( "RETR $num", $me->EOL ); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for RETR"); return; } chomp $line; $line =~ /^\+OK/ or $me->Message("Bad return from RETR: $line") and return; $line =~ /^\+OK (\d+) / and my $buflen = $1; # skip the header do { $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for RETR"); return; } $line =~ s/[\r\n]//g; } until $line =~ /^(\s*|\.)$/; $line =~ /^\.\s*$/ && return; # we found a header only! Lotus Notes seems to do this. while (1) { $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for RETR"); return; } last if $line =~ /^\.\s*$/; # convert any '..' at the start of a line to '.' $line =~ s/^\.\././; $body .= $line; } return wantarray ? split(/\r?\n/, $body) : $body; } # end Body #****************************************************************************** #* get the body of a message and write it to a file handle. Sends the raw data: #* does no CR/NL stripping or mapping. #****************************************************************************** sub BodyToFile { local ($, , $\); my $me = shift; my $fh = shift; my $num = shift; my $body = ''; $me->_checkstate('TRANSACTION', 'RETR') or return; $me->_sockprint( "RETR $num", $me->EOL ); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for RETR"); return; } chomp $line; $line =~ /^\+OK/ or $me->Message("Bad return from RETR: $line") and return; $line =~ /^\+OK (\d+) / and my $buflen = $1; # skip the header do { $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for RETR"); return; } $line =~ s/[\r\n]//g; } until $line =~ /^(\s*|\.)$/; $line =~ /^\.\s*$/ && return; # we found a header only! Lotus Notes seems to do this. while (1) { $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for RETR"); return; } chomp $line; last if $line =~ /^\.\s*$/; # convert any '..' at the start of a line to '.' $line =~ s/^\.\././; print $fh $line, "\n"; } } # end BodyToFile #****************************************************************************** #* handle a STAT command - returns the number of messages in the box #****************************************************************************** sub POPStat { my $me = shift; $me->_checkstate('TRANSACTION', 'STAT') or return -1; $me->_sockprint( "STAT", $me->EOL ); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for STAT"); return -1; } $line =~ /^\+OK/ or $me->Message("STAT failed: $line") and return -1; $line =~ /^\+OK (\d+) (\d+)/ and $me->Count($1), $me->Size($2); return $me->Count(); } #****************************************************************************** #* issue the LIST command #****************************************************************************** sub List { my $me = shift; my $num = shift || ''; my $CMD = shift || 'LIST'; $CMD=~ tr/a-z/A-Z/; $me->Alive() or return; my @retarray = (); my $ret = ''; $me->_checkstate('TRANSACTION', $CMD) or return; $me->_sockprint($CMD, $num ? " $num" : '', $me->EOL()); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for LIST"); return; } $line =~ /^\+OK/ or $me->Message("$line") and return; if ($num) { $line =~ s/^\+OK\s*//; return $line; } while( defined( $line = $me->_sockread() ) ) { $line =~ /^\.\s*$/ and last; $ret .= $line; chomp $line; push(@retarray, $line); } if ($ret) { return wantarray ? @retarray : $ret; } } #****************************************************************************** #* issue the LIST command, but return results in an indexed array. #****************************************************************************** sub ListArray { my $me = shift; my $num = shift || ''; my $CMD = shift || 'LIST'; $CMD=~ tr/a-z/A-Z/; $me->Alive() or return; my @retarray = (); my $ret = ''; $me->_checkstate('TRANSACTION', $CMD) or return; $me->_sockprint($CMD, $num ? " $num" : '', $me->EOL()); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for LIST"); return; } $line =~ /^\+OK/ or $me->Message("$line") and return; if ($num) { $line =~ s/^\+OK\s*//; return $line; } while( defined( $line = $me->_sockread() ) ) { $line =~ /^\.\s*$/ and last; $ret .= $line; chomp $line; my ($num, $uidl) = split('\s+', $line); $retarray[$num] = $uidl; } if ($ret) { return wantarray ? @retarray : $ret; } } #****************************************************************************** #* retrieve the given message number - uses HeadAndBody #****************************************************************************** sub Retrieve { return HeadAndBody( @_ ); } #****************************************************************************** #* retrieve the given message number to the given file handle- uses #* HeadAndBodyToFile #****************************************************************************** sub RetrieveToFile { return HeadAndBodyToFile( @_ ); } #****************************************************************************** #* implement the LAST command - see the rfc (1081) OBSOLETED by RFC #****************************************************************************** sub Last { my $me = shift; $me->_checkstate('TRANSACTION', 'LAST') or return; $me->_sockprint( "LAST", $me->EOL ); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for LAST"); return 0; } $line =~ /\+OK (\d+)\D*$/ and return $1; } #****************************************************************************** #* reset the deletion stat #****************************************************************************** sub Reset { my $me = shift; $me->_checkstate('TRANSACTION', 'RSET') or return; $me->_sockprint( "RSET", $me->EOL ); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for RSET"); return 0; } $line =~ /^\+OK/ and return 1; return 0; } #****************************************************************************** #* delete the given message number #****************************************************************************** sub Delete { my $me = shift; my $num = shift || return; $me->_checkstate('TRANSACTION', 'DELE') or return; $me->_sockprint( "DELE $num", $me->EOL ); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for DELE"); return 0; } $me->Message($line); $line =~ /^\+OK/ && return 1; return 0; } sub delete_message { Delete(@_); } #****************************************************************************** #* UIDL - submitted by Dion Almaer (dion@member.com) #****************************************************************************** sub Uidl { my $me = shift; my $num = shift || ''; $me->Alive() or return; my @retarray = (); my $ret = ''; $me->_checkstate('TRANSACTION', 'UIDL') or return; $me->_sockprint('UIDL', $num ? " $num" : '', $me->EOL()); my $line = $me->_sockread(); unless (defined $line) { $me->Message("Socket read failed for UIDL"); return; } $line =~ /^\+OK/ or $me->Message($line) and return; if ($num) { $line =~ s/^\+OK\s*//; return $line; } while( defined( $line = $me->_sockread() ) ) { $line =~ /^\.\s*$/ and last; $ret .= $line; chomp $line; my ($num, $uidl) = split('\s+', $line); $retarray[$num] = $uidl; } if ($ret) { return wantarray ? @retarray : $ret; } } #****************************************************************************** #* CAPA - query server capabilities, see RFC 2449 #****************************************************************************** sub Capa { my $me = shift; # no state check here, all are allowed $me->Alive() or return; my @retarray = (); my $ret = ''; $me->_sockprint('CAPA', $me->EOL()); my $line = $me->_sockread(); $line =~ /^\+OK/ or $me->Message($line) and return; while(defined($line = $me->_sockread())) { $line =~ /^\.\s*$/ and last; $ret .= $line; chomp $line; push(@retarray, $line); } if ($ret) { return wantarray ? @retarray : $ret; } } #****************************************************************************** #* XTND - submitted by Chris Moates (six@mox.net) #****************************************************************************** sub Xtnd { my $me = shift; my $xtndarg = shift || ''; if ($xtndarg eq '') { $me->Message("XTND requires a string argument"); return; } my $s = $me->Socket(); $me->_checkstate('TRANSACTION', 'XTND') or return; $me->Alive() or return; $me->_sockprint( "XTND $xtndarg", $me->EOL ); my $line = $me->_sockread(); $line =~ /^\+OK/ or $me->Message($line) and return; $line =~ s/^\+OK\s*//; return $line; } #****************************************************************************** #* UTF8 - submitted by eady@galionlibrary.org #****************************************************************************** sub UTF8 { my $me = shift; if (grep { /^UTF8 USER/ } $me->Capa()) { # my $sock = $me->Socket(); # Is this needed? Xtnd() does it... if ($me->Alive()) { $me->_sockprint("UTF8" . $me->EOL()); my $result = $me->_sockread(); $result = s/\r?\n$//; $result =~ /^\+OK/ or $me->Message($result) and return; $result =~ s/^\+OK\s*//; $result ||= "[inferred: UTF-8 mode enabled]"; return $result; } } return; } #****************************************************************************** #* NOOP - used to check socket #****************************************************************************** sub NOOP { my $me = shift; my $s = $me->Socket(); $me->Alive() or return 0; $me->_sockprint( "NOOP", $me->EOL ); my $line = $me->_sockread(); # defined( $line ) or return 0; $line =~ /^\+OK/ or return 0; return 1; } #****************************************************************************** #* Mail::IMAPClient compatibility functions (wsnyder@wsnyder.org) #****************************************************************************** # Empty stubs sub Peek {} sub Uid {} # Pop doesn't have concept of different folders sub folders { return ('INBOX'); } sub Folder { return ('INBOX'); } sub select {} # Message accessing sub unseen { my $me = shift; my $count = $me->Count; return () if !$count; return ( 1..$count); } #***************************************************************************** #* Check the state before issuing a command #***************************************************************************** sub _checkstate { my ($me, $state, $cmd) = @_; my $currstate = $me->State(); if ($currstate ne $state) { $me->Message("POP3 command $cmd may be given only in the '$state' state " . "(current state is '$currstate')."); return 0; } else { return 1; } } #***************************************************************************** #* funnel all read/write through here to allow easier debugging #* (mitra@earth.path.net) #***************************************************************************** sub _sockprint { local ($, , $\); my $me = shift; my $s = $me->Socket(); $me->Debug and Carp::carp "POP3 -> ", @_; my $outline = "@_"; chomp $outline; push(@{$me->{tranlog}}, $outline); print $s @_; } sub _sockread { my $me = shift; my $line = $me->Socket()->getline(); unless (defined $line) { return; } # Macs seem to leave CR's or LF's sitting on the socket. This # removes them. $me->{STRIPCR} && ($line =~ s/^[\r]+//); $me->Debug and Carp::carp "POP3 <- ", $line; $line =~ /^[\\+\\-](OK|ERR)/i && do { my $l = $line; chomp $l; push(@{$me->{tranlog}}, $l); }; return $line; } # end package Mail::POP3Client # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ ################################################################################ # POD Documentation (perldoc Mail::POP3Client or pod2html this_file) ################################################################################ =head1 NAME Mail::POP3Client - Perl 5 module to talk to a POP3 (RFC1939) server =head1 SYNOPSIS use Mail::POP3Client; $pop = new Mail::POP3Client( USER => "me", PASSWORD => "mypassword", HOST => "pop3.do.main" ); for( $i = 1; $i <= $pop->Count(); $i++ ) { foreach( $pop->Head( $i ) ) { /^(From|Subject):\s+/i && print $_, "\n"; } } $pop->Close(); # OR with SSL $pop = new Mail::POP3Client( USER => "me", PASSWORD => "mypassword", HOST => "pop3.do.main", USESSL => true, ); # OR $pop2 = new Mail::POP3Client( HOST => "pop3.otherdo.main" ); $pop2->User( "somebody" ); $pop2->Pass( "doublesecret" ); $pop2->Connect() >= 0 || die $pop2->Message(); $pop2->Close(); # OR to use your own SSL socket... my $socket = IO::Socket::SSL->new( PeerAddr => 'pop.securedo.main', PeerPort => 993, Proto => 'tcp') || die "No socket!"; my $pop = Mail::POP3Client->new(); $pop->User('somebody'); $pop->Pass('doublesecret'); $pop->Socket($socket); $pop->Connect(); =head1 DESCRIPTION This module implements an Object-Oriented interface to a POP3 server. It implements RFC1939 (http://www.faqs.org/rfcs/rfc1939.html) =head1 EXAMPLES Here is a simple example to list out the From: and Subject: headers in your remote mailbox: #!/usr/local/bin/perl use Mail::POP3Client; $pop = new Mail::POP3Client( USER => "me", PASSWORD => "mypassword", HOST => "pop3.do.main" ); for ($i = 1; $i <= $pop->Count(); $i++) { foreach ( $pop->Head( $i ) ) { /^(From|Subject):\s+/i and print $_, "\n"; } print "\n"; } =head1 CONSTRUCTORS Old style (deprecated): new Mail::POP3Client( USER, PASSWORD [, HOST, PORT, DEBUG, AUTH_MODE] ); New style (shown with defaults): new Mail::POP3Client( USER => "", PASSWORD => "", HOST => "pop3", PORT => 110, AUTH_MODE => 'BEST', DEBUG => 0, TIMEOUT => 60, LOCALADDR => 'xxx.xxx.xxx.xxx[:xx]', SOCKET => undef, USESSL => 0, ); =over 4 =item * USER is the userID of the account on the POP server =item * PASSWORD is the cleartext password for the userID =item * HOST is the POP server name or IP address (default = 'pop3') =item * PORT is the POP server port (default = 110) =item * DEBUG - any non-null, non-zero value turns on debugging (default = 0) =item * AUTH_MODE - pass 'APOP' to force APOP (MD5) authorization. (default is 'BEST') =item * TIMEOUT - set a timeout value for socket operations (default = 60) =item * LOCALADDR - allow selecting a local inet address to use =back =head1 METHODS These commands are intended to make writing a POP3 client easier. They do not necessarily map directly to POP3 commands defined in RFC1081 or RFC1939, although all commands should be supported. Some commands return multiple lines as an array in an array context. =over 8 =item I( USER => 'user', PASSWORD => 'password', HOST => 'host', PORT => 110, DEBUG => 0, AUTH_MODE => 'BEST', TIMEOUT => 60,, LOCALADDR => 'xxx.xxx.xxx.xxx[:xx]', SOCKET => undef, USESSL => 0 ) ) Construct a new POP3 connection with this. You should use the hash-style constructor. B You should give it at least 2 arguments: USER and PASSWORD. The default HOST is 'pop3' which may or may not work for you. You can specify a different PORT (be careful here). new will attempt to Connect to and Login to the POP3 server if you supply a USER and PASSWORD. If you do not supply them in the constructor, you will need to call Connect yourself. The valid values for AUTH_MODE are 'BEST', 'PASS', 'APOP' and 'CRAM-MD5'. BEST says to try APOP if the server appears to support it and it can be used to successfully log on, next try similarly with CRAM-MD5, and finally revert to PASS. APOP and CRAM-MD5 imply that an MD5 checksum will be used instead of sending your password in cleartext. However, B There are a few servers that will send a timestamp in the banner greeting, but APOP will not work with them (for instance if the server does not know your password in cleartext). If you think your authentication information is correct, run in DEBUG mode and look for errors regarding authorization. If so, then you may have to use 'PASS' for that server. The same applies to CRAM-MD5, too. If you enable debugging with DEBUG => 1, socket traffic will be echoed to STDERR. Another warning, it's impossible to differentiate between a timeout and a failure. If you pass a true value for USESSL, the port will be changed to 995 if it is not set or is 110. Otherwise, it will use your port. If USESSL is true, IO::Socket::SSL will be loaded. If it is not in your perl, the call to connect will fail. new returns a valid Mail::POP3Client object in all cases. To test for a connection failure, you will need to check the number of messages: -1 indicates a connection error. This will likely change sometime in the future to return undef on an error, setting $! as a side effect. This change will not happen in any 2.x version. =item I( MESSAGE_NUMBER [, PREVIEW_LINES ] ) Get the headers of the specified message, either as an array or as a string, depending on context. You can also specify a number of preview lines which will be returned with the headers. This may not be supported by all POP3 server implementations as it is marked as optional in the RFC. Submitted by Dennis Moroney . =item I( MESSAGE_NUMBER ) Get the body of the specified message, either as an array of lines or as a string, depending on context. =item I( FILE_HANDLE, MESSAGE_NUMBER ) Get the body of the specified message and write it to the given file handle. my $fh = new IO::Handle(); $fh->fdopen( fileno( STDOUT ), "w" ); $pop->BodyToFile( $fh, 1 ); Does no stripping of NL or CR. =item I( MESSAGE_NUMBER ) Get the head and body of the specified message, either as an array of lines or as a string, depending on context. =over 4 =item Example foreach ( $pop->HeadAndBody( 1 ) ) print $_, "\n"; prints out the complete text of message 1. =back =item I( FILE_HANDLE, MESSAGE_NUMBER ) Get the head and body of the specified message and write it to the given file handle. my $fh = new IO::Handle(); $fh->fdopen( fileno( STDOUT ), "w" ); $pop->HeadAndBodyToFile( $fh, 1 ); Does no stripping of NL or CR. =item I( MESSAGE_NUMBER ) Same as HeadAndBody. =item I( FILE_HANDLE, MESSAGE_NUMBER ) Same as HeadAndBodyToFile. =item I( MESSAGE_NUMBER ) Mark the specified message number as DELETED. Becomes effective upon QUIT (invoking the Close method). Can be reset with a Reset message. =item I Start the connection to the POP3 server. You can pass in the host and port. Returns 1 if the connection succeeds, or 0 if it fails (Message will contain a reason). The constructor always returns a blessed reference to a Mail::POP3Client obhect. This may change in a version 3.x release, but never in a 2.x release. =item I Close the connection gracefully. POP3 says this will perform any pending deletes on the server. =item I Return true or false on whether the connection is active. =item I Return the file descriptor for the socket, or set if supplied. =item I Set/Return the size of the remote mailbox. Set by POPStat. =item I Set/Return the number of remote messages. Set during Login. =item I The last status message received from the server or a message describing any problem encountered. =item I The internal state of the connection: DEAD, AUTHORIZATION, TRANSACTION. =item I Return the results of a POP3 STAT command. Sets the size of the mailbox. =item I([message_number]) Returns the size of the given message number when called with an argument using the following format: If message_number is omitted, List behaves the same as ListArray, returning an indexed array of the sizes of each message in the same format. You can parse the size in bytes using split: ($msgnum, $size) = split('\s+', $pop -> List( n )); =item I Return a list of sizes of each message. This returns an indexed array, with each message number as an index (starting from 1) and the value as the next entry on the line. Beware that some servers send additional info for each message for the list command. That info may be lost. =item I( [MESSAGE_NUMBER] ) Return the unique ID for the given message (or all of them). Returns an indexed array with an entry for each valid message number. Indexing begins at 1 to coincide with the server's indexing. =item I Query server capabilities, as described in RFC 2449. Returns the capabilities in an array. Valid in all states. =item I Optional extended commands. Transaction state only. =item I Add support for UTF8. =item I Return the number of the last message, retrieved from the server. =item I Tell the server to unmark any message marked for deletion. =item I( [USER_NAME] ) Set/Return the current user name. =item I( [PASSWORD] ) Set/Return the current user name. =item I Attempt to login to the server connection. =item I( [HOSTNAME] ) Set/Return the current host. =item I( [PORT_NUMBER] ) Set/Return the current port number. =back =head1 IMAP COMPATIBILITY Basic Mail::IMAPClient method calls are also supported: close, connect, login, message_string, Password, and unseen. Also, empty stubs are provided for Folder, folders, Peek, select, and Uid. =head1 REQUIREMENTS This module does not have mandatory requirements for modules that are not part of the standard Perl distribution. However, APOP needs need Digest::MD5 and CRAM-MD5 needs Digest::HMAC_MD5 and MIME::Base64. =head1 AUTHOR Sean Dowd =head1 COPYRIGHT This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 CREDITS Based loosely on News::NNTPClient by Rodger Anderson . =head1 SEE ALSO perl(1) the Digest::MD5 manpage, the Digest::HMAC_MD5 manpage, the MIME::Base64 manpage RFC 1939: Post Office Protocol - Version 3 RFC 2195: IMAP/POP AUTHorize Extension for Simple Challenge/Response RFC 2449: POP3 Extension Mechanism =cut Mail-POP3Client-2.21/t/pod.t000644 000766 000024 00000000202 14233302713 015335 0ustar00ssdstaff000000 000000 use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Mail-POP3Client-2.21/t/version.t000644 000766 000024 00000000276 14233302713 016253 0ustar00ssdstaff000000 000000 use strict; use warnings; use Test::More tests => 1; use Mail::POP3Client; my $Version = Mail::POP3Client::Version(); like ($Version, qr/^\d\.\d\d$/, "Version number '$Version' found"); Mail-POP3Client-2.21/t/poptest.t000644 000766 000024 00000010755 14233302713 016267 0ustar00ssdstaff000000 000000 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl t/poptest.t' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; $tests=26; print "1..$tests\n"; } END {print "not ok 1\n" unless $loaded;} use Mail::POP3Client; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): my $skip = 0; # additional tests require a pop account to test against # set POPTESTACCOUNT in environment. Format is user:password:host # % POPTESTACCOUNT="userid:password:pop3" make test $ENV{POPTESTACCOUNT} || do { print STDERR "\nTests 2-$tests skipped, try setting POPTESTACCOUNT=user:pass:host in environment.\n"; for ( $test = 2; $test <= $tests; $test++ ) {print "ok $test\n";} $skip = 1; }; ($user, $pass, $host) = split( /:/, $ENV{POPTESTACCOUNT} ); $user ||= "*"; $pass ||= "*"; $host ||= "localhost"; ($user && $pass && $host ) || do { if ( ! $skip ) { print STDERR "\nTests 2-$tests skipped, POPTESTACCOUNT=user:pass:host must use valid combination.\n"; for ( $test = 2; $test <= $tests; $test++ ) {print "ok $test\n";} $skip = 1; } }; ($user && $pass && $host ) && do { if ( ! $skip ) { $user =~ /\*/ || $pass =~ /\*/ && print STDERR "Using default user or password, expect failures!"; my $test = 2; # recommended style - autoconnects my $pop = new Mail::POP3Client( PASSWORD => $pass, HOST => $host, USER => $user, ); $pop->Alive() || print "not "; print "ok ", $test++, "\n"; # test some of the methods (we won't test a Delete) $pop->POPStat() >= 0 || print "not "; print "ok ", $test++, "\n"; (my $count = $pop->Count()) >= 0 || print "not "; print "ok ", $test++, "\n"; $pop->Size() >= 0 || print "not "; print "ok ", $test++, "\n"; if ( $count > 0 ) { my @array = $pop->List() || print "not "; } print "ok ", $test++, "\n"; if ( $count > 0 ) { $pop->Head( 1 ) || print "not "; } print "ok ", $test++, "\n"; if ( $count > 0 ) { $pop->HeadAndBody( 1 ) || print "not "; } print "ok ", $test++, "\n"; if ( $count > 0 ) { $pop->Body( 1 ) || print "not "; } print "ok ", $test++, "\n"; $pop->Close() || print "not "; print "ok ", $test++, "\n"; # do each step by hand my $pop2 = new Mail::POP3Client( HOST => $host ) || print "not "; print "ok ", $test++, "\n"; $pop2->User( $user ); $pop2->Pass( $pass ); $pop2->Connect() and $pop2->POPStat() || print "not "; print "ok ", $test++, "\n"; $pop2->Close() || print "not "; print "ok ", $test++, "\n"; # test old positional-style constructors my $pop3 = new Mail::POP3Client( $user, $pass, $host ) || print "not "; print "ok ", $test++, "\n"; $pop3->Close() || print "not "; print "ok ", $test++, "\n"; my $pop4 = new Mail::POP3Client( $user, $pass, $host, 110 ) || print "not "; print "ok ", $test++, "\n"; $pop4->Close() || print "not "; print "ok ", $test++, "\n"; my $pop5 = new Mail::POP3Client( $user, $pass, $host, 110, 0 ) || print "not "; print "ok ", $test++, "\n"; $pop5->Close() || print "not "; print "ok ", $test++, "\n"; my $pop6 = new Mail::POP3Client( $user, $pass, $host, 110, 0, 'APOP' ) || print "not "; print "ok ", $test++, "\n"; $pop6->Close() || print "not "; print "ok ", $test++, "\n"; my $pop7 = new Mail::POP3Client( $user, $pass, $host, 110, 0, 'PASS' ) || print "not "; print "ok ", $test++, "\n"; $pop7->Close() || print "not "; print "ok ", $test++, "\n"; # 2 concurrent connections - server may barf on this my $pop8 = new Mail::POP3Client( PASSWORD => $pass, HOST => $host, USER => $user, ); my $pop9 = new Mail::POP3Client( PASSWORD => $pass, HOST => $host, USER => $user, ); $pop8->Alive() && $pop9->Alive() || print "not "; print "ok ", $test++, "\n"; $pop8->Close() || print "not "; print "ok ", $test++, "\n"; $pop9->Close() || print "not "; print "ok ", $test++, "\n"; } };