Commit | Line | Data |
---|---|---|
406c51ee JH |
1 | # Net::POP3.pm |
2 | # | |
f92f3fcb | 3 | # Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. All rights reserved. |
406c51ee JH |
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 | ||
b3f6f6a6 | 16 | $VERSION = "2.29"; |
406c51ee JH |
17 | |
18 | @ISA = qw(Net::Cmd IO::Socket::INET); | |
19 | ||
b3f6f6a6 RGS |
20 | |
21 | sub new { | |
22 | my $self = shift; | |
23 | my $type = ref($self) || $self; | |
24 | my ($host, %arg); | |
25 | if (@_ % 2) { | |
26 | $host = shift; | |
27 | %arg = @_; | |
28 | } | |
29 | else { | |
30 | %arg = @_; | |
31 | $host = delete $arg{Host}; | |
32 | } | |
33 | my $hosts = defined $host ? [$host] : $NetConfig{pop3_hosts}; | |
34 | my $obj; | |
35 | my @localport = exists $arg{ResvPort} ? (LocalPort => $arg{ResvPort}) : (); | |
36 | ||
37 | my $h; | |
38 | foreach $h (@{$hosts}) { | |
39 | $obj = $type->SUPER::new( | |
40 | PeerAddr => ($host = $h), | |
41 | PeerPort => $arg{Port} || 'pop3(110)', | |
42 | Proto => 'tcp', | |
43 | @localport, | |
44 | Timeout => defined $arg{Timeout} | |
45 | ? $arg{Timeout} | |
46 | : 120 | |
47 | ) | |
48 | and last; | |
406c51ee JH |
49 | } |
50 | ||
b3f6f6a6 RGS |
51 | return undef |
52 | unless defined $obj; | |
406c51ee | 53 | |
b3f6f6a6 | 54 | ${*$obj}{'net_pop3_host'} = $host; |
406c51ee | 55 | |
b3f6f6a6 RGS |
56 | $obj->autoflush(1); |
57 | $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); | |
406c51ee | 58 | |
b3f6f6a6 RGS |
59 | unless ($obj->response() == CMD_OK) { |
60 | $obj->close(); | |
61 | return undef; | |
406c51ee JH |
62 | } |
63 | ||
b3f6f6a6 | 64 | ${*$obj}{'net_pop3_banner'} = $obj->message; |
406c51ee | 65 | |
b3f6f6a6 | 66 | $obj; |
406c51ee JH |
67 | } |
68 | ||
b3f6f6a6 | 69 | |
f92f3fcb | 70 | sub host { |
b3f6f6a6 RGS |
71 | my $me = shift; |
72 | ${*$me}{'net_pop3_host'}; | |
f92f3fcb GB |
73 | } |
74 | ||
406c51ee JH |
75 | ## |
76 | ## We don't want people sending me their passwords when they report problems | |
77 | ## now do we :-) | |
78 | ## | |
79 | ||
b3f6f6a6 | 80 | |
406c51ee JH |
81 | sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; } |
82 | ||
406c51ee | 83 | |
b3f6f6a6 RGS |
84 | sub login { |
85 | @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )'; | |
86 | my ($me, $user, $pass) = @_; | |
87 | ||
88 | if (@_ <= 2) { | |
89 | ($user, $pass) = $me->_lookup_credentials($user); | |
90 | } | |
406c51ee | 91 | |
b3f6f6a6 RGS |
92 | $me->user($user) |
93 | and $me->pass($pass); | |
406c51ee JH |
94 | } |
95 | ||
12df23ee | 96 | |
b3f6f6a6 RGS |
97 | sub apop { |
98 | @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )'; | |
99 | my ($me, $user, $pass) = @_; | |
100 | my $banner; | |
101 | my $md; | |
406c51ee | 102 | |
b3f6f6a6 RGS |
103 | if (eval { local $SIG{__DIE__}; require Digest::MD5 }) { |
104 | $md = Digest::MD5->new(); | |
105 | } | |
106 | elsif (eval { local $SIG{__DIE__}; require MD5 }) { | |
107 | $md = MD5->new(); | |
108 | } | |
109 | else { | |
110 | carp "You need to install Digest::MD5 or MD5 to use the APOP command"; | |
111 | return undef; | |
112 | } | |
113 | ||
114 | return undef | |
115 | unless ($banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0]); | |
406c51ee | 116 | |
b3f6f6a6 RGS |
117 | if (@_ <= 2) { |
118 | ($user, $pass) = $me->_lookup_credentials($user); | |
119 | } | |
406c51ee | 120 | |
b3f6f6a6 | 121 | $md->add($banner, $pass); |
406c51ee | 122 | |
b3f6f6a6 RGS |
123 | return undef |
124 | unless ($me->_APOP($user, $md->hexdigest)); | |
406c51ee | 125 | |
b3f6f6a6 | 126 | $me->_get_mailbox_count(); |
406c51ee JH |
127 | } |
128 | ||
b3f6f6a6 RGS |
129 | |
130 | sub user { | |
131 | @_ == 2 or croak 'usage: $pop3->user( USER )'; | |
132 | $_[0]->_USER($_[1]) ? 1 : undef; | |
406c51ee JH |
133 | } |
134 | ||
406c51ee | 135 | |
b3f6f6a6 RGS |
136 | sub pass { |
137 | @_ == 2 or croak 'usage: $pop3->pass( PASS )'; | |
406c51ee | 138 | |
b3f6f6a6 | 139 | my ($me, $pass) = @_; |
406c51ee | 140 | |
b3f6f6a6 RGS |
141 | return undef |
142 | unless ($me->_PASS($pass)); | |
143 | ||
144 | $me->_get_mailbox_count(); | |
406c51ee JH |
145 | } |
146 | ||
406c51ee | 147 | |
b3f6f6a6 RGS |
148 | sub reset { |
149 | @_ == 1 or croak 'usage: $obj->reset()'; | |
150 | ||
151 | my $me = shift; | |
406c51ee | 152 | |
b3f6f6a6 RGS |
153 | return 0 |
154 | unless ($me->_RSET); | |
686337f3 | 155 | |
b3f6f6a6 RGS |
156 | if (defined ${*$me}{'net_pop3_mail'}) { |
157 | local $_; | |
158 | foreach (@{${*$me}{'net_pop3_mail'}}) { | |
159 | delete $_->{'net_pop3_deleted'}; | |
406c51ee JH |
160 | } |
161 | } | |
162 | } | |
163 | ||
406c51ee | 164 | |
b3f6f6a6 RGS |
165 | sub last { |
166 | @_ == 1 or croak 'usage: $obj->last()'; | |
167 | ||
168 | return undef | |
406c51ee JH |
169 | unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/; |
170 | ||
b3f6f6a6 | 171 | return $1; |
406c51ee JH |
172 | } |
173 | ||
406c51ee | 174 | |
b3f6f6a6 RGS |
175 | sub top { |
176 | @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])'; | |
177 | my $me = shift; | |
178 | ||
179 | return undef | |
406c51ee JH |
180 | unless $me->_TOP($_[0], $_[1] || 0); |
181 | ||
b3f6f6a6 | 182 | $me->read_until_dot; |
406c51ee JH |
183 | } |
184 | ||
406c51ee | 185 | |
b3f6f6a6 RGS |
186 | sub popstat { |
187 | @_ == 1 or croak 'usage: $pop3->popstat()'; | |
188 | my $me = shift; | |
189 | ||
190 | return () | |
406c51ee JH |
191 | unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/; |
192 | ||
b3f6f6a6 | 193 | ($1 || 0, $2 || 0); |
406c51ee JH |
194 | } |
195 | ||
406c51ee | 196 | |
b3f6f6a6 RGS |
197 | sub list { |
198 | @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )'; | |
199 | my $me = shift; | |
200 | ||
201 | return undef | |
406c51ee JH |
202 | unless $me->_LIST(@_); |
203 | ||
b3f6f6a6 RGS |
204 | if (@_) { |
205 | $me->message =~ /\d+\D+(\d+)/; | |
206 | return $1 || undef; | |
406c51ee | 207 | } |
686337f3 | 208 | |
b3f6f6a6 RGS |
209 | my $info = $me->read_until_dot |
210 | or return undef; | |
406c51ee | 211 | |
b3f6f6a6 | 212 | my %hash = map { (/(\d+)\D+(\d+)/) } @$info; |
406c51ee | 213 | |
b3f6f6a6 | 214 | return \%hash; |
406c51ee JH |
215 | } |
216 | ||
406c51ee | 217 | |
b3f6f6a6 RGS |
218 | sub get { |
219 | @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])'; | |
220 | my $me = shift; | |
221 | ||
222 | return undef | |
406c51ee JH |
223 | unless $me->_RETR(shift); |
224 | ||
b3f6f6a6 | 225 | $me->read_until_dot(@_); |
406c51ee JH |
226 | } |
227 | ||
12df23ee | 228 | |
b3f6f6a6 RGS |
229 | sub getfh { |
230 | @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )'; | |
231 | my $me = shift; | |
12df23ee | 232 | |
b3f6f6a6 RGS |
233 | return unless $me->_RETR(shift); |
234 | return $me->tied_fh; | |
235 | } | |
12df23ee GB |
236 | |
237 | ||
b3f6f6a6 RGS |
238 | sub delete { |
239 | @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )'; | |
240 | my $me = shift; | |
241 | return 0 unless $me->_DELE(@_); | |
242 | ${*$me}{'net_pop3_deleted'} = 1; | |
406c51ee JH |
243 | } |
244 | ||
406c51ee | 245 | |
b3f6f6a6 RGS |
246 | sub uidl { |
247 | @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )'; | |
248 | my $me = shift; | |
249 | my $uidl; | |
250 | ||
251 | $me->_UIDL(@_) | |
252 | or return undef; | |
253 | if (@_) { | |
254 | $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0]; | |
406c51ee | 255 | } |
b3f6f6a6 RGS |
256 | else { |
257 | my $ref = $me->read_until_dot | |
258 | or return undef; | |
259 | my $ln; | |
260 | $uidl = {}; | |
261 | foreach $ln (@$ref) { | |
262 | my ($msg, $uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/; | |
263 | $uidl->{$msg} = $uid; | |
264 | } | |
406c51ee | 265 | } |
b3f6f6a6 | 266 | return $uidl; |
406c51ee JH |
267 | } |
268 | ||
406c51ee | 269 | |
b3f6f6a6 RGS |
270 | sub ping { |
271 | @_ == 2 or croak 'usage: $pop3->ping( USER )'; | |
272 | my $me = shift; | |
273 | ||
274 | return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/; | |
406c51ee | 275 | |
b3f6f6a6 | 276 | ($1 || 0, $2 || 0); |
406c51ee JH |
277 | } |
278 | ||
b3f6f6a6 RGS |
279 | |
280 | sub _lookup_credentials { | |
12df23ee GB |
281 | my ($me, $user) = @_; |
282 | ||
283 | require Net::Netrc; | |
284 | ||
b3f6f6a6 RGS |
285 | $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } |
286 | || $ENV{NAME} | |
287 | || $ENV{USER} | |
288 | || $ENV{LOGNAME}; | |
12df23ee | 289 | |
b3f6f6a6 | 290 | my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'}, $user); |
12df23ee GB |
291 | $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'}); |
292 | ||
b3f6f6a6 RGS |
293 | my $pass = $m |
294 | ? $m->password || "" | |
295 | : ""; | |
12df23ee GB |
296 | |
297 | ($user, $pass); | |
298 | } | |
299 | ||
b3f6f6a6 RGS |
300 | |
301 | sub _get_mailbox_count { | |
12df23ee | 302 | my ($me) = @_; |
b3f6f6a6 RGS |
303 | my $ret = ${*$me}{'net_pop3_count'} = |
304 | ($me->message =~ /(\d+)\s+message/io) ? $1 : ($me->popstat)[0]; | |
12df23ee GB |
305 | |
306 | $ret ? $ret : "0E0"; | |
307 | } | |
308 | ||
686337f3 | 309 | |
406c51ee | 310 | sub _STAT { shift->command('STAT')->response() == CMD_OK } |
b3f6f6a6 RGS |
311 | sub _LIST { shift->command('LIST', @_)->response() == CMD_OK } |
312 | sub _RETR { shift->command('RETR', $_[0])->response() == CMD_OK } | |
313 | sub _DELE { shift->command('DELE', $_[0])->response() == CMD_OK } | |
406c51ee JH |
314 | sub _NOOP { shift->command('NOOP')->response() == CMD_OK } |
315 | sub _RSET { shift->command('RSET')->response() == CMD_OK } | |
316 | sub _QUIT { shift->command('QUIT')->response() == CMD_OK } | |
317 | sub _TOP { shift->command('TOP', @_)->response() == CMD_OK } | |
b3f6f6a6 RGS |
318 | sub _UIDL { shift->command('UIDL', @_)->response() == CMD_OK } |
319 | sub _USER { shift->command('USER', $_[0])->response() == CMD_OK } | |
320 | sub _PASS { shift->command('PASS', $_[0])->response() == CMD_OK } | |
321 | sub _APOP { shift->command('APOP', @_)->response() == CMD_OK } | |
322 | sub _PING { shift->command('PING', $_[0])->response() == CMD_OK } | |
406c51ee | 323 | |
b3f6f6a6 RGS |
324 | |
325 | sub _RPOP { shift->command('RPOP', $_[0])->response() == CMD_OK } | |
406c51ee JH |
326 | sub _LAST { shift->command('LAST')->response() == CMD_OK } |
327 | ||
b3f6f6a6 | 328 | |
f92f3fcb GB |
329 | sub _CAPA { shift->command('CAPA')->response() == CMD_OK } |
330 | ||
406c51ee | 331 | |
b3f6f6a6 RGS |
332 | sub quit { |
333 | my $me = shift; | |
334 | ||
335 | $me->_QUIT; | |
336 | $me->close; | |
406c51ee JH |
337 | } |
338 | ||
406c51ee | 339 | |
b3f6f6a6 RGS |
340 | sub DESTROY { |
341 | my $me = shift; | |
342 | ||
343 | if (defined fileno($me) and ${*$me}{'net_pop3_deleted'}) { | |
344 | $me->reset; | |
345 | $me->quit; | |
406c51ee JH |
346 | } |
347 | } | |
348 | ||
349 | ## | |
350 | ## POP3 has weird responses, so we emulate them to look the same :-) | |
351 | ## | |
352 | ||
b3f6f6a6 | 353 | |
f92f3fcb GB |
354 | sub response { |
355 | my $cmd = shift; | |
356 | my $str = $cmd->getline() or return undef; | |
357 | my $code = "500"; | |
406c51ee | 358 | |
f92f3fcb GB |
359 | $cmd->debug_print(0, $str) |
360 | if ($cmd->debug); | |
406c51ee | 361 | |
f92f3fcb GB |
362 | if ($str =~ s/^\+OK\s*//io) { |
363 | $code = "200"; | |
406c51ee | 364 | } |
f92f3fcb GB |
365 | elsif ($str =~ s/^\+\s*//io) { |
366 | $code = "300"; | |
367 | } | |
368 | else { | |
369 | $str =~ s/^-ERR\s*//io; | |
406c51ee JH |
370 | } |
371 | ||
f92f3fcb GB |
372 | ${*$cmd}{'net_cmd_resp'} = [$str]; |
373 | ${*$cmd}{'net_cmd_code'} = $code; | |
406c51ee | 374 | |
f92f3fcb GB |
375 | substr($code, 0, 1); |
376 | } | |
377 | ||
378 | ||
379 | sub capa { | |
b3f6f6a6 RGS |
380 | my $this = shift; |
381 | my ($capa, %capabilities); | |
f92f3fcb | 382 | |
b3f6f6a6 RGS |
383 | # Fake a capability here |
384 | $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/); | |
f92f3fcb | 385 | |
b3f6f6a6 RGS |
386 | if ($this->_CAPA()) { |
387 | $capabilities{CAPA} = 1; | |
388 | $capa = $this->read_until_dot(); | |
389 | %capabilities = (%capabilities, map {/^\s*(\S+)\s*(.*)/} @$capa); | |
390 | } | |
391 | else { | |
392 | ||
393 | # Check AUTH for SASL capabilities | |
394 | if ($this->command('AUTH')->response() == CMD_OK) { | |
395 | my $mechanism = $this->read_until_dot(); | |
396 | $capabilities{SASL} = join " ", map {m/([A-Z0-9_-]+)/} @{$mechanism}; | |
7cf5cf7c | 397 | } |
b3f6f6a6 RGS |
398 | } |
399 | ||
400 | return ${*$this}{'net_pop3e_capabilities'} = \%capabilities; | |
f92f3fcb GB |
401 | } |
402 | ||
b3f6f6a6 | 403 | |
f92f3fcb | 404 | sub capabilities { |
b3f6f6a6 | 405 | my $this = shift; |
f92f3fcb | 406 | |
b3f6f6a6 | 407 | ${*$this}{'net_pop3e_capabilities'} || $this->capa; |
f92f3fcb | 408 | } |
7cf5cf7c | 409 | |
f92f3fcb | 410 | |
b3f6f6a6 RGS |
411 | sub auth { |
412 | my ($self, $username, $password) = @_; | |
413 | ||
414 | eval { | |
415 | require MIME::Base64; | |
416 | require Authen::SASL; | |
417 | } or $self->set_status(500, ["Need MIME::Base64 and Authen::SASL todo auth"]), return 0; | |
418 | ||
419 | my $capa = $self->capa; | |
420 | my $mechanisms = $capa->{SASL} || 'CRAM-MD5'; | |
421 | ||
422 | my $sasl; | |
423 | ||
424 | if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) { | |
425 | $sasl = $username; | |
426 | my $user_mech = $sasl->mechanism || ''; | |
427 | my @user_mech = split(/\s+/, $user_mech); | |
428 | my %user_mech; | |
429 | @user_mech{@user_mech} = (); | |
430 | ||
431 | my @server_mech = split(/\s+/, $mechanisms); | |
432 | my @mech = @user_mech | |
433 | ? grep { exists $user_mech{$_} } @server_mech | |
434 | : @server_mech; | |
435 | unless (@mech) { | |
436 | $self->set_status( | |
437 | 500, | |
438 | [ 'Client SASL mechanisms (', | |
439 | join(', ', @user_mech), | |
440 | ') do not match the SASL mechnism the server announces (', | |
441 | join(', ', @server_mech), ')', | |
442 | ] | |
443 | ); | |
7cf5cf7c SP |
444 | return 0; |
445 | } | |
b3f6f6a6 RGS |
446 | |
447 | $sasl->mechanism(join(" ", @mech)); | |
448 | } | |
449 | else { | |
450 | die "auth(username, password)" if not length $username; | |
451 | $sasl = Authen::SASL->new( | |
452 | mechanism => $mechanisms, | |
453 | callback => { | |
454 | user => $username, | |
455 | pass => $password, | |
456 | authname => $username, | |
457 | } | |
458 | ); | |
459 | } | |
460 | ||
461 | # We should probably allow the user to pass the host, but I don't | |
462 | # currently know and SASL mechanisms that are used by smtp that need it | |
463 | my ($hostname) = split /:/, ${*$self}{'net_pop3_host'}; | |
464 | my $client = eval { $sasl->client_new('pop', $hostname, 0) }; | |
465 | ||
466 | unless ($client) { | |
467 | my $mech = $sasl->mechanism; | |
468 | $self->set_status( | |
469 | 500, | |
470 | [ " Authen::SASL failure: $@", | |
471 | '(please check if your local Authen::SASL installation', | |
472 | "supports mechanism '$mech'" | |
473 | ] | |
474 | ); | |
475 | return 0; | |
476 | } | |
477 | ||
478 | my ($token) = $client->client_start | |
479 | or do { | |
480 | my $mech = $client->mechanism; | |
481 | $self->set_status( | |
482 | 500, | |
483 | [ ' Authen::SASL failure: $client->client_start ', | |
484 | "mechanism '$mech' hostname #$hostname#", | |
485 | $client->error | |
486 | ] | |
487 | ); | |
488 | return 0; | |
489 | }; | |
490 | ||
491 | # We dont support sasl mechanisms that encrypt the socket traffic. | |
492 | # todo that we would really need to change the ISA hierarchy | |
493 | # so we dont inherit from IO::Socket, but instead hold it in an attribute | |
494 | ||
495 | my @cmd = ("AUTH", $client->mechanism); | |
496 | my $code; | |
497 | ||
498 | push @cmd, MIME::Base64::encode_base64($token, '') | |
499 | if defined $token and length $token; | |
500 | ||
501 | while (($code = $self->command(@cmd)->response()) == CMD_MORE) { | |
502 | ||
503 | my ($token) = $client->client_step(MIME::Base64::decode_base64(($self->message)[0])) or do { | |
504 | $self->set_status( | |
505 | 500, | |
506 | [ ' Authen::SASL failure: $client->client_step ', | |
507 | "mechanism '", $client->mechanism, " hostname #$hostname#, ", | |
7cf5cf7c | 508 | $client->error |
b3f6f6a6 | 509 | ] |
7cf5cf7c | 510 | ); |
b3f6f6a6 RGS |
511 | return 0; |
512 | }; | |
513 | ||
514 | @cmd = (MIME::Base64::encode_base64(defined $token ? $token : '', '')); | |
515 | } | |
f92f3fcb | 516 | |
b3f6f6a6 | 517 | $code == CMD_OK; |
f92f3fcb GB |
518 | } |
519 | ||
b3f6f6a6 | 520 | |
f92f3fcb | 521 | sub banner { |
b3f6f6a6 | 522 | my $this = shift; |
f92f3fcb | 523 | |
b3f6f6a6 | 524 | return ${*$this}{'net_pop3_banner'}; |
406c51ee JH |
525 | } |
526 | ||
527 | 1; | |
528 | ||
529 | __END__ | |
530 | ||
531 | =head1 NAME | |
532 | ||
12df23ee | 533 | Net::POP3 - Post Office Protocol 3 Client class (RFC1939) |
406c51ee JH |
534 | |
535 | =head1 SYNOPSIS | |
536 | ||
537 | use Net::POP3; | |
686337f3 | 538 | |
406c51ee JH |
539 | # Constructors |
540 | $pop = Net::POP3->new('pop3host'); | |
541 | $pop = Net::POP3->new('pop3host', Timeout => 60); | |
542 | ||
dea4d7df GB |
543 | if ($pop->login($username, $password) > 0) { |
544 | my $msgnums = $pop->list; # hashref of msgnum => size | |
545 | foreach my $msgnum (keys %$msgnums) { | |
546 | my $msg = $pop->get($msgnum); | |
547 | print @$msg; | |
548 | $pop->delete($msgnum); | |
549 | } | |
550 | } | |
551 | ||
552 | $pop->quit; | |
553 | ||
406c51ee JH |
554 | =head1 DESCRIPTION |
555 | ||
556 | This module implements a client interface to the POP3 protocol, enabling | |
557 | a perl5 application to talk to POP3 servers. This documentation assumes | |
12df23ee | 558 | that you are familiar with the POP3 protocol described in RFC1939. |
406c51ee JH |
559 | |
560 | A new Net::POP3 object must be created with the I<new> method. Once | |
561 | this has been done, all POP3 commands are accessed via method calls | |
562 | on the object. | |
563 | ||
406c51ee JH |
564 | =head1 CONSTRUCTOR |
565 | ||
566 | =over 4 | |
567 | ||
f92f3fcb | 568 | =item new ( [ HOST ] [, OPTIONS ] 0 |
406c51ee JH |
569 | |
570 | This is the constructor for a new Net::POP3 object. C<HOST> is the | |
f92f3fcb | 571 | name of the remote host to which an POP3 connection is required. |
406c51ee | 572 | |
f92f3fcb GB |
573 | C<HOST> is optional. If C<HOST> is not given then it may instead be |
574 | passed as the C<Host> option described below. If neither is given then | |
575 | the C<POP3_Hosts> specified in C<Net::Config> will be used. | |
406c51ee JH |
576 | |
577 | C<OPTIONS> are passed in a hash like fashion, using key and value pairs. | |
578 | Possible options are: | |
579 | ||
f92f3fcb GB |
580 | B<Host> - POP3 host to connect to. It may be a single scalar, as defined for |
581 | the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to | |
582 | an array with hosts to try in turn. The L</host> method will return the value | |
583 | which was used to connect to the host. | |
584 | ||
406c51ee JH |
585 | B<ResvPort> - If given then the socket for the C<Net::POP3> object |
586 | will be bound to the local port given using C<bind> when the socket is | |
587 | created. | |
588 | ||
589 | B<Timeout> - Maximum time, in seconds, to wait for a response from the | |
590 | POP3 server (default: 120) | |
591 | ||
592 | B<Debug> - Enable debugging information | |
593 | ||
594 | =back | |
595 | ||
596 | =head1 METHODS | |
597 | ||
598 | Unless otherwise stated all methods return either a I<true> or I<false> | |
599 | value, with I<true> meaning that the operation was a success. When a method | |
600 | states that it returns a value, failure will be returned as I<undef> or an | |
601 | empty list. | |
602 | ||
603 | =over 4 | |
604 | ||
f92f3fcb GB |
605 | =item auth ( USERNAME, PASSWORD ) |
606 | ||
607 | Attempt SASL authentication. | |
608 | ||
406c51ee JH |
609 | =item user ( USER ) |
610 | ||
611 | Send the USER command. | |
612 | ||
613 | =item pass ( PASS ) | |
614 | ||
615 | Send the PASS command. Returns the number of messages in the mailbox. | |
616 | ||
617 | =item login ( [ USER [, PASS ]] ) | |
618 | ||
d1be9408 | 619 | Send both the USER and PASS commands. If C<PASS> is not given the |
406c51ee JH |
620 | C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host |
621 | and username. If the username is not specified then the current user name | |
622 | will be used. | |
623 | ||
624 | Returns the number of messages in the mailbox. However if there are no | |
625 | messages on the server the string C<"0E0"> will be returned. This is | |
626 | will give a true value in a boolean context, but zero in a numeric context. | |
627 | ||
628 | If there was an error authenticating the user then I<undef> will be returned. | |
629 | ||
12df23ee | 630 | =item apop ( [ USER [, PASS ]] ) |
406c51ee JH |
631 | |
632 | Authenticate with the server identifying as C<USER> with password C<PASS>. | |
12df23ee | 633 | Similar to L</login>, but the password is not sent in clear text. |
406c51ee | 634 | |
12df23ee GB |
635 | To use this method you must have the Digest::MD5 or the MD5 module installed, |
636 | otherwise this method will return I<undef>. | |
406c51ee | 637 | |
f92f3fcb GB |
638 | =item banner () |
639 | ||
640 | Return the sever's connection banner | |
641 | ||
642 | =item capa () | |
643 | ||
3c4b39be | 644 | Return a reference to a hash of the capabilities of the server. APOP |
f92f3fcb GB |
645 | is added as a pseudo capability. Note that I've been unable to |
646 | find a list of the standard capability values, and some appear to | |
647 | be multi-word and some are not. We make an attempt at intelligently | |
648 | parsing them, but it may not be correct. | |
649 | ||
650 | =item capabilities () | |
651 | ||
652 | Just like capa, but only uses a cache from the last time we asked | |
653 | the server, so as to avoid asking more than once. | |
654 | ||
406c51ee JH |
655 | =item top ( MSGNUM [, NUMLINES ] ) |
656 | ||
657 | Get the header and the first C<NUMLINES> of the body for the message | |
658 | C<MSGNUM>. Returns a reference to an array which contains the lines of text | |
659 | read from the server. | |
660 | ||
661 | =item list ( [ MSGNUM ] ) | |
662 | ||
663 | If called with an argument the C<list> returns the size of the message | |
664 | in octets. | |
665 | ||
666 | If called without arguments a reference to a hash is returned. The | |
667 | keys will be the C<MSGNUM>'s of all undeleted messages and the values will | |
668 | be their size in octets. | |
669 | ||
670 | =item get ( MSGNUM [, FH ] ) | |
671 | ||
672 | Get the message C<MSGNUM> from the remote mailbox. If C<FH> is not given | |
673 | then get returns a reference to an array which contains the lines of | |
674 | text read from the server. If C<FH> is given then the lines returned | |
675 | from the server are printed to the filehandle C<FH>. | |
676 | ||
12df23ee GB |
677 | =item getfh ( MSGNUM ) |
678 | ||
679 | As per get(), but returns a tied filehandle. Reading from this | |
680 | filehandle returns the requested message. The filehandle will return | |
681 | EOF at the end of the message and should not be reused. | |
682 | ||
406c51ee JH |
683 | =item last () |
684 | ||
685 | Returns the highest C<MSGNUM> of all the messages accessed. | |
686 | ||
687 | =item popstat () | |
688 | ||
689 | Returns a list of two elements. These are the number of undeleted | |
690 | elements and the size of the mbox in octets. | |
691 | ||
692 | =item ping ( USER ) | |
693 | ||
694 | Returns a list of two elements. These are the number of new messages | |
695 | and the total number of messages for C<USER>. | |
696 | ||
697 | =item uidl ( [ MSGNUM ] ) | |
698 | ||
699 | Returns a unique identifier for C<MSGNUM> if given. If C<MSGNUM> is not | |
700 | given C<uidl> returns a reference to a hash where the keys are the | |
701 | message numbers and the values are the unique identifiers. | |
702 | ||
703 | =item delete ( MSGNUM ) | |
704 | ||
705 | Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages | |
706 | that are marked to be deleted will be removed from the remote mailbox | |
707 | when the server connection closed. | |
708 | ||
709 | =item reset () | |
710 | ||
3c4b39be | 711 | Reset the status of the remote POP3 server. This includes resetting the |
406c51ee JH |
712 | status of all messages to not be deleted. |
713 | ||
714 | =item quit () | |
715 | ||
716 | Quit and close the connection to the remote POP3 server. Any messages marked | |
717 | as deleted will be deleted from the remote mailbox. | |
718 | ||
719 | =back | |
720 | ||
721 | =head1 NOTES | |
722 | ||
723 | If a C<Net::POP3> object goes out of scope before C<quit> method is called | |
724 | then the C<reset> method will called before the connection is closed. This | |
725 | means that any messages marked to be deleted will not be. | |
726 | ||
727 | =head1 SEE ALSO | |
728 | ||
12df23ee | 729 | L<Net::Netrc>, |
406c51ee JH |
730 | L<Net::Cmd> |
731 | ||
732 | =head1 AUTHOR | |
733 | ||
734 | Graham Barr <gbarr@pobox.com> | |
735 | ||
736 | =head1 COPYRIGHT | |
737 | ||
f92f3fcb | 738 | Copyright (c) 1995-2003 Graham Barr. All rights reserved. |
406c51ee JH |
739 | This program is free software; you can redistribute it and/or modify |
740 | it under the same terms as Perl itself. | |
741 | ||
742 | =cut |