Mail-Box-POP3-3.005/0000755000175000001440000000000013462770346014402 5ustar00markovusers00000000000000Mail-Box-POP3-3.005/t/0000755000175000001440000000000013462770346014645 5ustar00markovusers00000000000000Mail-Box-POP3-3.005/t/original/0000755000175000001440000000000013462770346016451 5ustar00markovusers00000000000000Mail-Box-POP3-3.005/t/original/00020000644000175000001440000000143613462273570016756 0ustar00markovusers00000000000000Return-Path: Delivered-To: xx-woppa@xx.nl Received: (qmail 29414 invoked from network); 8 Jul 2002 20:25:55 -0000 Received: from smtpzilla5.xs4all.nl (194.109.127.141) by ds051.xs4all.nl with SMTP; 8 Jul 2002 20:25:55 -0000 Received: from valizo (a80-127-230-87.dial.xs4all.nl [80.127.230.87]) by smtpzilla5.xs4all.nl (8.12.0/8.12.0) with ESMTP id g68KQRdP007359 for ; Mon, 8 Jul 2002 22:26:28 +0200 (CEST) Message-Id: <4.2.0.58.20020708222644.02efb4b0@mickey.dijkmat.nl> X-Sender: lm@mickey.dijkmat.nl X-Mailer: QUALCOMM Windows Eudora Pro Version 4.2.0.58 Date: Mon, 08 Jul 2002 22:26:52 +0200 To: woppa@xx.nl From: Elizabeth Mattijsen Subject: test Mime-Version: 1.0 Content-Type: text/plain; charset="us-ascii"; format=flowed Mail-Box-POP3-3.005/t/original/00010000644000175000001440000000143613462273570016755 0ustar00markovusers00000000000000Return-Path: Delivered-To: xx-woppa@xx.nl Received: (qmail 29439 invoked from network); 8 Jul 2002 20:27:13 -0000 Received: from smtpzilla1.xs4all.nl (194.109.127.137) by ds051.xs4all.nl with SMTP; 8 Jul 2002 20:27:13 -0000 Received: from valizo (a80-127-230-87.dial.xs4all.nl [80.127.230.87]) by smtpzilla1.xs4all.nl (8.12.0/8.12.0) with ESMTP id g68KRdEr060805 for ; Mon, 8 Jul 2002 22:27:43 +0200 (CEST) Message-Id: <4.2.0.58.20020708222802.024df4a0@mickey.dijkmat.nl> X-Sender: lm@mickey.dijkmat.nl X-Mailer: QUALCOMM Windows Eudora Pro Version 4.2.0.58 Date: Mon, 08 Jul 2002 22:28:03 +0200 To: woppa@xx.nl From: Elizabeth Mattijsen Subject: test Mime-Version: 1.0 Content-Type: text/plain; charset="us-ascii"; format=flowed Mail-Box-POP3-3.005/t/original/00030000644000175000001440000000362513462273570016761 0ustar00markovusers00000000000000Return-Path: <15ghnow@yahoo.com> Delivered-To: xx-xxx@xx.nl Received: (qmail 29529 invoked from network); 8 Jul 2002 20:32:12 -0000 Received: from unknown (HELO hlzx.bjedu.gov.cn) (211.153.20.89) by ds051.xs4all.nl with SMTP; 8 Jul 2002 20:32:12 -0000 Received: (qmail 29012 invoked by uid 0); 25 Jun 2002 21:33:30 -0000 Received: from unknown (HELO mx1.mail.yahoo.com) ([209.86.180.232]) (envelope-sender <15ghnow@yahoo.com>) by 10.91.86.1 (qmail-ldap-1.03) with SMTP for ; 25 Jun 2002 21:33:30 -0000 Message-ID: <000071e14f34$00001849$00002497@mx1.mail.yahoo.com> To: From: "Max" <15ghnow@yahoo.com> Subject: As Seen On TV15480 Date: Tue, 25 Jun 2002 17:41:37 -1600 MIME-Version: 1.0 Content-Type: text/plain; charset="Windows-1252" Content-Transfer-Encoding: 7bit Reply-To: 15ghnow@yahoo.com As seen on NBC, CBS, CNN, and even Oprah! The health discovery that actually reverses aging while burning fat, without dieting or exercise! This proven discovery has even been reported on by the New England Journal of Medicine. Forget aging and dieting forever! And it's Guaranteed! Click here: http://www.flyhost.net/betterhealth Would you like to lose weight while you sleep! No dieting! No hunger pains! No Cravings! No strenuous exercise! Change your life forever! 100% GUARANTEED! 1.Body Fat Loss 82% improvement. 2.Wrinkle Reduction 61% improvement. 3.Energy Level 84% improvement. 4.Muscle Strength 88% improvement. 5.Sexual Potency 75% improvement. 6.Emotional Stability 67% improvement. 7.Memory 62% improvement. *********************************************************** You are receiving this email as a double opt-in subscriber to the Standard Affiliates Mailing List. To remove yourself from all related email lists, just click here: mailto:optoutemails@btamail.net.cn?Subject=REMOVE Mail-Box-POP3-3.005/t/original/00040000644000175000001440000000676313462273570016770 0ustar00markovusers00000000000000Return-Path: Delivered-To: xx-xxxxx@xx.nl Received: (qmail 29622 invoked from network); 8 Jul 2002 20:39:46 -0000 Received: from softdnserror (HELO w0.xxxletter.com) (66.181.174.116) by ds051.xs4all.nl with SMTP; 8 Jul 2002 20:39:46 -0000 Received: (from root@localhost) by w0.xxxletter.com (8.11.4/8.11.4) id g68Kbow05230 for xxxxx@xx.nl; Mon, 8 Jul 2002 16:37:50 -0400 (EDT) Date: Mon, 8 Jul 2002 16:37:50 -0400 (EDT) Message-Id: <200207082037.g68Kbow05230@w0.xxxletter.com> Mime-Version: 1.0 To: xxxxx@xx.nl Subject: You Won The Porn Lottery! Content-type: text/html; From: PrizeCommitee@sexy-emails.com THE PORN LOTTERY!!! YOU WON!!!


CLICK HERE NOW!!!




