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