Net-IMAP-Client
view release on metacpan or search on metacpan
lib/Net/IMAP/Client.pm view on Meta::CPAN
package Net::IMAP::Client;
use vars qw[$VERSION];
$VERSION = '0.9511';
use strict;
use warnings;
use List::Util qw( min max first );
use List::MoreUtils qw( each_array );
use IO::Socket::INET ();
use IO::Socket::SSL ();
use Socket qw( SO_KEEPALIVE );
use Net::IMAP::Client::MsgSummary ();
our $READ_BUFFER = 4096;
my %UID_COMMANDS = map { $_ => 1 } qw( COPY FETCH STORE SEARCH SORT THREAD );
my %DEFAULT_ARGS = (
uid_mode => 1,
timeout => 90,
server => '127.0.0.1',
port => undef,
user => undef,
pass => undef,
ssl => 0,
ssl_verify_peer => 1,
tls => 0,
socket => undef,
_cmd_id => 0,
ssl_options => {},
);
sub new {
my ($class, %args) = @_;
my $self = { map {
$_ => exists $args{$_} ? $args{$_} : $DEFAULT_ARGS{$_}
} keys %DEFAULT_ARGS };
die "Cannot enable both ssl and tls" if ($self->{tls} and $self->{ssl});
bless $self, $class;
$self->{notifications} = [];
eval {
$self->_get_socket; # set up the socket
};
return $@ ? undef : $self;
}
sub DESTROY {
my ($self) = @_;
local $@;
eval {
$self->quit
if $self->{socket}->opened;
};
}
sub uid_mode {
my ($self, $val) = @_;
if (defined($val)) {
return $self->{uid_mode} = $val;
} else {
return $self->{uid_mode};
}
}
### imap utilities ###
lib/Net/IMAP/Client.pm view on Meta::CPAN
sub del_flags {
my ($self, $msg, $flags) = @_;
$self->_store_helper($msg, $flags, '-FLAGS');
}
sub delete_message {
my ($self, $msg) = @_;
$self->add_flags($msg, '\\Deleted');
}
sub expunge {
my ($self) = @_;
my ($ok, $lines) = $self->_tell_imap('EXPUNGE' => undef, 1);
if ($ok && $lines && @$lines) {
my $ret = $lines->[0][0];
if ($ret =~ /^\*\s+(\d+)\s+EXPUNGE/) {
return $1 + 0;
}
}
return $ok ? -1 : undef;
}
sub last_error {
my ($self) = @_;
defined $self->{_error} or return;
$self->{_error} =~ s/\s+$//s; # remove trailing carriage return
return $self->{_error};
}
sub notifications {
my ($self) = @_;
my $tmp = $self->{notifications};
$self->{notifications} = [];
return wantarray ? @$tmp : $tmp;
}
##### internal stuff #####
sub _get_port {
my ($self) = @_;
return $self->{port} || ($self->{ssl} ? 993 : 143);
}
sub _get_timeout {
my ($self) = @_;
return $self->{timeout} || 90;
}
sub _get_server {
my ($self) = @_;
return $self->{server};
}
sub _get_ssl_config {
my ($self) = @_;
if (!$self->{ssl_verify_peer}
|| !$self->{ssl_ca_path}
&& !$self->{ssl_ca_file}
&& $^O ne 'linux') {
return SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE;
}
my %ssl_config = ( SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER );
if ($^O eq 'linux' && !$self->{ssl_ca_path} && !$self->{ssl_ca_file}) {
$ssl_config{SSL_ca_path} =
-d '/etc/ssl/certs/' ? '/etc/ssl/certs/' : '/etc/pki/tls/certs/';
-d $ssl_config{SSL_ca_path}
or die "$ssl_config{SSL_ca_path}: SSL certification directory not found";
}
$ssl_config{SSL_ca_path} = $self->{ssl_ca_path} if $self->{ssl_ca_path};
$ssl_config{SSL_ca_file} = $self->{ssl_ca_file} if $self->{ssl_ca_file};
return %ssl_config;
}
sub _get_socket {
my ($self) = @_;
my $socket = $self->{socket};
return $socket if (defined($socket) and ($socket->isa('IO::Socket::SSL')or $socket->isa('IO::Socket::INET')));
$self->{socket} = ($self->{ssl} ? 'IO::Socket::SSL' : 'IO::Socket::INET')->new(
( ( %{$self->{ssl_options}} ) x !!$self->{ssl} ),
PeerAddr => $self->_get_server,
PeerPort => $self->_get_port,
Timeout => $self->_get_timeout,
Proto => 'tcp',
Blocking => 1,
$self->_get_ssl_config,
) or die "failed connect or ssl handshake: $!,$IO::Socket::SSL::SSL_ERROR";
$self->{socket}->sockopt(SO_KEEPALIVE, 1);
$self->{greeting} = $self->_socket_getline; # get the initial greeting
$self->_starttls if ($self->{tls}); # upgrade to TLS if needed
return $self->{socket};
}
sub _starttls {
my ($self) = @_;
# ask for the capabilities directly at this level, make sure we can do STARTTLS
my $can_do_starttls = 0;
my ($ok, $lines) = $self->_tell_imap('CAPABILITY');
if ($ok) {
my $line = $lines->[0][0];
$can_do_starttls ||= 1 if ($line =~ /^\*\s+CAPABILITY.*\s+STARTTLS/);
} else {
die "IMAP server failed CAPABILITY query"
}
die "IMAP server does not have STARTTLS capability" unless ($can_do_starttls);
# request STARTTLS
($ok, $lines) = $self->_tell_imap('STARTTLS');
if ($ok) {
my @sni_args;
push(@sni_args, SSL_hostname => $self->_get_server) if (IO::Socket::SSL->can_client_sni());
IO::Socket::SSL->start_SSL(
$self->{socket},
$self->_get_ssl_config,
@sni_args,
) or die $IO::Socket::SSL::SSL_ERROR;
} else {
die "IMAP server failed STARTTLS command"
}
return $self->{socket};
}
sub _get_next_id {
return ++$_[0]->{_cmd_id};
}
sub _socket_getline {
local $/ = "\r\n";
return $_[0]->_get_socket->getline;
}
sub _socket_write {
my $self = shift;
# open LOG, '>>:raw', '/tmp/net-imap-client.log';
# print LOG @_;
# close LOG;
$self->_get_socket->write(@_);
}
sub _send_cmd {
my ($self, $cmd, $args) = @_;
local $\;
use bytes;
my $id = $self->_get_next_id;
if ($self->uid_mode && exists($UID_COMMANDS{$cmd})) {
$cmd = "UID $cmd";
}
my @literals = ();
if (ref $args eq 'ARRAY') {
# may contain literals
foreach (@$args) {
if (ref $_ eq 'SCALAR') {
push @literals, $_;
$_ = '{' . length($$_) . "}\r\n";
}
}
$args = join('', @$args);
}
my $socket = $self->_get_socket;
if (@literals == 0) {
$cmd = "NIC$id $cmd" . ($args ? " $args" : '') . "\r\n";
$self->_socket_write($cmd);
} else {
$cmd = "NIC$id $cmd ";
$self->_socket_write($cmd);
my @split = split(/\r\n/, $args);
my $ea = each_array(@split, @literals);
while (my ($tmp, $lit) = $ea->()) {
$self->_socket_write($tmp . "\r\n");
my $line = $self->_socket_getline;
# print STDERR "$line - $tmp\n";
if ($line =~ /^\+/) {
$self->_socket_write($$lit);
lib/Net/IMAP/Client.pm view on Meta::CPAN
my $hash = $imap->get_parts_bodies($msg_id, [ '1.2', '1.3', '2.2' ]);
my $part1_2 = $hash->{'1.2'};
my $part1_3 = $hash->{'1.3'};
my $part2_2 = $hash->{'2.2'};
print $$part1_2; # need to dereference it
# copy messages between folders
$imap->select('INBOX');
$imap->copy(\@msg_ids, 'Archive');
# delete messages ("Move to Trash")
$imap->copy(\@msg_ids, 'Trash');
$imap->add_flags(\@msg_ids, '\\Deleted');
$imap->expunge;
=head1 DESCRIPTION
Net::IMAP::Client provides methods to access an IMAP server. It aims
to provide a simple and clean API, while employing a rigorous parser
for IMAP responses in order to create Perl data structures from them.
The code is simple, clean and extensible.
It started as an effort to improve L<Net::IMAP::Simple> but then I
realized that I needed to change a lot of code and API so I started it
as a fresh module. Still, the design is influenced by
Net::IMAP::Simple and I even stole a few lines of code from it ;-)
(very few, honestly).
This software was developed for creating a web-based email (IMAP)
client: www.xuheki.com. Xhueki uses Net::IMAP::Client.
=head1 API REFERENCE
Unless otherwise specified, if a method fails it returns I<undef> and
you can inspect the error by calling $imap->last_error. For a
successful call most methods will return a meaningful value but
definitely not I<undef>.
=head2 new(%args) # constructor
my $imap = Net::IMAP::Client->new(%args);
Pass to the constructor a hash of arguments that can contain:
=over
=item - B<server> (STRING)
Host name or IP of the IMAP server.
=item - B<user> (STRING)
User ID (I<only "clear" login is supported for now!>)
=item - B<pass> (STRING)
Password
=item - B<ssl> (BOOL, optional, default FALSE)
Pass a true value if you want to use L<IO::Socket::SSL>
You may not set both C<ssl> and C<tls> at the same time.
=item - B<tls> (BOOL, optional, default FALSE)
Pass a true value if you want to use connect without SSL and then use
C<STARTTLS> to upgrade the connection to an encrypted session using
L<IO::Socket::SSL>. The other C<ssl_*> options also apply.
You may not set both C<ssl> and C<tls> at the same time.
=item - B<ssl_verify_peer> (BOOL, optional, default TRUE)
Pass a false value if you do not want to use SSL CA to verify server
only need when you set ssl to true
=item - B<ssl_ca_file> (STRING, optional)
Pass a file path which used as CA file to verify server
at least one of ssl_ca_file and ssl_ca_path is needed for ssl verify
server
=item -B<ssl_ca_path> (STRING, optional)
Pass a dir which will be used as CA file search dir, found CA file
will be used to verify server
On linux, by default is '/etc/ssl/certs/'
at least one of ssl_ca_file and ssl_ca_path is needed for ssl verify
server
=item - B<ssl_options> (HASHREF, optional)
Optional arguments to be passed to the L<IO::Socket::SSL> object.
=item - B<uid_mode> (BOOL, optional, default TRUE)
Whether to use UID command (see RFC3501). Recommended.
=item - B<socket> (IO::Handle, optional)
If you already have a socket connected to the IMAP server, you can
pass it here.
=back
The B<ssl_ca_file> and B<ssl_ca_path> only need when you set
B<ssl_verify_peer> to TRUE.
If you havn't apply an B<ssl_ca_file> and B<ssl_ca_path>, on linux,
the B<ssl_ca_path> will use the value '/etc/ssl/certs/', on other
platform B<ssl_verify_peer> will be disabled.
The constructor doesn't login to the IMAP server -- you need to call
$imap->login for that.
=head2 last_error
Returns the last error from the IMAP server.
=head2 login($user, $pass)
Login to the IMAP server. You can pass $user and $pass here if you
wish; if not passed, the values used in constructor will be used.
Returns I<undef> if login failed.
=head2 logout / quit
Send EXPUNGE and LOGOUT then close connection. C<quit> is an alias
for C<logout>.
=head2 noop
"Do nothing" method that calls the IMAP "NOOP" command. It returns a
true value upon success, I<undef> otherwise.
This method fetches any notifications that the server might have for
us and you can get them by calling $imap->notifications. See the
L</notifications()> method.
=head2 capability() / capability(qr/^SOMETHING/)
With no arguments, returns an array of all capabilities advertised by
the server. If you're interested in a certain capability you can pass
a RegExp. E.g. to check if this server knows 'SORT', you can do this:
if ($imap->capability(/^sort$/i)) {
# speaks it
}
This data is cached, the server will be only hit once.
=head2 select($folder)
( run in 1.742 second using v1.01-cache-2.11-cpan-39bf76dae61 )