Note: this is not a spam email. This email was sent to you because your email was entered in on a website
requesting to be a registered subscriber. If you would would like to be removed from our list,
CLICK HERE TO CANCEL YOUR ACCOUNT and you will *never* receive another email from us!
Mail-Box-POP3-3.005/t/01basic.t0000644000175000001440000000432513462273570016255 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Mail::Box::POP3::Test; use Mail::Box::Test; use File::Spec (); use File::Basename qw(dirname); use Test::More; $ENV{MARKOV_DEVEL} or plan skip_all => "tests are fragile, skipped"; use_ok('Mail::Transport::POP3'); # Check if all methods are there OK can_ok('Mail::Transport::POP3', qw( deleted deleteFetched DESTROY disconnect fetched folderSize header ids id2n init message messages messageSize send sendList socket url )); my $here = dirname __FILE__; my $original = File::Spec->catdir($here, 'original'); my $popbox = File::Spec->catdir($here, 'popbox'); copy_dir($original, $popbox); my ($server, $port) = start_pop3_server($popbox); my $receiver = start_pop3_client($port); isa_ok($receiver, 'Mail::Transport::POP3'); my $socket = $receiver->socket; ok($socket, "Could not get socket of POP3 server"); print $socket "EXIT\n"; my @message = <$popbox/????>; my $total = 0; $total += -s foreach @message; my $messages = @message; cmp_ok($receiver->messages, '==', $messages, "Wrong number of messages"); cmp_ok($receiver->folderSize, '==', $total, "Wrong number of bytes"); my @id = $receiver->ids; cmp_ok(scalar(@id), '==', scalar(@message), "Number of messages doesn't match"); is(join('',@id), join('',@message), "ID's don't match filenames"); my $error = ''; foreach(@id) { my ($reported, $real) = ($receiver->messageSize($_),-s); $error .= "size $_ is not right: expected $real, got $reported\n" if $reported != $real; } ok(!$error, ($error || 'No errors with sizes')); $error = ''; foreach(@id) { my $message = $receiver->message($_); open(my $handle, '<', $_); $error .= "content of $_ is not right\n" if join('', @$message) ne join('', <$handle>); } ok(!$error, $error || 'No errors with contents'); $receiver->deleted(1,@id); ok($receiver->disconnect, 'Failed to properly disconnect from server'); @message = <$popbox/????>; cmp_ok(scalar(@message) ,'==', 0, 'Did not remove messages at QUIT'); ok(rmdir($popbox), "Failed to remove $popbox directory: $!"); is(join('', <$server>), < "tests are fragile, skipped"; use_ok('Mail::Transport::POP3'); my $here = dirname __FILE__; my $original = File::Spec->catdir($here, 'original'); my $popbox = File::Spec->catdir($here, 'popbox'); copy_dir($original, $popbox); my ($server, $port) = start_pop3_server($popbox, 'autodelete'); my $receiver = start_pop3_client($port, authenticate => 'LOGIN'); isa_ok($receiver, 'Mail::Transport::POP3'); my $socket = $receiver->socket; ok($socket, "Could not get socket of POP3 server"); print $socket "EXIT\n"; # make server exit on QUIT $receiver->message($_) foreach $receiver->ids; ok($receiver->disconnect, 'Failed to properly disconnect from server'); my @message = <$popbox/????>; cmp_ok(scalar(@message) ,'==', 0, 'Did not remove messages at QUIT'); ok(rmdir($popbox), "Failed to remove $popbox directory: $!"); is(join('', <$server>), < as real POP3 server (yet). The server takes on a randomly selected, free port to prevent interference with existing applications. Start the server by running this script from another script while capturing the output to STDOUT, e.g. like: open( my $pop3,"$^X t/server/start t/messages |" ) or die "Could not start POP3 server: $!\n"; my $port = <$pop3>; The returned $pop3 file handle produces informational texts: it will tell you the port which is occupied by the server, and when the server shuts down. It will also report some statistics on the performance of the server. The server will be bound to localhost (127.0.0.1) at the port number of the first line that is printed to STDOUT by this script. The first parameter to the script indicates the directory in which the actual messages (each message as a seperate file) are located. In the example, this is "t/messages". Any other parameters to the script are optional: they consist of keywords to indicate any settings or peculiarities of certain POP3 server implementations. The following keywords are recognised: =over 2 =item minimal If the keyword "minimal" is specified, only the minimal set of POP3 commands will be allowed (i.e. USER, PASS, STAT, LIST, RETR, DELE, RSET, NOOP and QUIT). The optional POP3 commands (APOP, TOP and UIDL) are also supported if this keyword is B specified. =item apoponly If the keyword "apoponly" is specified, then authorization will only be allowed with the APOP command (i.e. authorization with USER will yield a negative response). Please note that you cannot use this together with the "minimal" keyword, as APOP is one of the optional POP3 commands (which is excluded if you use the "minimal" keyword). =item autodelete If the keyword "autodelete" is specified, any messages that are completely retrieved with RETR or TOP (without specification of number of lines in the body to return) will be automatically marked for deletion. This will cause those messages to be deleted if the session is finished with a QUIT command. This coincides with system resource restrictions imposed by some providers. =item noextra If the keyword "noextra" is specified, then all messages will be served with a check for a CRLF pair at the end of the original messasge: if a CRLF is found, then only ".\r\n" will be added to indicate the end of a message that are retrieved with RETR or TOP. =item standardport If the keyword "standardport" is specified, then an attempt will be made to start the POP3 server on port 110, the standard POP3 port. Please note that this will only be successful if the current user has sufficient privileges (usually only the root user will be allowed to listen on ports < 1024). =back User name is always "user" and the correct password is always "password". Any other combination will always fail. APOP authorization can be used if the "minimal" keyword is B specified. The following script will help you in debugging APOP authorization: use Digest::MD5 qw(md5_hex); while (<>) { s#\r?\n?$##s; print md5_hex( $_.'password' )."\n"; } Copy the string that was sent by the initial greeting of the server (including the <> brackets), paste this into the running script, press ENTER. The script will respond with a 32 character hexadecimal string. Copy that and the enter the authorization thus: APOP user 0123456789abcdef0123456789abcdef Note that the above hex string is only an example of course. The following commands do B exist in the POP3 protocol, but are intended to simulate certain events. The BREAK command can be used to simulate the breaking of a connection. After a BREAK is received, the connection is broken by the server (without sending a response to the client). No messages will be deleted even if any messages were marked for deletion. This can also be used to simulate a timeout, of course. The EXIT command can be used for test-suites: when sent from the client, it will cause the server to shut down (as if an EXIT was sent) whenever the client does a QUIT command. When the servers shuts down, its prints its statistics on STDOUT. Statistics returned are: - number of succesful logins - each command + frequency in alphabetical order so a statistics list for one successful session could be: 1 DELE 102 EXIT 1 LIST 1 PASS 1 QUIT 1 RETR 102 STAT 1 UIDL 1 USER 1 =cut # Make sure we do everything by the book # Make sure we can do sockets # Make sure we can do digests use strict; use IO::Socket; use Digest::MD5 qw(md5_hex); # Obtain the directory to work on # Remove trailing slash if any # Die now if there is no directory # Die now if we can't work with it my $directory = shift; $directory =~ s#/$##; die qq(Must specify directory to work with\n) unless $directory; die qq(Trouble using directory "$directory": $!\n) unless -d $directory and -w _; # Initialize the flag settings my $minimal = 0; my $apoponly = 0; my $autodelete = 0; my $noextra = 0; my $exitonquit = 0; my $exitnow = 0; my @port; # While there are keywords specified # Set appropriate flags if so specified while (my $keyword = shift) { $minimal = ($keyword eq 'minimal'); $apoponly = ($keyword eq 'apoponly'); $autodelete = ($keyword eq 'autodelete'); $noextra = ($keyword eq 'noextra'); @port = qw(LocalPort 110) if $keyword eq 'standardport'; } # Make sure no buffering takes place # Create a server that can only take one connection at a time $| = 1; my $server = IO::Socket::INET->new( Type => SOCK_STREAM, Listen => 1, @port, ) or die "Couldn't start a POP3 server:\n $@\n"; # Find out the port we're running on # Let the caller know which port we're running on my $port = $server->sockport; print "$port\n"; # Initialize the connected flag # Initialize the list of available messages # Initialize the hash of message ordinal numbers to delete # Initialize the hash of message ordinal numbers to delete automatically my $connected = 0; my @message; my %delete; my %autodelete; # Initialize user # Initialize digest password field (used by APOP only) # Initialize the line ending on output my $user = ''; my $digest; my $lf = "\x0D\x0A"; # always CRLF # Number of successful logins performed # Hash with frequency of each command my $logins = 0; my %command; # While the server is running and we got a new client # Initialize the APOP initialization string # If this is a minimal POP3 server # Don't make it appear we can do POP3 # Else # Create the APOP authentication string # Let the client know we're there and we can do APOP SERVER: while (my $client = $server->accept()) { my $apop = ''; if ($minimal) { print $client qq(+OK Welcome to the test-suite POP3 server$lf); } else { $apop = "<$$.".time().'@localhost>'; print $client qq(+OK $apop$lf); } # Obtain list of files in message directory # Reset the messages to be (automatically) deleted hashes @message = <$directory/*>; %autodelete = %delete = (); # While the client is asking us stuff to do # Lose the line ending (whatever it is) # Split into a command and parameters # Make sure the command is always uppercase (easier checks later) # Make sure the parameters are defined (if empty) while (<$client>) { s#\r?\n$##s; my ($command,$parameters) = split( /\s+/,$_,2 ); $command = uc($command); $parameters = '' unless defined($parameters); # Count this command for the statistics # Outloop if quitting this client $command{$command}++; last if $command eq 'BREAK'; # If we're connected # Allow for variable references # If there is a subroutine for this command # Execute it with the given parameters and return result # Send result to client if there is something to connect # Stop server is so requested # Outloop if we're no longer connected # Else # Indicate it's not implemented if ($connected) { no strict 'refs'; if (exists( &$command )) { my @return = &{$command}( split( /\s+/,$parameters ) ); print $client @return if @return; last SERVER if $exitnow; last unless $connected; } else { print $client "-ERR unimplemented$lf"; } # Elseif we're quitting without a connection # Show that we agree # And outloop } elsif ($command eq 'QUIT') { print $client "+OK$lf"; last; # Elseif we're trying APOP authentication # If we have a minimal POP3 server # Show that this isn't implemented # And reloop } elsif ($command eq 'APOP') { if ($minimal) { print $client "-ERR unimplemented$lf"; next; } # Obtain the user name and the digest # Log the user in if client gives the right credentials # Send the result to the client ($user,$digest) = split( /\s+/,$parameters ); my @return = login( $user eq 'user' and $digest eq md5_hex( $apop.'password') ); print $client @return; # Elseif we have a user name (and we're not connected yet) # Log the user in if client gives the right credentials now and before # Send the result to the client } elsif ($user) { my @return = login( $command eq 'PASS' and $user eq 'user' and $parameters eq 'password' ); print $client @return; # Elseif the user name is passed (and none given before) # If we only allow APOP # Let the client know it's not ok # Else # Save the user name (for later checking with PASS) # Let the client know it's ok so far } elsif ($command eq 'USER') { if ($apoponly) { print $client "-ERR APOP authorization allowed only$lf"; } else { $user = $parameters; print $client "+OK$lf"; } # Elseif the password is given (but no user name before) # Let the client know it's wrong # Else (attempting to do anything else without authorization) # Let the client know it's wrong } elsif ($command eq 'PASS') { print $client "-ERR user first$lf"; } else { print $client "-ERR authorization first$lf"; } } # Reset user name # Reset connected flag # Shut down the client connection $user = ''; $connected = 0; close( $client ); } # Show number of successful logins # For all the commands that were issued # Return name and frequency of it # And shut down the server print "$logins\n"; foreach (sort keys %command) { print "$_ $command{$_}\n"; } close($server); #------------------------------------------------------------------------ # OUT: 1 whatever needs to be sent to client sub STAT { # Initialize number of messages # Initialize number of bytes they have # Initialize ordinal number my $messages = 0; my $octets = 0; my $ordinal = 0; # For all of the messages # Reloop if message marked as delete, incrementing ordina on the fly # Increment number of messages # Add number of bytes # Return the result foreach (@message) { next if exists( $delete{$ordinal++} ); $messages++; $octets += -s; } return "+OK $messages $octets$lf"; } #STAT #------------------------------------------------------------------------ # OUT: 1 whatever needs to be sent to client sub UIDL { # Return now if running a minimal POP3 server return "-ERR unimplemented$lf" if $minimal; # Initialize message number # If a number was specified # Obtain ordinal number and possible error message # Return error message if there is one # Return the message number and the identifier of the message otherwise my $number = shift; if (defined($number)) { my ($ordinal,$error) = ordinal( $number,1 ); return $error if $error; return "+OK $number $message[$ordinal]$lf"; } # Initialize ordinal number # Initialize text to be returned # For all of the messages # Reloop if message marked as deleted, incrementing ordinal on the fly # Add the ordinal number and the identifier (just use filename for that) # Return the result with an extra . at the end to indicate end of list my $ordinal = 0; my $text = "+OK$lf"; foreach (@message) { next if exists( $delete{$ordinal++} ); $text .= "$ordinal $_$lf"; # external numbers 1-based, internal 0-based } return "$text.$lf"; } #UIDL #------------------------------------------------------------------------ # IN: 1 message to obtain (optionally) # OUT: 1 whatever needs to be sent to client sub LIST { # Initialize message number # If a number was specified # Obtain ordinal number and possible error message # Return error message if there is one # Return the message number and size of message otherwise my $number = shift; if (defined($number)) { my ($ordinal,$error) = ordinal( $number,1 ); return $error if $error; return "+OK $number ".(-s $message[$ordinal]).$lf; } # Initialize ordinal number # Initialize text to be returned # For all of the messages # Reloop if message marked as deleted, incrementing ordinal on the fly # Add the ordinal number and the identifier (just use filename for that) # Return the result with an extra . at the end to indicate end of list my $ordinal = 0; my $text = "+OK$lf"; foreach (@message) { next if exists( $delete{$ordinal++} ); $text .= "$ordinal ".(-s).$lf; # external numbers 1-based, internal 0-based } return "$text.$lf"; } #LIST #------------------------------------------------------------------------ # IN: 1 ordinal number of message to retrieve # OUT: 1 whatever needs to be sent to client sub RETR { # Obtain ordinal number and possible error message # Return now if there was an error message my ($ordinal,$error) = ordinal( shift,1 ); return $error if $error; # Open file for reading or return with empty message # Initialize text to be returned # While there are lines to be returned # Make sure any period at the start of the line becomes a double period # Add the line to the text to be returned open( my $handle,'<',$message[$ordinal] ) or return "+OK$lf.$lf"; my $text = "+OK$lf"; while (<$handle>) { s#^\.#..#; $text .= $_; } # Mark this message to be deleted automatically if flag set # Add the right marker to the text # Return the finished text $autodelete{$ordinal} = undef if $autodelete; addmarker( \$text ); $text; } #RETR #------------------------------------------------------------------------ # IN: 1 ordinal number of message to retrieve # 2 number of lines of the message to retrieve # OUT: 1 whatever needs to be sent to client sub TOP { # Return now if running a minimal POP3 server # Obtain ordinal number and possible error message # Return now if there was an error message return "-ERR unimplemented$lf" if $minimal; my ($ordinal,$error) = ordinal( shift,1 ); return $error if $error; # Open file for reading or return with empty message # Initialize text to be returned open( my $handle,'<',$message[$ordinal] ) or return "+OK$lf.$lf"; my $text = "+OK$lf"; # Obtain the number of lines # If a number of lines was specified # While there are lines to be returned # Make sure any period at the start of the line becomes a double period # Add the line to the text to be returned # Outloop if we're reached the end of the headers my $lines = shift; if (defined($lines)) { while (<$handle>) { s#^\.#..#; $text .= $_; last if m#^\s+$#s; } # While there are lines to be fetched # Outloop if no line left to be fetched # Make sure any period at the start of the line becomes a double period # Add the line to the text to be returned while ($lines--) { last unless defined($_ = <$handle>); s#^\.#..#; $text .= $_; } # Else (no limit) # While there are lines to be returned # Make sure any period at the start of the line becomes a double period # Add the line to the text to be returned # Mark this message to be deleted automatically if flag set } else { while (<$handle>) { s#^\.#..#; $text .= $_; } $autodelete{$ordinal} = undef if $autodelete; } # Add the right marker to the text # Return the result with an extra . at the end to indicate end of list addmarker( \$text ); $text; } #TOP #------------------------------------------------------------------------ # IN: 1 ordinal number of message to delete # OUT: 1 whatever needs to be sent to client sub DELE { # Obtain ordinal number and possible error message # Return now if there was an error message # Mark this message as deletable # Return the result with an extra . at the end to indicate end of list my ($ordinal,$error) = ordinal( shift,1 ); return $error if $error; $delete{$ordinal} = undef; return "+OK$lf"; } #DELE #------------------------------------------------------------------------ # IN: 1 ordinal number of message to undelete # OUT: 1 whatever needs to be sent to client sub RSET { # Obtain ordinal number and possible error message # Return now if there was an error message # Unmark this message as deletable # Return the result with an extra . at the end to indicate end of list my ($ordinal,$error) = ordinal( shift ); return $error if $error; delete( $delete{$ordinal} ); return "+OK$lf"; } #RSET #------------------------------------------------------------------------ # OUT: 1 whatever needs to be sent to client sub NOOP { "+OK$lf" } #NOOP #------------------------------------------------------------------------ sub EXIT { $exitonquit = 1; return } #EXIT #------------------------------------------------------------------------ # OUT: 1 whatever needs to be sent to client sub QUIT { # Remove all of the files that were supposed to be deleted # Remove all of the files that were supposed to be deleted automatically # Set exit now flag if QUIT is to operate as EXIT # Mark the connection as ended # Let the client now it was fun while it lasted unlink( map {$message[$_]} keys %delete ); unlink( map {$message[$_]} keys %autodelete ); $exitnow = $exitonquit; $connected = 0; return "+OK$lf"; } #QUIT #------------------------------------------------------------------------ # IN: 1 flag whether login successful # OUT: 1 what needs to be returned to the client sub login { # If successful # Increment number of successful logins # Set connected flag # Let the client know it's ok if (shift) { $logins++; $connected = 1; return "+OK$lf"; } # Reset the user that was entered before # Let the client know authorization has failed $user = ''; return "-ERR authorization failed$lf"; } #login #------------------------------------------------------------------------ # IN: 1 ordinal number of message # 2 flag: check whether message deleted already # OUT: 1 normalize message number # 2 error message (if any) sub ordinal { # Obtain the message number # Initialize error message # Set error if too low # Set error if zero # Set error if too high my $ordinal = shift; my $error = ''; $error ||= "-ERR syntax error$lf" if $ordinal < 0; $error ||= "-ERR messages are counted from 1$lf" if $ordinal == 0; $error ||= "-ERR not that many messages$lf" if $ordinal > @message; # Normalize for arrays # Set error if checking for deletion and already deleted # Return the result $ordinal--; $error ||= "-ERR already deleted$lf" if shift and exists( $delete{$ordinal} ); return ($ordinal,$error); } #ordinal #------------------------------------------------------------------------ # IN: 1 reference to text (to add the right end-of-data marker to) sub addmarker { # Obtain the reference to the text # If we should check for extra newlines at the end # Add the right stuff depending on the end of the text so far # Else # Add it as most POP3 servers do my $textref = shift; if ($noextra) { $$textref .= ($$textref =~ m#\r\n$#so ? ".$lf" : "$lf.$lf"); } else { $$textref .= "$lf.$lf"; } } Mail-Box-POP3-3.005/t/03minimal.t0000644000175000001440000000223113462273570016616 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Mail::Box::POP3::Test; use Mail::Box::Test; use File::Basename qw(dirname); use File::Spec (); use Test::More; $ENV{MARKOV_DEVEL} or plan skip_all => "tests are fragile, skipped"; use_ok('Mail::Transport::POP3'); my $here = dirname __FILE__; my $original = File::Spec->catdir($here, 'original'); my $popbox = File::Spec->catdir($here, 'popbox'); copy_dir($original, $popbox); my ($server, $port) = start_pop3_server($popbox, 'minimal'); my $receiver = start_pop3_client($port); isa_ok($receiver, 'Mail::Transport::POP3'); my $socket = $receiver->socket; ok($socket, "Could not get socket of POP3 server"); print $socket "EXIT\n"; # make server exit on QUIT $receiver->deleted(1, $receiver->ids); ok($receiver->disconnect, 'Failed to properly disconnect from server'); my @message = <$popbox/????>; cmp_ok(scalar(@message) ,'==', 0, 'Did not remove messages at QUIT'); ok(rmdir($popbox), "Failed to remove $popbox directory: $!"); is(join('', <$server>), < "tests are fragile, skipped"; use_ok('Mail::Transport::POP3'); my $here = dirname __FILE__; my $original = File::Spec->catdir($here, 'original'); my $popbox = File::Spec->catdir($here, 'popbox'); copy_dir($original, $popbox); my ($server, $port) = start_pop3_server($popbox); my $receiver = start_pop3_client($port); isa_ok($receiver, 'Mail::Transport::POP3'); my $socket = $receiver->socket; ok($socket, "Could not get socket of POP3 server"); print $socket "EXIT\n"; # make server exit on QUIT $receiver->message($_) foreach $receiver->ids; $receiver->deleteFetched; print $socket "BREAK\n"; # force breaking of connection ok($receiver->disconnect, 'Failed to properly disconnect from server'); my @message = <$popbox/????>; cmp_ok(scalar(@message) ,'==', 0, 'Did not remove messages at QUIT'); ok(rmdir($popbox), "Failed to remove $popbox directory: $!"); is(join('', <$server>), <{via} = 'pop3'; $args->{port} ||= 110; $self->SUPER::init($args) or return; $self->{MTP_auth} = $args->{authenticate} || 'AUTO'; $self->{MTP_ssl} = $args->{use_ssl}; $self->socket or return; # establish connection $self; } #------------------------------------------ sub useSSL() { shift->{MTP_ssl} } #------------------------------------------ sub ids(;@) { my $self = shift; $self->socket or return; wantarray ? @{$self->{MTP_n2uidl}} : $self->{MTP_n2uidl}; } sub messages() { my $self = shift; $self->log(ERROR =>"Cannot get the messages of pop3 via messages()."), return () if wantarray; $self->{MTP_messages}; } sub folderSize() { shift->{MTP_folder_size} } sub header($;$) { my ($self, $uidl) = (shift, shift); return unless $uidl; my $bodylines = shift || 0;; my $socket = $self->socket or return; my $n = $self->id2n($uidl) or return; $self->sendList($socket, "TOP $n $bodylines$CRLF"); } sub message($;$) { my ($self, $uidl) = @_; return unless $uidl; my $socket = $self->socket or return; my $n = $self->id2n($uidl) or return; my $message = $self->sendList($socket, "RETR $n$CRLF"); return unless $message; # Some POP3 servers add a trailing empty line pop @$message if @$message && $message->[-1] =~ m/^[\012\015]*$/; $self->{MTP_fetched}{$uidl} = undef # mark this ID as fetched unless exists $self->{MTP_nouidl}; $message; } sub messageSize($) { my ($self, $uidl) = @_; return unless $uidl; my $list; unless($list = $self->{MTP_n2length}) { my $socket = $self->socket or return; my $raw = $self->sendList($socket, "LIST$CRLF") or return; my @n2length; foreach (@$raw) { m#^(\d+) (\d+)#; $n2length[$1] = $2; } $self->{MTP_n2length} = $list = \@n2length; } my $n = $self->id2n($uidl) or return; $list->[$n]; } sub deleted($@) { my $dele = shift->{MTP_dele} ||= {}; (shift) ? @$dele{ @_ } = () : delete @$dele{ @_ }; } sub deleteFetched() { my $self = shift; $self->deleted(1, keys %{$self->{MTP_fetched}}); } sub disconnect() { my $self = shift; my $quit; if($self->{MTP_socket}) # can only disconnect once { if(my $socket = $self->socket) { my $dele = $self->{MTP_dele} || {}; while(my $uidl = each %$dele) { my $n = $self->id2n($uidl) or next; $self->send($socket, "DELE $n$CRLF") or last; } $quit = $self->send($socket, "QUIT$CRLF"); close $socket; } } delete @$self{ qw( MTP_socket MTP_dele MTP_uidl2n MTP_n2uidl MTP_n2length MTP_fetched ) }; _OK $quit; } sub fetched(;$) { my $self = shift; return if exists $self->{MTP_nouidl}; $self->{MTP_fetched}; } sub id2n($;$) { shift->{MTP_uidl2n}{shift()} } #------------------------------------------ sub socket() { my $self = shift; # Do we (still) have a working connection which accepts commands? my $socket = $self->_connection; return $socket if defined $socket; if(exists $self->{MTP_nouidl}) { $self->log(ERROR => "Can not re-connect reliably to server which doesn't support UIDL"); return; } # (Re-)establish the connection $socket = $self->login or return; $self->status($socket) or return; $self->{MTP_socket} = $socket; } sub send($$) { my $self = shift; my $socket = shift; my $response; if(eval {print $socket @_}) { $response = <$socket>; $self->log(ERROR => "Cannot read POP3 from socket: $!") unless defined $response; } else { $self->log(ERROR => "Cannot write POP3 to socket: $@"); } $response; } sub sendList($$) { my ($self, $socket) = (shift, shift); my $response = $self->send($socket, @_); $response && _OK $response or return; my @list; while(my $line = <$socket>) { last if $line =~ m#^\.\r?\n#s; $line =~ s#^\.##; push @list, $line; } \@list; } sub DESTROY() { my $self = shift; $self->SUPER::DESTROY; $self->disconnect if $self->{MTP_socket}; # only when open } sub _connection() { my $self = shift; my $socket = $self->{MTP_socket}; defined $socket or return; # Check if we (still) got a connection eval { print $socket "NOOP$CRLF" }; if($@ || ! <$socket> ) { delete $self->{MTP_socket}; return undef; } $socket; } sub login(;$) { my $self = shift; # Check if we can make a connection my ($host, $port, $username, $password) = $self->remoteHost; unless($username && $password) { $self->log(ERROR => "POP3 requires a username and password."); return; } my $net = $self->useSSL ? 'IO::Socket::SSL' : 'IO::Socket::INET'; eval "require $net" or die $@; my $socket = eval { $net->new("$host:$port") }; unless($socket) { $self->log(ERROR => "Cannot connect to $host:$port for POP3: $!"); return; } # Check if it looks like a POP server my $connected; my $authenticate = $self->{MTP_auth}; my $welcome = <$socket>; unless(_OK $welcome) { $self->log(ERROR => "Server at $host:$port does not seem to be talking POP3."); return; } # Check APOP login if automatic or APOP specifically requested if($authenticate eq 'AUTO' || $authenticate eq 'APOP') { if($welcome =~ m#^\+OK .*(<\d+\.\d+\@[^>]+>)#) { my $md5 = md5_hex $1.$password; my $response = $self->send($socket, "APOP $username $md5$CRLF"); $connected = _OK $response; } } # Check USER/PASS login if automatic and failed or LOGIN specifically # requested. unless($connected) { if($authenticate eq 'AUTO' || $authenticate eq 'LOGIN') { my $response = $self->send($socket, "USER $username$CRLF") or return; if(_OK $response) { my $response2 = $self->send($socket, "PASS $password$CRLF") or return; $connected = _OK $response2; } } } # If we're still not connected now, we have an error unless($connected) { $self->log(ERROR => $authenticate eq 'AUTO' ? "Could not authenticate using any login method" : "Could not authenticate using '$authenticate' method"); return; } $socket; } sub status($;$) { my ($self, $socket) = @_; # Check if we can do a STAT my $stat = $self->send($socket, "STAT$CRLF") or return; if($stat !~ m#^\+OK (\d+) (\d+)#) { delete $self->{MTP_messages}; delete $self->{MTP_size}; $self->log(ERROR => "POP3 Could not do a STAT"); return; } $self->{MTP_messages} = my $nr_msgs = $1; $self->{MTP_folder_size} = $2; # Check if we can do a UIDL my $uidl = $self->send($socket, "UIDL$CRLF") or return; $self->{MTP_nouidl} = undef; delete $self->{MTP_uidl2n}; # drop the reverse lookup: UIDL -> number if(_OK $uidl) { my @n2uidl; $n2uidl[$nr_msgs] = undef; # pre-alloc while(my $line = <$socket>) { last if substr($line, 0, 1) eq '.'; $line =~ m#^(\d+) (.+?)\r?\n# or next; $n2uidl[$1] = $2; } shift @n2uidl; # make message 1 into index 0 $self->{MTP_n2uidl} = \@n2uidl; delete $self->{MTP_n2length}; delete $self->{MTP_nouidl}; } else { # We can't do UIDL, we need to fake it my $list = $self->send($socket, "LIST$CRLF") or return; my (@n2length, @n2uidl); if(_OK $list) { $n2length[$nr_msgs] = $n2uidl[$nr_msgs] = undef; # alloc all my ($host, $port) = $self->remoteHost; while(my $line = <$socket>) { last if substr($line, 0, 1) eq '.'; $line =~ m#^(\d+) (\d+)# or next; $n2length[$1] = $2; $n2uidl[$1] = "$host:$port:$1"; # fake UIDL, for id only } shift @n2length; shift @n2uidl; # make 1st message in index 0 } $self->{MTP_n2length} = \@n2length; $self->{MTP_n2uidl} = \@n2uidl; } my $i = 1; my %uidl2n = map +($_ => $i++), @{$self->{MTP_n2uidl}}; $self->{MTP_uidl2n} = \%uidl2n; 1; } #------------------------------------------ sub url(;$) { my $self = shift; my ($host, $port, $user, $pwd) = $self->remoteHost; my $proto = $self->useSSL ? 'pop3s' : 'pop3'; "$proto://$user:$pwd\@$host:$port"; } #------------------------------------------ 1; Mail-Box-POP3-3.005/lib/Mail/Transport/POP3.pod0000644000175000001440000003071213462770345021255 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Transport::POP3 - receive messages via POP3 =head1 INHERITANCE Mail::Transport::POP3 is a Mail::Transport::Receive is a Mail::Transport is a Mail::Reporter =head1 SYNOPSIS my $receiver = Mail::Transport::POP3->new(...); my $message = $receiver->receive($id); =head1 DESCRIPTION Receive messages via the POP3 protocol from one remote server, as specified in rfc1939. This object hides much of the complications in the protocol and recovers broken connections automatically. Although it is part of the MailBox distribution, this object can be used separately. You probably should B module, but L. This module is the interface to POP3, whereas L hides the protocol weirdness and works as any other mail folder. Extends L<"DESCRIPTION" in Mail::Transport::Receive|Mail::Transport::Receive/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Transport::Receive|Mail::Transport::Receive/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Transport::Receive|Mail::Transport::Receive/"Constructors">. =over 4 =item Mail::Transport::POP3-EB(%options) Create a new pop3 server connection. One object can only handle one connection: for a single user to one single server. If the server could not be reached, or when the login fails, this instantiating C will return C. -Option --Defined in --Default authenticate 'AUTO' executable Mail::Transport undef hostname Mail::Transport 'localhost' interval Mail::Transport 30 log Mail::Reporter 'WARNINGS' password Mail::Transport undef port Mail::Transport 110 proxy Mail::Transport undef retry Mail::Transport timeout Mail::Transport 120 trace Mail::Reporter 'WARNINGS' use_ssl username Mail::Transport undef via Mail::Transport 'sendmail' =over 2 =item authenticate => 'LOGIN'|'APOP'|'AUTO' Authenthication method. The standard defines two methods, named LOGIN and APOP. The first sends the username and password in plain text to the server to get permission, the latter encrypts this data using MD5. When AUTO is used, first APOP is tried, and then LOGIN. =item executable => FILENAME =item hostname => HOSTNAME|ARRAY =item interval => SECONDS =item log => LEVEL =item password => STRING =item port => INTEGER =item proxy => PATH =item retry => NUMBER|undef =item timeout => SECONDS =item trace => LEVEL =item use_ssl => BOOLEAN To set the SSL parameters, use IO::Socket::SSL subroutine set_defaults. Connections will get restarted when they are lost: you have to keep the defaults in place during POP actions. =item username => STRING =item via => CLASS|NAME =back =back =head2 Attributes =over 4 =item $obj-EB() Returns C when SSL must be used. =back =head2 Receiving mail Extends L<"Receiving mail" in Mail::Transport::Receive|Mail::Transport::Receive/"Receiving mail">. =over 4 =item $obj-EB( [$unique_message_id] ) Inherited, see L =back =head2 Exchanging information =over 4 =item $obj-EB() Mark all messages that have been fetched with L for deletion. See L. =item $obj-EB(BOOLEAN, @ids) Either mark the specified message(s) to be deleted on the remote server or unmark them for deletion (if the first parameter is false). Deletion of messages will take place B when the connection is specifically disconnected or the last reference to the object goes out of scope. =item $obj-EB() Break contact with the server, if that (still) exists. Returns true if successful. Please note that even if the disconnect was not successful, all knowledge of messages etc. will be removed from the object: the object basically has reverted to the state in which it was before anything was done with the mail box. =item $obj-EB() Returns a reference to a list of ID's that have been fetched using L. This can be used to update a database of messages that were fetched (but maybe not yet deleted) from the mailbox. Please note that if the POP3 server did not support the UIDL command, this method will always return undef because it is not possibly to reliably identify messages between sessions (other than looking at the contents of the messages themselves). See also L. =item $obj-EB() Returns the total number of octets used by the mailbox on the remote server. =item $obj-EB
( $id, [$bodylines] ) Returns a reference to an array which contains the header of the message with the specified $id. C is returned if something has gone wrong. The optional integer $bodylines specifies the number of lines from the body which should be added, by default none. example: my $ref_lines = $pop3->header($uidl); print @$ref_lines; =item $obj-EB($id) Translates the unique $id of a message into a sequence number which represents the message as long a this connection to the POP3 server exists. When the message has been deleted for some reason, C is returned. =item $obj-EB() Returns a list (in list context) or a reference to a list (in scalar context) of all IDs which are known by the server on this moment. =item $obj-EB($id) Returns a reference to an array which contains the lines of the message with the specified $id. Returns C if something has gone wrong. example: my $ref_lines = $pop3->message($uidl); print @$ref_lines; =item $obj-EB($id) Returns the size of the message which is indicated by the $id, in octets. If the message has been deleted on the remote server, this will return C. =item $obj-EB() Returns (in scalar context only) the number of messages that are known to exist in the mailbox. =back =head2 Protocol internals The follow methods handle protocol internals, and should not be used by a normal user of this class. =over 4 =item $obj-EB() Establish a new connection to the POP3 server, using username and password. =item $obj-EB($socket, $data) Send $data to the indicated socket and return the first line read from that socket. Logs an error if either writing to or reading from socket failed. This method does B attempt to reconnect or anything: if reading or writing the socket fails, something is very definitely wrong. =item $obj-EB($socket, $command) Sends the indicated $command to the specified socket, and retrieves the response. It returns a reference to an array with all the lines that were reveived after the first C<+OK> line and before the end-of-message delimiter (a single dot on a line). Returns C whenever something has gone wrong. =item $obj-EB() Returns a connection to the POP3 server. If there was no connection yet, it will be created transparently. If the connection with the POP3 server was lost, it will be reconnected and the assures that internal state information (STAT and UIDL) is up-to-date in the object. If the contact to the server was still present, or could be established, an IO::Socket::INET object is returned. Else, C is returned and no further actions should be tried on the object. =item $obj-EB($socket) Update the current status of folder on the remote POP3 server. =back =head2 Server connection Extends L<"Server connection" in Mail::Transport::Receive|Mail::Transport::Receive/"Server connection">. =over 4 =item $obj-EB( $name, [@directories] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Represent this pop3 connection as URL. =back =head2 Error handling Extends L<"Error handling" in Mail::Transport::Receive|Mail::Transport::Receive/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $obj-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) =item Mail::Transport::POP3-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level, [$strings]] ) =item Mail::Transport::POP3-EB( [$level, [$strings]] ) Inherited, see L =item $obj-EB($level) =item Mail::Transport::POP3-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Transport::Receive|Mail::Transport::Receive/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Error: Cannot connect to $host:$port for POP3: $! Unsuccessful in connecting to the remote POP3 server. =item Error: Cannot get the messages of pop3 via messages() It is not possible to retrieve all messages on a remote POP3 folder at once: each shall be taken separately. The POP3 folder will hide this for you. =item Error: Cannot re-connect reliably to server which doesn't support UIDL. The connection to the remote POP3 was lost, and cannot be re-established because the server's protocol implementation lacks the necessary information. =item Error: Cannot read POP3 from socket: $! It is not possible to read the success status of the previously given POP3 command. Connection lost? =item Error: Cannot write POP3 to socket: $@ It is not possible to send a protocol command to the POP3 server. Connection lost? =item Error: Could not authenticate using '$some' method. The authenication method to get access to the POP3 server did not result in a connection. Maybe you need a different authentication protocol, or your username with password are invalid. =item Error: Could not authenticate using any login method. No authentication method was explicitly prescribed, so both AUTH and APOP were tried. However, both failed. There are other authentication methods, which are not defined by the main POP3 RFC rfc1939. These protocols are not implemented yet. Please contribute your implementation. =item Error: POP3 Could not do a STAT For some weird reason, the server does not respond to the STAT call. =item Error: POP3 requires a username and password. No username and/or no password specified for this POP3 folder, although these are obligatory parts in the protocol. =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. =item Error: Server at $host:$port does not seem to be talking POP3. The remote server did not respond to an initial exchange of messages as is expected by the POP3 protocol. The server has probably a different service on the specified port. =back =head1 SEE ALSO This module is part of Mail-Box-POP3 distribution version 3.005, built on May 03, 2019. Website: F =head1 LICENSE Copyrights 2001-2019 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Box-POP3-3.005/lib/Mail/Box/0000755000175000001440000000000013462770346016562 5ustar00markovusers00000000000000Mail-Box-POP3-3.005/lib/Mail/Box/POP3s.pm0000644000175000001440000000143513462770344020025 0ustar00markovusers00000000000000# Copyrights 2001-2019 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Box-POP3. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Box::POP3s; use vars '$VERSION'; $VERSION = '3.005'; use base 'Mail::Box::POP3'; use strict; use warnings; sub init($) { my ($self, $args) = @_; $args->{server_port} ||= 995; $self->SUPER::init($args); $self; } sub type() {'pop3s'} #------------------------------------------- sub popClient(%) { my $self = shift; $self->SUPER::popClient(@_, use_ssl => 1); } 1; Mail-Box-POP3-3.005/lib/Mail/Box/POP3s.pod0000644000175000001440000003533213462770345020177 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::POP3s - handle secure POP3 folders as client =head1 INHERITANCE Mail::Box::POP3s is a Mail::Box::POP3 is a Mail::Box::Net is a Mail::Box is a Mail::Reporter =head1 SYNOPSIS use Mail::Box::POP3s; my $folder = Mail::Box::POP3s->new(folder => $ENV{MAIL}, ...); =head1 DESCRIPTION This module mainly extends L. Extends L<"DESCRIPTION" in Mail::Box::POP3|Mail::Box::POP3/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Box::POP3|Mail::Box::POP3/"OVERLOADED">. =over 4 =item overload: B<""> Inherited, see L =item overload: B<@{}> Inherited, see L =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Box::POP3|Mail::Box::POP3/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Box::POP3|Mail::Box::POP3/"Constructors">. =over 4 =item Mail::Box::POP3s-EB(%options) -Option --Defined in --Default access Mail::Box 'r' authenticate Mail::Box::POP3 'AUTO' body_delayed_type Mail::Box Mail::Message::Body::Delayed body_type Mail::Box Mail::Message::Body::Lines coerce_options Mail::Box [] create Mail::Box extract Mail::Box 10240 field_type Mail::Box undef fix_headers Mail::Box folder Mail::Box folderdir Mail::Box head_delayed_type Mail::Box Mail::Message::Head::Delayed head_type Mail::Box Mail::Message::Head::Complete keep_dups Mail::Box lock_file Mail::Box undef lock_timeout Mail::Box 1 hour lock_type Mail::Box 'NONE' lock_wait Mail::Box 10 seconds locker Mail::Box undef log Mail::Reporter 'WARNINGS' manager Mail::Box undef message_type Mail::Box Mail::Box::POP3::Message multipart_type Mail::Box Mail::Message::Body::Multipart password Mail::Box::Net undef pop_client Mail::Box::POP3 undef remove_when_empty Mail::Box save_on_exit Mail::Box server_name Mail::Box::Net undef server_port Mail::Box::Net 995 trace Mail::Reporter 'WARNINGS' trusted Mail::Box username Mail::Box::Net undef =over 2 =item access => MODE =item authenticate => 'LOGIN'|'APOP'|'AUTO' =item body_delayed_type => CLASS =item body_type => CLASS|CODE =item coerce_options => ARRAY =item create => BOOLEAN =item extract => INTEGER | CODE | METHOD | 'LAZY'|'ALWAYS' =item field_type => CLASS =item fix_headers => BOOLEAN =item folder => FOLDERNAME =item folderdir => DIRECTORY =item head_delayed_type => CLASS =item head_type => CLASS =item keep_dups => BOOLEAN =item lock_file => FILENAME =item lock_timeout => SECONDS =item lock_type => CLASS|STRING|ARRAY =item lock_wait => SECONDS =item locker => OBJECT =item log => LEVEL =item manager => MANAGER =item message_type => CLASS =item multipart_type => CLASS =item password => STRING =item pop_client => OBJECT =item remove_when_empty => BOOLEAN =item save_on_exit => BOOLEAN =item server_name => HOSTNAME =item server_port => INTEGER =item trace => LEVEL =item trusted => BOOLEAN =item username => STRING =back =back =head2 The folder Extends L<"The folder" in Mail::Box::POP3|Mail::Box::POP3/"The folder">. =over 4 =item $obj-EB($message) Inherited, see L =item $obj-EB($messages) Inherited, see L =item Mail::Box::POP3s-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB($folder, %options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB( [$directory] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Folder flags Extends L<"Folder flags" in Mail::Box::POP3|Mail::Box::POP3/"Folder flags">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [BOOLEAN] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 The messages Extends L<"The messages" in Mail::Box::POP3|Mail::Box::POP3/"The messages">. =over 4 =item $obj-EB( [$number|$message|$message_id] ) Inherited, see L =item $obj-EB($message_id) Inherited, see L =item $obj-EB( $label, [BOOLEAN, [$msgs]] ) Inherited, see L =item $obj-EB( $index, [$message] ) Inherited, see L =item $obj-EB( $message_id, [$message] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( <'ALL'|$range|'ACTIVE'|'DELETED'|$label| !$label|$filter> ) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB($message, $message_ids, $timespan, $window) Inherited, see L =back =head2 Sub-folders Extends L<"Sub-folders" in Mail::Box::POP3|Mail::Box::POP3/"Sub-folders">. =over 4 =item $obj-EB(%options) =item Mail::Box::POP3s-EB(%options) Inherited, see L =item $obj-EB( $subname, [$parentname] ) =item Mail::Box::POP3s-EB( $subname, [$parentname] ) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() =item Mail::Box::POP3s-EB() Inherited, see L =back =head2 Internals Extends L<"Internals" in Mail::Box::POP3|Mail::Box::POP3/"Internals">. =over 4 =item $obj-EB($message, %options) Inherited, see L =item $obj-EB($folder, %options) =item Mail::Box::POP3s-EB($folder, %options) Inherited, see L =item $obj-EB($message, $head) Inherited, see L =item Mail::Box::POP3s-EB( [$foldername], %options ) Inherited, see L =item $obj-EB($message) Inherited, see L =item $obj-EB($message) Inherited, see L =item $obj-EB( [] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB($message) Inherited, see L =item $obj-EB($messages) Inherited, see L =item $obj-EB($messages) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =back =head2 Other methods Extends L<"Other methods" in Mail::Box::POP3|Mail::Box::POP3/"Other methods">. =over 4 =item $obj-EB($time) =item Mail::Box::POP3s-EB($time) Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Box::POP3|Mail::Box::POP3/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $obj-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) =item Mail::Box::POP3s-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level, [$strings]] ) =item Mail::Box::POP3s-EB( [$level, [$strings]] ) Inherited, see L =item $obj-EB($level) =item Mail::Box::POP3s-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Box::POP3|Mail::Box::POP3/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Mail::Box::POP3|Mail::Box::POP3/"DETAILS">. =head1 DIAGNOSTICS =over 4 =item Error: Cannot create POP3 client for $name. The connection to the POP3 server cannot be established. You may see more, related, error messages about the failure. =item Error: Cannot find head back for $uidl on POP3 server $name. The server told to have this message, but when asked for its headers, no single line was returned. Did the message get destroyed? =item Error: Cannot read body for $uidl on POP3 server $name. The message's headers are retrieved from the server, but the body seems to be lost. Did the message get destroyed between reading the header and reading the body? =item Warning: Changes not written to read-only folder $self. You have opened the folder read-only --which is the default set by L--, made modifications, and now want to close it. Set L if you want to overrule the access mode, or close the folder with L set to C. =item Error: Copying failed for one message. For some reason, for instance disc full, removed by external process, or read-protection, it is impossible to copy one of the messages. Copying will proceed for the other messages. =item Error: Destination folder $name is not writable. The folder where the messages are copied to is not opened with write access (see L). This has no relation with write permission to the folder which is controlled by your operating system. =item Warning: Different messages with id $msgid The message id is discovered more than once within the same folder, but the content of the message seems to be different. This should not be possible: each message must be unique. =item Error: Folder $name is opened read-only You can not write to this folder unless you have opened the folder to write or append with L, or the C option is set true. =item Error: Invalid timespan '$timespan' specified. The string does not follow the strict rules of the time span syntax which is permitted as parameter. =item Warning: Message $uidl on POP3 server $name disappeared. The server indicated the existence of this message before, however it has no information about the message anymore. =item Warning: Message-id '$msgid' does not contain a domain. According to the RFCs, message-ids need to contain a unique random part, then an C<@>, and then a domain name. This is made to avoid the creation of two messages with the same id. The warning emerges when the C<@> is missing from the string. =item Warning: POP3 folders cannot be deleted. Each user has only one POP3 folder on a server. This folder is created and deleted by the server's administrator only. =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. =item Error: Unable to create subfolder $name of $folder. The copy includes the subfolders, but for some reason it was not possible to copy one of these. Copying will proceed for all other sub-folders. =item Error: Update of $nr messages ignored for POP3 folder $name. The standard POP3 implementation does not support writing from client back to the server. Therefore, modifications may be lost. =item Error: Writing folder $name failed For some reason (you probably got more error messages about this problem) it is impossible to write the folder, although you should because there were changes made. =item Error: You cannot write a message to a pop server (yet) Some extensions to the POP3 protocol do permit writing messages to the server, but the standard protocol only implements retreival. Feel invited to extend our implementation with writing. =back =head1 SEE ALSO This module is part of Mail-Box-POP3 distribution version 3.005, built on May 03, 2019. Website: F =head1 LICENSE Copyrights 2001-2019 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Box-POP3-3.005/lib/Mail/Box/POP3.pm0000644000175000001440000001240513462770344017641 0ustar00markovusers00000000000000# Copyrights 2001-2019 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Box-POP3. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Box::POP3; use vars '$VERSION'; $VERSION = '3.005'; use base 'Mail::Box::Net'; use strict; use warnings; use Mail::Box::POP3::Message; use Mail::Box::Parser::Perl; use Mail::Box::FastScalar; use File::Spec; use File::Basename; use Carp; sub init($) { my ($self, $args) = @_; $args->{server_port} ||= 110; $args->{folder} ||= 'inbox'; $args->{message_type} ||= 'Mail::Box::POP3::Message'; $self->SUPER::init($args); $self->{MBP_client} = $args->{pop_client}; $self->{MBP_auth} = $args->{authenticate} || 'AUTO'; $self; } sub create($@) { undef } # fails sub foundIn(@) { my $self = shift; unshift @_, 'folder' if @_ % 2; my %options = @_; (exists $options{type} && lc $options{type} eq 'pop3') || (exists $options{folder} && $options{folder} =~ m/^pop/); } sub addMessage($) { my ($self, $message) = @_; $self->log(ERROR => "You cannot write a message to a pop server (yet)") if defined $message; undef; } sub addMessages(@) { my $self = shift; # error message described in addMessage() $self->log(ERROR => "You cannot write messages to a pop server (yet)") if @_; (); } sub type() {'pop3'} sub close(@) { my $self = shift; $self->SUPER::close(@_); my $pop = delete $self->{MBP_client}; $pop->disconnect if defined $pop; $self; } sub delete(@) { my $self = shift; $self->log(WARNING => "POP3 folders cannot be deleted."); undef; } sub listSubFolders(@) { () } # no sub openSubFolder($@) { undef } # fails sub topFolderWithMessages() { 1 } # Yes: only top folder sub update() {shift->notImplemented} #------------------------------------------- sub popClient(%) { my ($self, %args) = @_; return $self->{MBP_client} if defined $self->{MBP_client}; my $auth = $self->{auth}; require Mail::Transport::POP3; my $client = Mail::Transport::POP3->new ( username => $self->{MBN_username} , password => $self->{MBN_password} , hostname => $self->{MBN_hostname} , port => $self->{MBN_port} , authenticate => $self->{MBP_auth} , use_ssl => $args{use_ssl} ); $self->log(ERROR => "Cannot create POP3 client for $self.") unless defined $client; $self->{MBP_client} = $client; } sub readMessages(@) { my ($self, %args) = @_; my $pop = $self->popClient or return; my @log = $self->logSettings; my $seqnr = 0; foreach my $id ($pop->ids) { my $message = $args{message_type}->new ( head => $args{head_delayed_type}->new(@log) , unique => $id , folder => $self , seqnr => $seqnr++ ); my $body = $args{body_delayed_type}->new(@log, message => $message); $message->storeBody($body); $self->storeMessage($message); } $self; } sub getHead($) { my ($self, $message) = @_; my $pop = $self->popClient or return; my $uidl = $message->unique; my $lines = $pop->header($uidl); unless(defined $lines) { $lines = []; $self->log(WARNING => "Message $uidl disappeared from POP3 server $self."); } my $text = join '', @$lines; my $parser = Mail::Box::Parser::Perl->new # not parseable by C parser ( filename => "$pop" , file => Mail::Box::FastScalar->new(\$text) , fix_headers => $self->{MB_fix_headers} ); $self->lazyPermitted(1); my $head = $message->readHead($parser); $parser->stop; $self->lazyPermitted(0); $self->log(PROGRESS => "Loaded head of $uidl."); $head; } sub getHeadAndBody($) { my ($self, $message) = @_; my $pop = $self->popClient or return; my $uidl = $message->unique; my $lines = $pop->message($uidl); unless(defined $lines) { $lines = []; $self->log(WARNING => "Message $uidl disappeared from POP3 server $self."); } my $parser = Mail::Box::Parser::Perl->new # not parseable by C parser ( filename => "$pop" , file => IO::ScalarArray->new($lines) ); my $head = $message->readHead($parser); unless(defined $head) { $self->log(ERROR => "Cannot find head back for $uidl on POP3 server $self."); $parser->stop; return undef; } my $body = $message->readBody($parser, $head); unless(defined $body) { $self->log(ERROR => "Cannot read body for $uidl on POP3 server $self."); $parser->stop; return undef; } $parser->stop; $self->log(PROGRESS => "Loaded message $uidl."); ($head, $body); } sub writeMessages($@) { my ($self, $args) = @_; if(my $modifications = grep {$_->isModified} @{$args->{messages}}) { $self->log(WARNING => "Update of $modifications messages ignored for POP3 folder $self."); } $self; } #------------------------------------------- 1; Mail-Box-POP3-3.005/lib/Mail/Box/POP3/0000755000175000001440000000000013462770346017303 5ustar00markovusers00000000000000Mail-Box-POP3-3.005/lib/Mail/Box/POP3/Test.pm0000644000175000001440000000336213462770344020562 0ustar00markovusers00000000000000# Copyrights 2001-2019 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Box-POP3. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Box::POP3::Test; use vars '$VERSION'; $VERSION = '3.005'; use base 'Exporter'; use strict; use warnings; use Mail::Transport::POP3; use List::Util 'first'; use File::Spec; our @EXPORT = qw/start_pop3_server start_pop3_client/; # # Start POP3 server for tests # sub start_pop3_server($;$) { my $popbox = shift; my $setting = shift || ''; my $serverscript = File::Spec->catfile('t', 'server'); # Some complications to find-out $perl, which must be absolute and # untainted for perl5.6.1, but not for the other Perl's. my $perl = $^X; unless(File::Spec->file_name_is_absolute($perl)) { my @path = split /\:|\;/, $ENV{PATH}; $perl = first { -x $_ } map { File::Spec->catfile($_, $^X) } @path; } $perl =~ m/(.*)/; $perl = $1; %ENV = (); open(my $server, "$perl $serverscript $popbox $setting|") or die "Could not start POP3 server\n"; my $line = <$server>; my $port = $line =~ m/(\d+)/ ? $1 : die "Did not get port specification, but '$line'"; ($server, $port); } # # START_POP3_CLIENT PORT, OPTIONS # sub start_pop3_client($@) { my ($port, @options) = @_; Mail::Transport::POP3->new ( hostname => '127.0.0.1' , port => $port , username => 'user' , password => 'password' , @options ); } 1; Mail-Box-POP3-3.005/lib/Mail/Box/POP3/Message.pm0000644000175000001440000000373513462770344021233 0ustar00markovusers00000000000000# Copyrights 2001-2019 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Box-POP3. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Box::POP3::Message; use vars '$VERSION'; $VERSION = '3.005'; use base 'Mail::Box::Net::Message'; use strict; use warnings; sub init($) { my ($self, $args) = @_; $args->{body_type} ||= 'Mail::Message::Body::Lines'; $self->SUPER::init($args); $self; } sub size($) { my $self = shift; return $self->SUPER::size unless $self->isDelayed; $self->folder->popClient->messageSize($self->unique); } sub label(@) { my $self = shift; $self->loadHead; # be sure the labels are read return $self->SUPER::label(@_) if @_==1; # POP3 can only set 'deleted' in the source folder. Don't forget my $olddel = $self->label('deleted') ? 1 : 0; my $ret = $self->SUPER::label(@_); my $newdel = $self->label('deleted') ? 1 : 0; $self->folder->popClient->deleted($newdel, $self->unique) if $newdel != $olddel; $ret; } sub labels(@) { my $self = shift; $self->loadHead; # be sure the labels are read $self->SUPER::labels(@_); } #------------------------------------------- sub loadHead() { my $self = shift; my $head = $self->head; return $head unless $head->isDelayed; $head = $self->folder->getHead($self); $self->head($head); $self->statusToLabels; # not supported by al POP3 servers $head; } sub loadBody() { my $self = shift; my $body = $self->body; return $body unless $body->isDelayed; (my $head, $body) = $self->folder->getHeadAndBody($self); $self->head($head) if $head->isDelayed; $self->storeBody($body); } 1; Mail-Box-POP3-3.005/lib/Mail/Box/POP3/Message.pod0000644000175000001440000003664213462770345021405 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::POP3::Message - one message on a POP3 server =head1 INHERITANCE Mail::Box::POP3::Message is a Mail::Box::Net::Message is a Mail::Box::Message is a Mail::Message is a Mail::Reporter =head1 SYNOPSIS my $folder = new Mail::Box::POP3 ... my $message = $folder->message(10); =head1 DESCRIPTION A C represents one message on a POP3 server, maintained by a L folder. Each message is stored as separate entity on the server, and maybe temporarily in your program as well. Extends L<"DESCRIPTION" in Mail::Box::Net::Message|Mail::Box::Net::Message/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Box::Net::Message|Mail::Box::Net::Message/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Box::Net::Message|Mail::Box::Net::Message/"Constructors">. =over 4 =item $obj-EB(%options) Inherited, see L =item Mail::Box::POP3::Message-EB(%options) -Option --Defined in --Default body Mail::Message undef body_type Mail::Box::Message Mail::Message::Body::Lines deleted Mail::Message field_type Mail::Message undef folder Mail::Box::Message head Mail::Message undef head_type Mail::Message Mail::Message::Head::Complete labels Mail::Message {} log Mail::Reporter 'WARNINGS' messageId Mail::Message undef modified Mail::Message size Mail::Box::Message undef trace Mail::Reporter 'WARNINGS' trusted Mail::Message unique Mail::Box::Net::Message =over 2 =item body => OBJECT =item body_type => CODE|CLASS =item deleted => BOOLEAN =item field_type => CLASS =item folder => FOLDER =item head => OBJECT =item head_type => CLASS =item labels => ARRAY|HASH =item log => LEVEL =item messageId => STRING =item modified => BOOLEAN =item size => INTEGER =item trace => LEVEL =item trusted => BOOLEAN =item unique => STRING =back =back =head2 Constructing a message Extends L<"Constructing a message" in Mail::Box::Net::Message|Mail::Box::Net::Message/"Constructing a message">. =over 4 =item $obj-EB( [<$rg_object|%options>] ) Inherited, see L =item Mail::Box::POP3::Message-EB( [$message|$part|$body], $content ) Inherited, see L =item Mail::Box::POP3::Message-EB($body, [$head], $headers) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB(STRING) Inherited, see L =item Mail::Box::POP3::Message-EB($fh|STRING|SCALAR|ARRAY, %options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB( [STRING|$field|$address|ARRAY-$of-$things] ) Inherited, see L =item $obj-EB(STRING) =item Mail::Box::POP3::Message-EB(STRING) Inherited, see L =back =head2 The message Extends L<"The message" in Mail::Box::Net::Message|Mail::Box::Net::Message/"The message">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($folder, %options) Inherited, see L =item $obj-EB( [$folder] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB($folder, %options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB( [$mailer], %options ) Inherited, see L =item $obj-EB( [$integer] ) Inherited, see L =item $obj-EB() Returns the size of this message. If the message is still on the remote server, POP is used to ask for the size. When the message is already loaded onto the local system, the size of the parsed message is taken. These sizes can differ because the difference in line-ending representation. =item $obj-EB() Inherited, see L =item $obj-EB( [STRING|undef] ) Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =back =head2 The header Extends L<"The header" in Mail::Box::Net::Message|Mail::Box::Net::Message/"The header">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB($fieldname) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$head] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB($fieldname) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 The body Extends L<"The body" in Mail::Box::Net::Message|Mail::Box::Net::Message/"The body">. =over 4 =item $obj-EB( [$body] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [<'ALL'|'ACTIVE'|'DELETED'|'RECURSE'|$filter>] ) Inherited, see L =back =head2 Flags Extends L<"Flags" in Mail::Box::Net::Message|Mail::Box::Net::Message/"Flags">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB( [BOOLEAN] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB