1*b8851fccSafresh1# Net::POP3.pm 2*b8851fccSafresh1# 3*b8851fccSafresh1# Versions up to 2.29 Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. 4*b8851fccSafresh1# All rights reserved. 5*b8851fccSafresh1# Changes in Version 2.29_01 onwards Copyright (C) 2013-2015 Steve Hay. All 6*b8851fccSafresh1# rights reserved. 7*b8851fccSafresh1# This module is free software; you can redistribute it and/or modify it under 8*b8851fccSafresh1# the same terms as Perl itself, i.e. under the terms of either the GNU General 9*b8851fccSafresh1# Public License or the Artistic License, as specified in the F<LICENCE> file. 10*b8851fccSafresh1 11*b8851fccSafresh1package Net::POP3; 12*b8851fccSafresh1 13*b8851fccSafresh1use 5.008001; 14*b8851fccSafresh1 15*b8851fccSafresh1use strict; 16*b8851fccSafresh1use warnings; 17*b8851fccSafresh1 18*b8851fccSafresh1use Carp; 19*b8851fccSafresh1use IO::Socket; 20*b8851fccSafresh1use Net::Cmd; 21*b8851fccSafresh1use Net::Config; 22*b8851fccSafresh1 23*b8851fccSafresh1our $VERSION = "3.08_01"; 24*b8851fccSafresh1 25*b8851fccSafresh1# Code for detecting if we can use SSL 26*b8851fccSafresh1my $ssl_class = eval { 27*b8851fccSafresh1 require IO::Socket::SSL; 28*b8851fccSafresh1 # first version with default CA on most platforms 29*b8851fccSafresh1 no warnings 'numeric'; 30*b8851fccSafresh1 IO::Socket::SSL->VERSION(2.007); 31*b8851fccSafresh1} && 'IO::Socket::SSL'; 32*b8851fccSafresh1 33*b8851fccSafresh1my $nossl_warn = !$ssl_class && 34*b8851fccSafresh1 'To use SSL please install IO::Socket::SSL with version>=2.007'; 35*b8851fccSafresh1 36*b8851fccSafresh1# Code for detecting if we can use IPv6 37*b8851fccSafresh1my $family_key = 'Domain'; 38*b8851fccSafresh1my $inet6_class = eval { 39*b8851fccSafresh1 require IO::Socket::IP; 40*b8851fccSafresh1 no warnings 'numeric'; 41*b8851fccSafresh1 IO::Socket::IP->VERSION(0.20) || die; 42*b8851fccSafresh1 $family_key = 'Family'; 43*b8851fccSafresh1} && 'IO::Socket::IP' || eval { 44*b8851fccSafresh1 require IO::Socket::INET6; 45*b8851fccSafresh1 no warnings 'numeric'; 46*b8851fccSafresh1 IO::Socket::INET6->VERSION(2.62); 47*b8851fccSafresh1} && 'IO::Socket::INET6'; 48*b8851fccSafresh1 49*b8851fccSafresh1 50*b8851fccSafresh1sub can_ssl { $ssl_class }; 51*b8851fccSafresh1sub can_inet6 { $inet6_class }; 52*b8851fccSafresh1 53*b8851fccSafresh1our @ISA = ('Net::Cmd', $inet6_class || 'IO::Socket::INET'); 54*b8851fccSafresh1 55*b8851fccSafresh1sub new { 56*b8851fccSafresh1 my $self = shift; 57*b8851fccSafresh1 my $type = ref($self) || $self; 58*b8851fccSafresh1 my ($host, %arg); 59*b8851fccSafresh1 if (@_ % 2) { 60*b8851fccSafresh1 $host = shift; 61*b8851fccSafresh1 %arg = @_; 62*b8851fccSafresh1 } 63*b8851fccSafresh1 else { 64*b8851fccSafresh1 %arg = @_; 65*b8851fccSafresh1 $host = delete $arg{Host}; 66*b8851fccSafresh1 } 67*b8851fccSafresh1 my $hosts = defined $host ? [$host] : $NetConfig{pop3_hosts}; 68*b8851fccSafresh1 my $obj; 69*b8851fccSafresh1 70*b8851fccSafresh1 if ($arg{SSL}) { 71*b8851fccSafresh1 # SSL from start 72*b8851fccSafresh1 die $nossl_warn if !$ssl_class; 73*b8851fccSafresh1 $arg{Port} ||= 995; 74*b8851fccSafresh1 } 75*b8851fccSafresh1 76*b8851fccSafresh1 $arg{Timeout} = 120 if ! defined $arg{Timeout}; 77*b8851fccSafresh1 78*b8851fccSafresh1 foreach my $h (@{$hosts}) { 79*b8851fccSafresh1 $obj = $type->SUPER::new( 80*b8851fccSafresh1 PeerAddr => ($host = $h), 81*b8851fccSafresh1 PeerPort => $arg{Port} || 'pop3(110)', 82*b8851fccSafresh1 Proto => 'tcp', 83*b8851fccSafresh1 $family_key => $arg{Domain} || $arg{Family}, 84*b8851fccSafresh1 LocalAddr => $arg{LocalAddr}, 85*b8851fccSafresh1 LocalPort => exists($arg{ResvPort}) ? $arg{ResvPort} : $arg{LocalPort}, 86*b8851fccSafresh1 Timeout => $arg{Timeout}, 87*b8851fccSafresh1 ) 88*b8851fccSafresh1 and last; 89*b8851fccSafresh1 } 90*b8851fccSafresh1 91*b8851fccSafresh1 return 92*b8851fccSafresh1 unless defined $obj; 93*b8851fccSafresh1 94*b8851fccSafresh1 ${*$obj}{'net_pop3_arg'} = \%arg; 95*b8851fccSafresh1 ${*$obj}{'net_pop3_host'} = $host; 96*b8851fccSafresh1 if ($arg{SSL}) { 97*b8851fccSafresh1 Net::POP3::_SSL->start_SSL($obj,%arg) or return; 98*b8851fccSafresh1 } 99*b8851fccSafresh1 100*b8851fccSafresh1 $obj->autoflush(1); 101*b8851fccSafresh1 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); 102*b8851fccSafresh1 103*b8851fccSafresh1 unless ($obj->response() == CMD_OK) { 104*b8851fccSafresh1 $obj->close(); 105*b8851fccSafresh1 return; 106*b8851fccSafresh1 } 107*b8851fccSafresh1 108*b8851fccSafresh1 ${*$obj}{'net_pop3_banner'} = $obj->message; 109*b8851fccSafresh1 110*b8851fccSafresh1 $obj; 111*b8851fccSafresh1} 112*b8851fccSafresh1 113*b8851fccSafresh1 114*b8851fccSafresh1sub host { 115*b8851fccSafresh1 my $me = shift; 116*b8851fccSafresh1 ${*$me}{'net_pop3_host'}; 117*b8851fccSafresh1} 118*b8851fccSafresh1 119*b8851fccSafresh1## 120*b8851fccSafresh1## We don't want people sending me their passwords when they report problems 121*b8851fccSafresh1## now do we :-) 122*b8851fccSafresh1## 123*b8851fccSafresh1 124*b8851fccSafresh1 125*b8851fccSafresh1sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; } 126*b8851fccSafresh1 127*b8851fccSafresh1 128*b8851fccSafresh1sub login { 129*b8851fccSafresh1 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )'; 130*b8851fccSafresh1 my ($me, $user, $pass) = @_; 131*b8851fccSafresh1 132*b8851fccSafresh1 if (@_ <= 2) { 133*b8851fccSafresh1 ($user, $pass) = $me->_lookup_credentials($user); 134*b8851fccSafresh1 } 135*b8851fccSafresh1 136*b8851fccSafresh1 $me->user($user) 137*b8851fccSafresh1 and $me->pass($pass); 138*b8851fccSafresh1} 139*b8851fccSafresh1 140*b8851fccSafresh1sub starttls { 141*b8851fccSafresh1 my $self = shift; 142*b8851fccSafresh1 $ssl_class or die $nossl_warn; 143*b8851fccSafresh1 $self->_STLS or return; 144*b8851fccSafresh1 Net::POP3::_SSL->start_SSL($self, 145*b8851fccSafresh1 %{ ${*$self}{'net_pop3_arg'} }, # (ssl) args given in new 146*b8851fccSafresh1 @_ # more (ssl) args 147*b8851fccSafresh1 ) or return; 148*b8851fccSafresh1 return 1; 149*b8851fccSafresh1} 150*b8851fccSafresh1 151*b8851fccSafresh1sub apop { 152*b8851fccSafresh1 @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )'; 153*b8851fccSafresh1 my ($me, $user, $pass) = @_; 154*b8851fccSafresh1 my $banner; 155*b8851fccSafresh1 my $md; 156*b8851fccSafresh1 157*b8851fccSafresh1 if (eval { local $SIG{__DIE__}; require Digest::MD5 }) { 158*b8851fccSafresh1 $md = Digest::MD5->new(); 159*b8851fccSafresh1 } 160*b8851fccSafresh1 elsif (eval { local $SIG{__DIE__}; require MD5 }) { 161*b8851fccSafresh1 $md = MD5->new(); 162*b8851fccSafresh1 } 163*b8851fccSafresh1 else { 164*b8851fccSafresh1 carp "You need to install Digest::MD5 or MD5 to use the APOP command"; 165*b8851fccSafresh1 return; 166*b8851fccSafresh1 } 167*b8851fccSafresh1 168*b8851fccSafresh1 return 169*b8851fccSafresh1 unless ($banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0]); 170*b8851fccSafresh1 171*b8851fccSafresh1 if (@_ <= 2) { 172*b8851fccSafresh1 ($user, $pass) = $me->_lookup_credentials($user); 173*b8851fccSafresh1 } 174*b8851fccSafresh1 175*b8851fccSafresh1 $md->add($banner, $pass); 176*b8851fccSafresh1 177*b8851fccSafresh1 return 178*b8851fccSafresh1 unless ($me->_APOP($user, $md->hexdigest)); 179*b8851fccSafresh1 180*b8851fccSafresh1 $me->_get_mailbox_count(); 181*b8851fccSafresh1} 182*b8851fccSafresh1 183*b8851fccSafresh1 184*b8851fccSafresh1sub user { 185*b8851fccSafresh1 @_ == 2 or croak 'usage: $pop3->user( USER )'; 186*b8851fccSafresh1 $_[0]->_USER($_[1]) ? 1 : undef; 187*b8851fccSafresh1} 188*b8851fccSafresh1 189*b8851fccSafresh1 190*b8851fccSafresh1sub pass { 191*b8851fccSafresh1 @_ == 2 or croak 'usage: $pop3->pass( PASS )'; 192*b8851fccSafresh1 193*b8851fccSafresh1 my ($me, $pass) = @_; 194*b8851fccSafresh1 195*b8851fccSafresh1 return 196*b8851fccSafresh1 unless ($me->_PASS($pass)); 197*b8851fccSafresh1 198*b8851fccSafresh1 $me->_get_mailbox_count(); 199*b8851fccSafresh1} 200*b8851fccSafresh1 201*b8851fccSafresh1 202*b8851fccSafresh1sub reset { 203*b8851fccSafresh1 @_ == 1 or croak 'usage: $obj->reset()'; 204*b8851fccSafresh1 205*b8851fccSafresh1 my $me = shift; 206*b8851fccSafresh1 207*b8851fccSafresh1 return 0 208*b8851fccSafresh1 unless ($me->_RSET); 209*b8851fccSafresh1 210*b8851fccSafresh1 if (defined ${*$me}{'net_pop3_mail'}) { 211*b8851fccSafresh1 local $_; 212*b8851fccSafresh1 foreach (@{${*$me}{'net_pop3_mail'}}) { 213*b8851fccSafresh1 delete $_->{'net_pop3_deleted'}; 214*b8851fccSafresh1 } 215*b8851fccSafresh1 } 216*b8851fccSafresh1} 217*b8851fccSafresh1 218*b8851fccSafresh1 219*b8851fccSafresh1sub last { 220*b8851fccSafresh1 @_ == 1 or croak 'usage: $obj->last()'; 221*b8851fccSafresh1 222*b8851fccSafresh1 return 223*b8851fccSafresh1 unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/; 224*b8851fccSafresh1 225*b8851fccSafresh1 return $1; 226*b8851fccSafresh1} 227*b8851fccSafresh1 228*b8851fccSafresh1 229*b8851fccSafresh1sub top { 230*b8851fccSafresh1 @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])'; 231*b8851fccSafresh1 my $me = shift; 232*b8851fccSafresh1 233*b8851fccSafresh1 return 234*b8851fccSafresh1 unless $me->_TOP($_[0], $_[1] || 0); 235*b8851fccSafresh1 236*b8851fccSafresh1 $me->read_until_dot; 237*b8851fccSafresh1} 238*b8851fccSafresh1 239*b8851fccSafresh1 240*b8851fccSafresh1sub popstat { 241*b8851fccSafresh1 @_ == 1 or croak 'usage: $pop3->popstat()'; 242*b8851fccSafresh1 my $me = shift; 243*b8851fccSafresh1 244*b8851fccSafresh1 return () 245*b8851fccSafresh1 unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/; 246*b8851fccSafresh1 247*b8851fccSafresh1 ($1 || 0, $2 || 0); 248*b8851fccSafresh1} 249*b8851fccSafresh1 250*b8851fccSafresh1 251*b8851fccSafresh1sub list { 252*b8851fccSafresh1 @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )'; 253*b8851fccSafresh1 my $me = shift; 254*b8851fccSafresh1 255*b8851fccSafresh1 return 256*b8851fccSafresh1 unless $me->_LIST(@_); 257*b8851fccSafresh1 258*b8851fccSafresh1 if (@_) { 259*b8851fccSafresh1 $me->message =~ /\d+\D+(\d+)/; 260*b8851fccSafresh1 return $1 || undef; 261*b8851fccSafresh1 } 262*b8851fccSafresh1 263*b8851fccSafresh1 my $info = $me->read_until_dot 264*b8851fccSafresh1 or return; 265*b8851fccSafresh1 266*b8851fccSafresh1 my %hash = map { (/(\d+)\D+(\d+)/) } @$info; 267*b8851fccSafresh1 268*b8851fccSafresh1 return \%hash; 269*b8851fccSafresh1} 270*b8851fccSafresh1 271*b8851fccSafresh1 272*b8851fccSafresh1sub get { 273*b8851fccSafresh1 @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])'; 274*b8851fccSafresh1 my $me = shift; 275*b8851fccSafresh1 276*b8851fccSafresh1 return 277*b8851fccSafresh1 unless $me->_RETR(shift); 278*b8851fccSafresh1 279*b8851fccSafresh1 $me->read_until_dot(@_); 280*b8851fccSafresh1} 281*b8851fccSafresh1 282*b8851fccSafresh1 283*b8851fccSafresh1sub getfh { 284*b8851fccSafresh1 @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )'; 285*b8851fccSafresh1 my $me = shift; 286*b8851fccSafresh1 287*b8851fccSafresh1 return unless $me->_RETR(shift); 288*b8851fccSafresh1 return $me->tied_fh; 289*b8851fccSafresh1} 290*b8851fccSafresh1 291*b8851fccSafresh1 292*b8851fccSafresh1sub delete { 293*b8851fccSafresh1 @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )'; 294*b8851fccSafresh1 my $me = shift; 295*b8851fccSafresh1 return 0 unless $me->_DELE(@_); 296*b8851fccSafresh1 ${*$me}{'net_pop3_deleted'} = 1; 297*b8851fccSafresh1} 298*b8851fccSafresh1 299*b8851fccSafresh1 300*b8851fccSafresh1sub uidl { 301*b8851fccSafresh1 @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )'; 302*b8851fccSafresh1 my $me = shift; 303*b8851fccSafresh1 my $uidl; 304*b8851fccSafresh1 305*b8851fccSafresh1 $me->_UIDL(@_) 306*b8851fccSafresh1 or return; 307*b8851fccSafresh1 if (@_) { 308*b8851fccSafresh1 $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0]; 309*b8851fccSafresh1 } 310*b8851fccSafresh1 else { 311*b8851fccSafresh1 my $ref = $me->read_until_dot 312*b8851fccSafresh1 or return; 313*b8851fccSafresh1 $uidl = {}; 314*b8851fccSafresh1 foreach my $ln (@$ref) { 315*b8851fccSafresh1 my ($msg, $uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/; 316*b8851fccSafresh1 $uidl->{$msg} = $uid; 317*b8851fccSafresh1 } 318*b8851fccSafresh1 } 319*b8851fccSafresh1 return $uidl; 320*b8851fccSafresh1} 321*b8851fccSafresh1 322*b8851fccSafresh1 323*b8851fccSafresh1sub ping { 324*b8851fccSafresh1 @_ == 2 or croak 'usage: $pop3->ping( USER )'; 325*b8851fccSafresh1 my $me = shift; 326*b8851fccSafresh1 327*b8851fccSafresh1 return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/; 328*b8851fccSafresh1 329*b8851fccSafresh1 ($1 || 0, $2 || 0); 330*b8851fccSafresh1} 331*b8851fccSafresh1 332*b8851fccSafresh1 333*b8851fccSafresh1sub _lookup_credentials { 334*b8851fccSafresh1 my ($me, $user) = @_; 335*b8851fccSafresh1 336*b8851fccSafresh1 require Net::Netrc; 337*b8851fccSafresh1 338*b8851fccSafresh1 $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } 339*b8851fccSafresh1 || $ENV{NAME} 340*b8851fccSafresh1 || $ENV{USER} 341*b8851fccSafresh1 || $ENV{LOGNAME}; 342*b8851fccSafresh1 343*b8851fccSafresh1 my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'}, $user); 344*b8851fccSafresh1 $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'}); 345*b8851fccSafresh1 346*b8851fccSafresh1 my $pass = $m 347*b8851fccSafresh1 ? $m->password || "" 348*b8851fccSafresh1 : ""; 349*b8851fccSafresh1 350*b8851fccSafresh1 ($user, $pass); 351*b8851fccSafresh1} 352*b8851fccSafresh1 353*b8851fccSafresh1 354*b8851fccSafresh1sub _get_mailbox_count { 355*b8851fccSafresh1 my ($me) = @_; 356*b8851fccSafresh1 my $ret = ${*$me}{'net_pop3_count'} = 357*b8851fccSafresh1 ($me->message =~ /(\d+)\s+message/io) ? $1 : ($me->popstat)[0]; 358*b8851fccSafresh1 359*b8851fccSafresh1 $ret ? $ret : "0E0"; 360*b8851fccSafresh1} 361*b8851fccSafresh1 362*b8851fccSafresh1 363*b8851fccSafresh1sub _STAT { shift->command('STAT' )->response() == CMD_OK } 364*b8851fccSafresh1sub _LIST { shift->command('LIST', @_)->response() == CMD_OK } 365*b8851fccSafresh1sub _RETR { shift->command('RETR', $_[0])->response() == CMD_OK } 366*b8851fccSafresh1sub _DELE { shift->command('DELE', $_[0])->response() == CMD_OK } 367*b8851fccSafresh1sub _NOOP { shift->command('NOOP' )->response() == CMD_OK } 368*b8851fccSafresh1sub _RSET { shift->command('RSET' )->response() == CMD_OK } 369*b8851fccSafresh1sub _QUIT { shift->command('QUIT' )->response() == CMD_OK } 370*b8851fccSafresh1sub _TOP { shift->command( 'TOP', @_)->response() == CMD_OK } 371*b8851fccSafresh1sub _UIDL { shift->command('UIDL', @_)->response() == CMD_OK } 372*b8851fccSafresh1sub _USER { shift->command('USER', $_[0])->response() == CMD_OK } 373*b8851fccSafresh1sub _PASS { shift->command('PASS', $_[0])->response() == CMD_OK } 374*b8851fccSafresh1sub _APOP { shift->command('APOP', @_)->response() == CMD_OK } 375*b8851fccSafresh1sub _PING { shift->command('PING', $_[0])->response() == CMD_OK } 376*b8851fccSafresh1sub _RPOP { shift->command('RPOP', $_[0])->response() == CMD_OK } 377*b8851fccSafresh1sub _LAST { shift->command('LAST' )->response() == CMD_OK } 378*b8851fccSafresh1sub _CAPA { shift->command('CAPA' )->response() == CMD_OK } 379*b8851fccSafresh1sub _STLS { shift->command("STLS", )->response() == CMD_OK } 380*b8851fccSafresh1 381*b8851fccSafresh1 382*b8851fccSafresh1sub quit { 383*b8851fccSafresh1 my $me = shift; 384*b8851fccSafresh1 385*b8851fccSafresh1 $me->_QUIT; 386*b8851fccSafresh1 $me->close; 387*b8851fccSafresh1} 388*b8851fccSafresh1 389*b8851fccSafresh1 390*b8851fccSafresh1sub DESTROY { 391*b8851fccSafresh1 my $me = shift; 392*b8851fccSafresh1 393*b8851fccSafresh1 if (defined fileno($me) and ${*$me}{'net_pop3_deleted'}) { 394*b8851fccSafresh1 $me->reset; 395*b8851fccSafresh1 $me->quit; 396*b8851fccSafresh1 } 397*b8851fccSafresh1} 398*b8851fccSafresh1 399*b8851fccSafresh1## 400*b8851fccSafresh1## POP3 has weird responses, so we emulate them to look the same :-) 401*b8851fccSafresh1## 402*b8851fccSafresh1 403*b8851fccSafresh1 404*b8851fccSafresh1sub response { 405*b8851fccSafresh1 my $cmd = shift; 406*b8851fccSafresh1 my $str = $cmd->getline() or return; 407*b8851fccSafresh1 my $code = "500"; 408*b8851fccSafresh1 409*b8851fccSafresh1 $cmd->debug_print(0, $str) 410*b8851fccSafresh1 if ($cmd->debug); 411*b8851fccSafresh1 412*b8851fccSafresh1 if ($str =~ s/^\+OK\s*//io) { 413*b8851fccSafresh1 $code = "200"; 414*b8851fccSafresh1 } 415*b8851fccSafresh1 elsif ($str =~ s/^\+\s*//io) { 416*b8851fccSafresh1 $code = "300"; 417*b8851fccSafresh1 } 418*b8851fccSafresh1 else { 419*b8851fccSafresh1 $str =~ s/^-ERR\s*//io; 420*b8851fccSafresh1 } 421*b8851fccSafresh1 422*b8851fccSafresh1 ${*$cmd}{'net_cmd_resp'} = [$str]; 423*b8851fccSafresh1 ${*$cmd}{'net_cmd_code'} = $code; 424*b8851fccSafresh1 425*b8851fccSafresh1 substr($code, 0, 1); 426*b8851fccSafresh1} 427*b8851fccSafresh1 428*b8851fccSafresh1 429*b8851fccSafresh1sub capa { 430*b8851fccSafresh1 my $this = shift; 431*b8851fccSafresh1 my ($capa, %capabilities); 432*b8851fccSafresh1 433*b8851fccSafresh1 # Fake a capability here 434*b8851fccSafresh1 $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/); 435*b8851fccSafresh1 436*b8851fccSafresh1 if ($this->_CAPA()) { 437*b8851fccSafresh1 $capabilities{CAPA} = 1; 438*b8851fccSafresh1 $capa = $this->read_until_dot(); 439*b8851fccSafresh1 %capabilities = (%capabilities, map {/^\s*(\S+)\s*(.*)/} @$capa); 440*b8851fccSafresh1 } 441*b8851fccSafresh1 else { 442*b8851fccSafresh1 443*b8851fccSafresh1 # Check AUTH for SASL capabilities 444*b8851fccSafresh1 if ($this->command('AUTH')->response() == CMD_OK) { 445*b8851fccSafresh1 my $mechanism = $this->read_until_dot(); 446*b8851fccSafresh1 $capabilities{SASL} = join " ", map {m/([A-Z0-9_-]+)/} @{$mechanism}; 447*b8851fccSafresh1 } 448*b8851fccSafresh1 } 449*b8851fccSafresh1 450*b8851fccSafresh1 return ${*$this}{'net_pop3e_capabilities'} = \%capabilities; 451*b8851fccSafresh1} 452*b8851fccSafresh1 453*b8851fccSafresh1 454*b8851fccSafresh1sub capabilities { 455*b8851fccSafresh1 my $this = shift; 456*b8851fccSafresh1 457*b8851fccSafresh1 ${*$this}{'net_pop3e_capabilities'} || $this->capa; 458*b8851fccSafresh1} 459*b8851fccSafresh1 460*b8851fccSafresh1 461*b8851fccSafresh1sub auth { 462*b8851fccSafresh1 my ($self, $username, $password) = @_; 463*b8851fccSafresh1 464*b8851fccSafresh1 eval { 465*b8851fccSafresh1 require MIME::Base64; 466*b8851fccSafresh1 require Authen::SASL; 467*b8851fccSafresh1 } or $self->set_status(500, ["Need MIME::Base64 and Authen::SASL todo auth"]), return 0; 468*b8851fccSafresh1 469*b8851fccSafresh1 my $capa = $self->capa; 470*b8851fccSafresh1 my $mechanisms = $capa->{SASL} || 'CRAM-MD5'; 471*b8851fccSafresh1 472*b8851fccSafresh1 my $sasl; 473*b8851fccSafresh1 474*b8851fccSafresh1 if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) { 475*b8851fccSafresh1 $sasl = $username; 476*b8851fccSafresh1 my $user_mech = $sasl->mechanism || ''; 477*b8851fccSafresh1 my @user_mech = split(/\s+/, $user_mech); 478*b8851fccSafresh1 my %user_mech; 479*b8851fccSafresh1 @user_mech{@user_mech} = (); 480*b8851fccSafresh1 481*b8851fccSafresh1 my @server_mech = split(/\s+/, $mechanisms); 482*b8851fccSafresh1 my @mech = @user_mech 483*b8851fccSafresh1 ? grep { exists $user_mech{$_} } @server_mech 484*b8851fccSafresh1 : @server_mech; 485*b8851fccSafresh1 unless (@mech) { 486*b8851fccSafresh1 $self->set_status( 487*b8851fccSafresh1 500, 488*b8851fccSafresh1 [ 'Client SASL mechanisms (', 489*b8851fccSafresh1 join(', ', @user_mech), 490*b8851fccSafresh1 ') do not match the SASL mechnism the server announces (', 491*b8851fccSafresh1 join(', ', @server_mech), ')', 492*b8851fccSafresh1 ] 493*b8851fccSafresh1 ); 494*b8851fccSafresh1 return 0; 495*b8851fccSafresh1 } 496*b8851fccSafresh1 497*b8851fccSafresh1 $sasl->mechanism(join(" ", @mech)); 498*b8851fccSafresh1 } 499*b8851fccSafresh1 else { 500*b8851fccSafresh1 die "auth(username, password)" if not length $username; 501*b8851fccSafresh1 $sasl = Authen::SASL->new( 502*b8851fccSafresh1 mechanism => $mechanisms, 503*b8851fccSafresh1 callback => { 504*b8851fccSafresh1 user => $username, 505*b8851fccSafresh1 pass => $password, 506*b8851fccSafresh1 authname => $username, 507*b8851fccSafresh1 } 508*b8851fccSafresh1 ); 509*b8851fccSafresh1 } 510*b8851fccSafresh1 511*b8851fccSafresh1 # We should probably allow the user to pass the host, but I don't 512*b8851fccSafresh1 # currently know and SASL mechanisms that are used by smtp that need it 513*b8851fccSafresh1 my ($hostname) = split /:/, ${*$self}{'net_pop3_host'}; 514*b8851fccSafresh1 my $client = eval { $sasl->client_new('pop', $hostname, 0) }; 515*b8851fccSafresh1 516*b8851fccSafresh1 unless ($client) { 517*b8851fccSafresh1 my $mech = $sasl->mechanism; 518*b8851fccSafresh1 $self->set_status( 519*b8851fccSafresh1 500, 520*b8851fccSafresh1 [ " Authen::SASL failure: $@", 521*b8851fccSafresh1 '(please check if your local Authen::SASL installation', 522*b8851fccSafresh1 "supports mechanism '$mech'" 523*b8851fccSafresh1 ] 524*b8851fccSafresh1 ); 525*b8851fccSafresh1 return 0; 526*b8851fccSafresh1 } 527*b8851fccSafresh1 528*b8851fccSafresh1 my ($token) = $client->client_start 529*b8851fccSafresh1 or do { 530*b8851fccSafresh1 my $mech = $client->mechanism; 531*b8851fccSafresh1 $self->set_status( 532*b8851fccSafresh1 500, 533*b8851fccSafresh1 [ ' Authen::SASL failure: $client->client_start ', 534*b8851fccSafresh1 "mechanism '$mech' hostname #$hostname#", 535*b8851fccSafresh1 $client->error 536*b8851fccSafresh1 ] 537*b8851fccSafresh1 ); 538*b8851fccSafresh1 return 0; 539*b8851fccSafresh1 }; 540*b8851fccSafresh1 541*b8851fccSafresh1 # We don't support sasl mechanisms that encrypt the socket traffic. 542*b8851fccSafresh1 # todo that we would really need to change the ISA hierarchy 543*b8851fccSafresh1 # so we don't inherit from IO::Socket, but instead hold it in an attribute 544*b8851fccSafresh1 545*b8851fccSafresh1 my @cmd = ("AUTH", $client->mechanism); 546*b8851fccSafresh1 my $code; 547*b8851fccSafresh1 548*b8851fccSafresh1 push @cmd, MIME::Base64::encode_base64($token, '') 549*b8851fccSafresh1 if defined $token and length $token; 550*b8851fccSafresh1 551*b8851fccSafresh1 while (($code = $self->command(@cmd)->response()) == CMD_MORE) { 552*b8851fccSafresh1 553*b8851fccSafresh1 my ($token) = $client->client_step(MIME::Base64::decode_base64(($self->message)[0])) or do { 554*b8851fccSafresh1 $self->set_status( 555*b8851fccSafresh1 500, 556*b8851fccSafresh1 [ ' Authen::SASL failure: $client->client_step ', 557*b8851fccSafresh1 "mechanism '", $client->mechanism, " hostname #$hostname#, ", 558*b8851fccSafresh1 $client->error 559*b8851fccSafresh1 ] 560*b8851fccSafresh1 ); 561*b8851fccSafresh1 return 0; 562*b8851fccSafresh1 }; 563*b8851fccSafresh1 564*b8851fccSafresh1 @cmd = (MIME::Base64::encode_base64(defined $token ? $token : '', '')); 565*b8851fccSafresh1 } 566*b8851fccSafresh1 567*b8851fccSafresh1 $code == CMD_OK; 568*b8851fccSafresh1} 569*b8851fccSafresh1 570*b8851fccSafresh1 571*b8851fccSafresh1sub banner { 572*b8851fccSafresh1 my $this = shift; 573*b8851fccSafresh1 574*b8851fccSafresh1 return ${*$this}{'net_pop3_banner'}; 575*b8851fccSafresh1} 576*b8851fccSafresh1 577*b8851fccSafresh1{ 578*b8851fccSafresh1 package Net::POP3::_SSL; 579*b8851fccSafresh1 our @ISA = ( $ssl_class ? ($ssl_class):(), 'Net::POP3' ); 580*b8851fccSafresh1 sub starttls { die "POP3 connection is already in SSL mode" } 581*b8851fccSafresh1 sub start_SSL { 582*b8851fccSafresh1 my ($class,$pop3,%arg) = @_; 583*b8851fccSafresh1 delete @arg{ grep { !m{^SSL_} } keys %arg }; 584*b8851fccSafresh1 ( $arg{SSL_verifycn_name} ||= $pop3->host ) 585*b8851fccSafresh1 =~s{(?<!:):[\w()]+$}{}; # strip port 586*b8851fccSafresh1 $arg{SSL_hostname} = $arg{SSL_verifycn_name} 587*b8851fccSafresh1 if ! defined $arg{SSL_hostname} && $class->can_client_sni; 588*b8851fccSafresh1 $arg{SSL_verifycn_scheme} ||= 'pop3'; 589*b8851fccSafresh1 my $ok = $class->SUPER::start_SSL($pop3,%arg); 590*b8851fccSafresh1 $@ = $ssl_class->errstr if !$ok; 591*b8851fccSafresh1 return $ok; 592*b8851fccSafresh1 } 593*b8851fccSafresh1} 594*b8851fccSafresh1 595*b8851fccSafresh1 596*b8851fccSafresh1 597*b8851fccSafresh11; 598*b8851fccSafresh1 599*b8851fccSafresh1__END__ 600*b8851fccSafresh1 601*b8851fccSafresh1=head1 NAME 602*b8851fccSafresh1 603*b8851fccSafresh1Net::POP3 - Post Office Protocol 3 Client class (RFC1939) 604*b8851fccSafresh1 605*b8851fccSafresh1=head1 SYNOPSIS 606*b8851fccSafresh1 607*b8851fccSafresh1 use Net::POP3; 608*b8851fccSafresh1 609*b8851fccSafresh1 # Constructors 610*b8851fccSafresh1 $pop = Net::POP3->new('pop3host'); 611*b8851fccSafresh1 $pop = Net::POP3->new('pop3host', Timeout => 60); 612*b8851fccSafresh1 $pop = Net::POP3->new('pop3host', SSL => 1, Timeout => 60); 613*b8851fccSafresh1 614*b8851fccSafresh1 if ($pop->login($username, $password) > 0) { 615*b8851fccSafresh1 my $msgnums = $pop->list; # hashref of msgnum => size 616*b8851fccSafresh1 foreach my $msgnum (keys %$msgnums) { 617*b8851fccSafresh1 my $msg = $pop->get($msgnum); 618*b8851fccSafresh1 print @$msg; 619*b8851fccSafresh1 $pop->delete($msgnum); 620*b8851fccSafresh1 } 621*b8851fccSafresh1 } 622*b8851fccSafresh1 623*b8851fccSafresh1 $pop->quit; 624*b8851fccSafresh1 625*b8851fccSafresh1=head1 DESCRIPTION 626*b8851fccSafresh1 627*b8851fccSafresh1This module implements a client interface to the POP3 protocol, enabling 628*b8851fccSafresh1a perl5 application to talk to POP3 servers. This documentation assumes 629*b8851fccSafresh1that you are familiar with the POP3 protocol described in RFC1939. 630*b8851fccSafresh1With L<IO::Socket::SSL> installed it also provides support for implicit and 631*b8851fccSafresh1explicit TLS encryption, i.e. POP3S or POP3+STARTTLS. 632*b8851fccSafresh1 633*b8851fccSafresh1A new Net::POP3 object must be created with the I<new> method. Once 634*b8851fccSafresh1this has been done, all POP3 commands are accessed via method calls 635*b8851fccSafresh1on the object. 636*b8851fccSafresh1 637*b8851fccSafresh1The Net::POP3 class is a subclass of Net::Cmd and (depending on avaibility) of 638*b8851fccSafresh1IO::Socket::IP, IO::Socket::INET6 or IO::Socket::INET. 639*b8851fccSafresh1 640*b8851fccSafresh1 641*b8851fccSafresh1=head1 CONSTRUCTOR 642*b8851fccSafresh1 643*b8851fccSafresh1=over 4 644*b8851fccSafresh1 645*b8851fccSafresh1=item new ( [ HOST ] [, OPTIONS ] ) 646*b8851fccSafresh1 647*b8851fccSafresh1This is the constructor for a new Net::POP3 object. C<HOST> is the 648*b8851fccSafresh1name of the remote host to which an POP3 connection is required. 649*b8851fccSafresh1 650*b8851fccSafresh1C<HOST> is optional. If C<HOST> is not given then it may instead be 651*b8851fccSafresh1passed as the C<Host> option described below. If neither is given then 652*b8851fccSafresh1the C<POP3_Hosts> specified in C<Net::Config> will be used. 653*b8851fccSafresh1 654*b8851fccSafresh1C<OPTIONS> are passed in a hash like fashion, using key and value pairs. 655*b8851fccSafresh1Possible options are: 656*b8851fccSafresh1 657*b8851fccSafresh1B<Host> - POP3 host to connect to. It may be a single scalar, as defined for 658*b8851fccSafresh1the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to 659*b8851fccSafresh1an array with hosts to try in turn. The L</host> method will return the value 660*b8851fccSafresh1which was used to connect to the host. 661*b8851fccSafresh1 662*b8851fccSafresh1B<Port> - port to connect to. 663*b8851fccSafresh1Default - 110 for plain POP3 and 995 for POP3s (direct SSL). 664*b8851fccSafresh1 665*b8851fccSafresh1B<SSL> - If the connection should be done from start with SSL, contrary to later 666*b8851fccSafresh1upgrade with C<starttls>. 667*b8851fccSafresh1You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will 668*b8851fccSafresh1usually use the right arguments already. 669*b8851fccSafresh1 670*b8851fccSafresh1B<LocalAddr> and B<LocalPort> - These parameters are passed directly 671*b8851fccSafresh1to IO::Socket to allow binding the socket to a specific local address and port. 672*b8851fccSafresh1For compatibility with older versions B<ResvPort> can be used instead of 673*b8851fccSafresh1B<LocalPort>. 674*b8851fccSafresh1 675*b8851fccSafresh1B<Domain> - This parameter is passed directly to IO::Socket and makes it 676*b8851fccSafresh1possible to enforce IPv4 connections even if L<IO::Socket::IP> is used as super 677*b8851fccSafresh1class. Alternatively B<Family> can be used. 678*b8851fccSafresh1 679*b8851fccSafresh1B<Timeout> - Maximum time, in seconds, to wait for a response from the 680*b8851fccSafresh1POP3 server (default: 120) 681*b8851fccSafresh1 682*b8851fccSafresh1B<Debug> - Enable debugging information 683*b8851fccSafresh1 684*b8851fccSafresh1=back 685*b8851fccSafresh1 686*b8851fccSafresh1=head1 METHODS 687*b8851fccSafresh1 688*b8851fccSafresh1Unless otherwise stated all methods return either a I<true> or I<false> 689*b8851fccSafresh1value, with I<true> meaning that the operation was a success. When a method 690*b8851fccSafresh1states that it returns a value, failure will be returned as I<undef> or an 691*b8851fccSafresh1empty list. 692*b8851fccSafresh1 693*b8851fccSafresh1C<Net::POP3> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may 694*b8851fccSafresh1be used to send commands to the remote POP3 server in addition to the methods 695*b8851fccSafresh1documented here. 696*b8851fccSafresh1 697*b8851fccSafresh1=over 4 698*b8851fccSafresh1 699*b8851fccSafresh1=item host () 700*b8851fccSafresh1 701*b8851fccSafresh1Returns the value used by the constructor, and passed to IO::Socket::INET, 702*b8851fccSafresh1to connect to the host. 703*b8851fccSafresh1 704*b8851fccSafresh1=item auth ( USERNAME, PASSWORD ) 705*b8851fccSafresh1 706*b8851fccSafresh1Attempt SASL authentication. 707*b8851fccSafresh1 708*b8851fccSafresh1=item user ( USER ) 709*b8851fccSafresh1 710*b8851fccSafresh1Send the USER command. 711*b8851fccSafresh1 712*b8851fccSafresh1=item pass ( PASS ) 713*b8851fccSafresh1 714*b8851fccSafresh1Send the PASS command. Returns the number of messages in the mailbox. 715*b8851fccSafresh1 716*b8851fccSafresh1=item login ( [ USER [, PASS ]] ) 717*b8851fccSafresh1 718*b8851fccSafresh1Send both the USER and PASS commands. If C<PASS> is not given the 719*b8851fccSafresh1C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host 720*b8851fccSafresh1and username. If the username is not specified then the current user name 721*b8851fccSafresh1will be used. 722*b8851fccSafresh1 723*b8851fccSafresh1Returns the number of messages in the mailbox. However if there are no 724*b8851fccSafresh1messages on the server the string C<"0E0"> will be returned. This is 725*b8851fccSafresh1will give a true value in a boolean context, but zero in a numeric context. 726*b8851fccSafresh1 727*b8851fccSafresh1If there was an error authenticating the user then I<undef> will be returned. 728*b8851fccSafresh1 729*b8851fccSafresh1=item starttls ( SSLARGS ) 730*b8851fccSafresh1 731*b8851fccSafresh1Upgrade existing plain connection to SSL. 732*b8851fccSafresh1You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will 733*b8851fccSafresh1usually use the right arguments already. 734*b8851fccSafresh1 735*b8851fccSafresh1=item apop ( [ USER [, PASS ]] ) 736*b8851fccSafresh1 737*b8851fccSafresh1Authenticate with the server identifying as C<USER> with password C<PASS>. 738*b8851fccSafresh1Similar to L</login>, but the password is not sent in clear text. 739*b8851fccSafresh1 740*b8851fccSafresh1To use this method you must have the Digest::MD5 or the MD5 module installed, 741*b8851fccSafresh1otherwise this method will return I<undef>. 742*b8851fccSafresh1 743*b8851fccSafresh1=item banner () 744*b8851fccSafresh1 745*b8851fccSafresh1Return the sever's connection banner 746*b8851fccSafresh1 747*b8851fccSafresh1=item capa () 748*b8851fccSafresh1 749*b8851fccSafresh1Return a reference to a hash of the capabilities of the server. APOP 750*b8851fccSafresh1is added as a pseudo capability. Note that I've been unable to 751*b8851fccSafresh1find a list of the standard capability values, and some appear to 752*b8851fccSafresh1be multi-word and some are not. We make an attempt at intelligently 753*b8851fccSafresh1parsing them, but it may not be correct. 754*b8851fccSafresh1 755*b8851fccSafresh1=item capabilities () 756*b8851fccSafresh1 757*b8851fccSafresh1Just like capa, but only uses a cache from the last time we asked 758*b8851fccSafresh1the server, so as to avoid asking more than once. 759*b8851fccSafresh1 760*b8851fccSafresh1=item top ( MSGNUM [, NUMLINES ] ) 761*b8851fccSafresh1 762*b8851fccSafresh1Get the header and the first C<NUMLINES> of the body for the message 763*b8851fccSafresh1C<MSGNUM>. Returns a reference to an array which contains the lines of text 764*b8851fccSafresh1read from the server. 765*b8851fccSafresh1 766*b8851fccSafresh1=item list ( [ MSGNUM ] ) 767*b8851fccSafresh1 768*b8851fccSafresh1If called with an argument the C<list> returns the size of the message 769*b8851fccSafresh1in octets. 770*b8851fccSafresh1 771*b8851fccSafresh1If called without arguments a reference to a hash is returned. The 772*b8851fccSafresh1keys will be the C<MSGNUM>'s of all undeleted messages and the values will 773*b8851fccSafresh1be their size in octets. 774*b8851fccSafresh1 775*b8851fccSafresh1=item get ( MSGNUM [, FH ] ) 776*b8851fccSafresh1 777*b8851fccSafresh1Get the message C<MSGNUM> from the remote mailbox. If C<FH> is not given 778*b8851fccSafresh1then get returns a reference to an array which contains the lines of 779*b8851fccSafresh1text read from the server. If C<FH> is given then the lines returned 780*b8851fccSafresh1from the server are printed to the filehandle C<FH>. 781*b8851fccSafresh1 782*b8851fccSafresh1=item getfh ( MSGNUM ) 783*b8851fccSafresh1 784*b8851fccSafresh1As per get(), but returns a tied filehandle. Reading from this 785*b8851fccSafresh1filehandle returns the requested message. The filehandle will return 786*b8851fccSafresh1EOF at the end of the message and should not be reused. 787*b8851fccSafresh1 788*b8851fccSafresh1=item last () 789*b8851fccSafresh1 790*b8851fccSafresh1Returns the highest C<MSGNUM> of all the messages accessed. 791*b8851fccSafresh1 792*b8851fccSafresh1=item popstat () 793*b8851fccSafresh1 794*b8851fccSafresh1Returns a list of two elements. These are the number of undeleted 795*b8851fccSafresh1elements and the size of the mbox in octets. 796*b8851fccSafresh1 797*b8851fccSafresh1=item ping ( USER ) 798*b8851fccSafresh1 799*b8851fccSafresh1Returns a list of two elements. These are the number of new messages 800*b8851fccSafresh1and the total number of messages for C<USER>. 801*b8851fccSafresh1 802*b8851fccSafresh1=item uidl ( [ MSGNUM ] ) 803*b8851fccSafresh1 804*b8851fccSafresh1Returns a unique identifier for C<MSGNUM> if given. If C<MSGNUM> is not 805*b8851fccSafresh1given C<uidl> returns a reference to a hash where the keys are the 806*b8851fccSafresh1message numbers and the values are the unique identifiers. 807*b8851fccSafresh1 808*b8851fccSafresh1=item delete ( MSGNUM ) 809*b8851fccSafresh1 810*b8851fccSafresh1Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages 811*b8851fccSafresh1that are marked to be deleted will be removed from the remote mailbox 812*b8851fccSafresh1when the server connection closed. 813*b8851fccSafresh1 814*b8851fccSafresh1=item reset () 815*b8851fccSafresh1 816*b8851fccSafresh1Reset the status of the remote POP3 server. This includes resetting the 817*b8851fccSafresh1status of all messages to not be deleted. 818*b8851fccSafresh1 819*b8851fccSafresh1=item quit () 820*b8851fccSafresh1 821*b8851fccSafresh1Quit and close the connection to the remote POP3 server. Any messages marked 822*b8851fccSafresh1as deleted will be deleted from the remote mailbox. 823*b8851fccSafresh1 824*b8851fccSafresh1=item can_inet6 () 825*b8851fccSafresh1 826*b8851fccSafresh1Returns whether we can use IPv6. 827*b8851fccSafresh1 828*b8851fccSafresh1=item can_ssl () 829*b8851fccSafresh1 830*b8851fccSafresh1Returns whether we can use SSL. 831*b8851fccSafresh1 832*b8851fccSafresh1=back 833*b8851fccSafresh1 834*b8851fccSafresh1=head1 NOTES 835*b8851fccSafresh1 836*b8851fccSafresh1If a C<Net::POP3> object goes out of scope before C<quit> method is called 837*b8851fccSafresh1then the C<reset> method will called before the connection is closed. This 838*b8851fccSafresh1means that any messages marked to be deleted will not be. 839*b8851fccSafresh1 840*b8851fccSafresh1=head1 SEE ALSO 841*b8851fccSafresh1 842*b8851fccSafresh1L<Net::Netrc>, 843*b8851fccSafresh1L<Net::Cmd>, 844*b8851fccSafresh1L<IO::Socket::SSL> 845*b8851fccSafresh1 846*b8851fccSafresh1=head1 AUTHOR 847*b8851fccSafresh1 848*b8851fccSafresh1Graham Barr E<lt>F<gbarr@pobox.com>E<gt> 849*b8851fccSafresh1 850*b8851fccSafresh1Steve Hay E<lt>F<shay@cpan.org>E<gt> is now maintaining libnet as of version 851*b8851fccSafresh11.22_02 852*b8851fccSafresh1 853*b8851fccSafresh1=head1 COPYRIGHT 854*b8851fccSafresh1 855*b8851fccSafresh1Versions up to 2.29 Copyright (c) 1995-2004 Graham Barr. All rights reserved. 856*b8851fccSafresh1Changes in Version 2.29_01 onwards Copyright (C) 2013-2015 Steve Hay. All 857*b8851fccSafresh1rights reserved. 858*b8851fccSafresh1 859*b8851fccSafresh1This module is free software; you can redistribute it and/or modify it under the 860*b8851fccSafresh1same terms as Perl itself, i.e. under the terms of either the GNU General Public 861*b8851fccSafresh1License or the Artistic License, as specified in the F<LICENCE> file. 862*b8851fccSafresh1 863*b8851fccSafresh1=cut 864