1# Net::POP3.pm 2# 3# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved. 4# This program is free software; you can redistribute it and/or 5# modify it under the same terms as Perl itself. 6 7package Net::POP3; 8 9use strict; 10use IO::Socket; 11use vars qw(@ISA $VERSION $debug); 12use Net::Cmd; 13use Carp; 14use Net::Config; 15 16$VERSION = "2.24"; # $Id: //depot/libnet/Net/POP3.pm#24 $ 17 18@ISA = qw(Net::Cmd IO::Socket::INET); 19 20sub new 21{ 22 my $self = shift; 23 my $type = ref($self) || $self; 24 my $host = shift if @_ % 2; 25 my %arg = @_; 26 my $hosts = defined $host ? [ $host ] : $NetConfig{pop3_hosts}; 27 my $obj; 28 my @localport = exists $arg{ResvPort} ? ( LocalPort => $arg{ResvPort} ): (); 29 30 my $h; 31 foreach $h (@{$hosts}) 32 { 33 $obj = $type->SUPER::new(PeerAddr => ($host = $h), 34 PeerPort => $arg{Port} || 'pop3(110)', 35 Proto => 'tcp', 36 @localport, 37 Timeout => defined $arg{Timeout} 38 ? $arg{Timeout} 39 : 120 40 ) and last; 41 } 42 43 return undef 44 unless defined $obj; 45 46 ${*$obj}{'net_pop3_host'} = $host; 47 48 $obj->autoflush(1); 49 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); 50 51 unless ($obj->response() == CMD_OK) 52 { 53 $obj->close(); 54 return undef; 55 } 56 57 ${*$obj}{'net_pop3_banner'} = $obj->message; 58 59 $obj; 60} 61 62## 63## We don't want people sending me their passwords when they report problems 64## now do we :-) 65## 66 67sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; } 68 69sub login 70{ 71 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )'; 72 my($me,$user,$pass) = @_; 73 74 if (@_ <= 2) { 75 ($user, $pass) = $me->_lookup_credentials($user); 76 } 77 78 $me->user($user) and 79 $me->pass($pass); 80} 81 82sub apop 83{ 84 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )'; 85 my($me,$user,$pass) = @_; 86 my $banner; 87 my $md; 88 89 if (eval { local $SIG{__DIE__}; require Digest::MD5 }) { 90 $md = Digest::MD5->new(); 91 } elsif (eval { local $SIG{__DIE__}; require MD5 }) { 92 $md = MD5->new(); 93 } else { 94 carp "You need to install Digest::MD5 or MD5 to use the APOP command"; 95 return undef; 96 } 97 98 return undef 99 unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0] ); 100 101 if (@_ <= 2) { 102 ($user, $pass) = $me->_lookup_credentials($user); 103 } 104 105 $md->add($banner,$pass); 106 107 return undef 108 unless($me->_APOP($user,$md->hexdigest)); 109 110 $me->_get_mailbox_count(); 111} 112 113sub user 114{ 115 @_ == 2 or croak 'usage: $pop3->user( USER )'; 116 $_[0]->_USER($_[1]) ? 1 : undef; 117} 118 119sub pass 120{ 121 @_ == 2 or croak 'usage: $pop3->pass( PASS )'; 122 123 my($me,$pass) = @_; 124 125 return undef 126 unless($me->_PASS($pass)); 127 128 $me->_get_mailbox_count(); 129} 130 131sub reset 132{ 133 @_ == 1 or croak 'usage: $obj->reset()'; 134 135 my $me = shift; 136 137 return 0 138 unless($me->_RSET); 139 140 if(defined ${*$me}{'net_pop3_mail'}) 141 { 142 local $_; 143 foreach (@{${*$me}{'net_pop3_mail'}}) 144 { 145 delete $_->{'net_pop3_deleted'}; 146 } 147 } 148} 149 150sub last 151{ 152 @_ == 1 or croak 'usage: $obj->last()'; 153 154 return undef 155 unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/; 156 157 return $1; 158} 159 160sub top 161{ 162 @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])'; 163 my $me = shift; 164 165 return undef 166 unless $me->_TOP($_[0], $_[1] || 0); 167 168 $me->read_until_dot; 169} 170 171sub popstat 172{ 173 @_ == 1 or croak 'usage: $pop3->popstat()'; 174 my $me = shift; 175 176 return () 177 unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/; 178 179 ($1 || 0, $2 || 0); 180} 181 182sub list 183{ 184 @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )'; 185 my $me = shift; 186 187 return undef 188 unless $me->_LIST(@_); 189 190 if(@_) 191 { 192 $me->message =~ /\d+\D+(\d+)/; 193 return $1 || undef; 194 } 195 196 my $info = $me->read_until_dot 197 or return undef; 198 199 my %hash = map { (/(\d+)\D+(\d+)/) } @$info; 200 201 return \%hash; 202} 203 204sub get 205{ 206 @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])'; 207 my $me = shift; 208 209 return undef 210 unless $me->_RETR(shift); 211 212 $me->read_until_dot(@_); 213} 214 215sub getfh 216{ 217 @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )'; 218 my $me = shift; 219 220 return unless $me->_RETR(shift); 221 return $me->tied_fh; 222} 223 224 225 226sub delete 227{ 228 @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )'; 229 $_[0]->_DELE($_[1]); 230} 231 232sub uidl 233{ 234 @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )'; 235 my $me = shift; 236 my $uidl; 237 238 $me->_UIDL(@_) or 239 return undef; 240 if(@_) 241 { 242 $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0]; 243 } 244 else 245 { 246 my $ref = $me->read_until_dot 247 or return undef; 248 my $ln; 249 $uidl = {}; 250 foreach $ln (@$ref) { 251 my($msg,$uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/; 252 $uidl->{$msg} = $uid; 253 } 254 } 255 return $uidl; 256} 257 258sub ping 259{ 260 @_ == 2 or croak 'usage: $pop3->ping( USER )'; 261 my $me = shift; 262 263 return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/; 264 265 ($1 || 0, $2 || 0); 266} 267 268sub _lookup_credentials 269{ 270 my ($me, $user) = @_; 271 272 require Net::Netrc; 273 274 $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } || 275 $ENV{NAME} || $ENV{USER} || $ENV{LOGNAME}; 276 277 my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user); 278 $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'}); 279 280 my $pass = $m ? $m->password || "" 281 : ""; 282 283 ($user, $pass); 284} 285 286sub _get_mailbox_count 287{ 288 my ($me) = @_; 289 my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io) 290 ? $1 : ($me->popstat)[0]; 291 292 $ret ? $ret : "0E0"; 293} 294 295 296sub _STAT { shift->command('STAT')->response() == CMD_OK } 297sub _LIST { shift->command('LIST',@_)->response() == CMD_OK } 298sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK } 299sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK } 300sub _NOOP { shift->command('NOOP')->response() == CMD_OK } 301sub _RSET { shift->command('RSET')->response() == CMD_OK } 302sub _QUIT { shift->command('QUIT')->response() == CMD_OK } 303sub _TOP { shift->command('TOP', @_)->response() == CMD_OK } 304sub _UIDL { shift->command('UIDL',@_)->response() == CMD_OK } 305sub _USER { shift->command('USER',$_[0])->response() == CMD_OK } 306sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK } 307sub _APOP { shift->command('APOP',@_)->response() == CMD_OK } 308sub _PING { shift->command('PING',$_[0])->response() == CMD_OK } 309 310sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK } 311sub _LAST { shift->command('LAST')->response() == CMD_OK } 312 313sub quit 314{ 315 my $me = shift; 316 317 $me->_QUIT; 318 $me->close; 319} 320 321sub DESTROY 322{ 323 my $me = shift; 324 325 if(defined fileno($me)) 326 { 327 $me->reset; 328 $me->quit; 329 } 330} 331 332## 333## POP3 has weird responses, so we emulate them to look the same :-) 334## 335 336sub response 337{ 338 my $cmd = shift; 339 my $str = $cmd->getline() || return undef; 340 my $code = "500"; 341 342 $cmd->debug_print(0,$str) 343 if ($cmd->debug); 344 345 if($str =~ s/^\+OK\s*//io) 346 { 347 $code = "200" 348 } 349 else 350 { 351 $str =~ s/^-ERR\s*//io; 352 } 353 354 ${*$cmd}{'net_cmd_resp'} = [ $str ]; 355 ${*$cmd}{'net_cmd_code'} = $code; 356 357 substr($code,0,1); 358} 359 3601; 361 362__END__ 363 364=head1 NAME 365 366Net::POP3 - Post Office Protocol 3 Client class (RFC1939) 367 368=head1 SYNOPSIS 369 370 use Net::POP3; 371 372 # Constructors 373 $pop = Net::POP3->new('pop3host'); 374 $pop = Net::POP3->new('pop3host', Timeout => 60); 375 376 if ($pop->login($username, $password) > 0) { 377 my $msgnums = $pop->list; # hashref of msgnum => size 378 foreach my $msgnum (keys %$msgnums) { 379 my $msg = $pop->get($msgnum); 380 print @$msg; 381 $pop->delete($msgnum); 382 } 383 } 384 385 $pop->quit; 386 387=head1 DESCRIPTION 388 389This module implements a client interface to the POP3 protocol, enabling 390a perl5 application to talk to POP3 servers. This documentation assumes 391that you are familiar with the POP3 protocol described in RFC1939. 392 393A new Net::POP3 object must be created with the I<new> method. Once 394this has been done, all POP3 commands are accessed via method calls 395on the object. 396 397=head1 CONSTRUCTOR 398 399=over 4 400 401=item new ( [ HOST, ] [ OPTIONS ] ) 402 403This is the constructor for a new Net::POP3 object. C<HOST> is the 404name of the remote host to which a POP3 connection is required. 405 406If C<HOST> is not given, then the C<POP3_Host> specified in C<Net::Config> 407will be used. 408 409C<OPTIONS> are passed in a hash like fashion, using key and value pairs. 410Possible options are: 411 412B<ResvPort> - If given then the socket for the C<Net::POP3> object 413will be bound to the local port given using C<bind> when the socket is 414created. 415 416B<Timeout> - Maximum time, in seconds, to wait for a response from the 417POP3 server (default: 120) 418 419B<Debug> - Enable debugging information 420 421=back 422 423=head1 METHODS 424 425Unless otherwise stated all methods return either a I<true> or I<false> 426value, with I<true> meaning that the operation was a success. When a method 427states that it returns a value, failure will be returned as I<undef> or an 428empty list. 429 430=over 4 431 432=item user ( USER ) 433 434Send the USER command. 435 436=item pass ( PASS ) 437 438Send the PASS command. Returns the number of messages in the mailbox. 439 440=item login ( [ USER [, PASS ]] ) 441 442Send both the USER and PASS commands. If C<PASS> is not given the 443C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host 444and username. If the username is not specified then the current user name 445will be used. 446 447Returns the number of messages in the mailbox. However if there are no 448messages on the server the string C<"0E0"> will be returned. This is 449will give a true value in a boolean context, but zero in a numeric context. 450 451If there was an error authenticating the user then I<undef> will be returned. 452 453=item apop ( [ USER [, PASS ]] ) 454 455Authenticate with the server identifying as C<USER> with password C<PASS>. 456Similar to L</login>, but the password is not sent in clear text. 457 458To use this method you must have the Digest::MD5 or the MD5 module installed, 459otherwise this method will return I<undef>. 460 461=item top ( MSGNUM [, NUMLINES ] ) 462 463Get the header and the first C<NUMLINES> of the body for the message 464C<MSGNUM>. Returns a reference to an array which contains the lines of text 465read from the server. 466 467=item list ( [ MSGNUM ] ) 468 469If called with an argument the C<list> returns the size of the message 470in octets. 471 472If called without arguments a reference to a hash is returned. The 473keys will be the C<MSGNUM>'s of all undeleted messages and the values will 474be their size in octets. 475 476=item get ( MSGNUM [, FH ] ) 477 478Get the message C<MSGNUM> from the remote mailbox. If C<FH> is not given 479then get returns a reference to an array which contains the lines of 480text read from the server. If C<FH> is given then the lines returned 481from the server are printed to the filehandle C<FH>. 482 483=item getfh ( MSGNUM ) 484 485As per get(), but returns a tied filehandle. Reading from this 486filehandle returns the requested message. The filehandle will return 487EOF at the end of the message and should not be reused. 488 489=item last () 490 491Returns the highest C<MSGNUM> of all the messages accessed. 492 493=item popstat () 494 495Returns a list of two elements. These are the number of undeleted 496elements and the size of the mbox in octets. 497 498=item ping ( USER ) 499 500Returns a list of two elements. These are the number of new messages 501and the total number of messages for C<USER>. 502 503=item uidl ( [ MSGNUM ] ) 504 505Returns a unique identifier for C<MSGNUM> if given. If C<MSGNUM> is not 506given C<uidl> returns a reference to a hash where the keys are the 507message numbers and the values are the unique identifiers. 508 509=item delete ( MSGNUM ) 510 511Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages 512that are marked to be deleted will be removed from the remote mailbox 513when the server connection closed. 514 515=item reset () 516 517Reset the status of the remote POP3 server. This includes reseting the 518status of all messages to not be deleted. 519 520=item quit () 521 522Quit and close the connection to the remote POP3 server. Any messages marked 523as deleted will be deleted from the remote mailbox. 524 525=back 526 527=head1 NOTES 528 529If a C<Net::POP3> object goes out of scope before C<quit> method is called 530then the C<reset> method will called before the connection is closed. This 531means that any messages marked to be deleted will not be. 532 533=head1 SEE ALSO 534 535L<Net::Netrc>, 536L<Net::Cmd> 537 538=head1 AUTHOR 539 540Graham Barr <gbarr@pobox.com> 541 542=head1 COPYRIGHT 543 544Copyright (c) 1995-1997 Graham Barr. All rights reserved. 545This program is free software; you can redistribute it and/or modify 546it under the same terms as Perl itself. 547 548=for html <hr> 549 550I<$Id: //depot/libnet/Net/POP3.pm#24 $> 551 552=cut 553