package Mail::Box::IMAP4::SSL;
use 5.006;
use strict;
use warnings;
use base 'Mail::Box::IMAP4';
use IO::Socket::SSL qw();
use Mail::Reporter qw();
use Mail::Transport::IMAP4 qw();
our $VERSION = '0.02';
my $imaps_port = 993; # standard port for IMAP over SSL
#--------------------------------------------------------------------------#
# init
#--------------------------------------------------------------------------#
sub init {
my ($self, $args) = @_;
# until we're connected, mark as closed in case we exit early
# (otherwise, Mail::Box::DESTROY will try to close/unlock, which dies)
$self->{MB_is_closed}++;
# if no port is provided, use the default
$args->{server_port} ||= $imaps_port;
# Mail::Box::IMAP4 wants a folder or it throws warnings
$args->{folder} ||= '/';
# Use messages classes from our superclass type
$args->{message_type} ||= 'Mail::Box::IMAP4::Message';
# giving us a transport argument is an error since our only purpose
# is to create the right kind of transport object
if ( $args->{transporter} ) {
Mail::Reporter->log(ERROR =>
"The 'transporter' option is not valid for " . __PACKAGE__
);
return;
}
# some arguments are required to connect to a server
for my $req ( qw/ server_name username password/ ) {
if ( not defined $args->{$req} ) {
Mail::Reporter->log(ERROR =>
"The '$req' option is required for " . __PACKAGE__
);
return;
}
}
# trying to create the transport object
my $ssl_socket = IO::Socket::SSL->new(
Proto => 'tcp',
PeerAddr => $args->{server_name},
PeerPort => $args->{server_port},
);
unless ( $ssl_socket ) {
Mail::Reporter->log(ERROR =>
"Couldn't connect to '$args->{server_name}': "
. IO::Socket::SSL::errstr()
);
return;
}
my $imap = Mail::IMAPClient->new(
User => $args->{username},
Password => $args->{password},
Socket => $ssl_socket,
Uid => 1, # Mail::Transport::IMAP4 does this
Peek => 1, # Mail::Transport::IMAP4 does this
);
my $imap_err = $@;
unless ( $imap && $imap->IsAuthenticated ) {
Mail::Reporter->log( ERROR =>
"Login rejected for user '$args->{username}'"
. " on server '$args->{server_name}': $imap_err"
);
return;
}
$args->{transporter} = Mail::Transport::IMAP4->new(
imap_client => $imap,
);
unless ( $args->{transporter} ) {
Mail::Reporter->log( ERROR =>
"Error creating Mail::Transport::IMAP4 from the SSL connection."
);
return;
}
# now that we have a valid transporter, mark ourselves open
# and let the superclass take over
delete $self->{MB_is_closed};
return $self->SUPER::init($args);
}
1; #modules must return true
__END__
#--------------------------------------------------------------------------#
# pod documentation
#--------------------------------------------------------------------------#
=begin wikidoc
= NAME
Mail::Box::IMAP4::SSL - handle IMAP4 folders with SSL
= VERSION
This documentation describes version %%VERSION%%.
= INHERITANCE
Mail::Box::IMAP4::SSL
is a Mail::Box::IMAP4
is a Mail::Box::Net
is a Mail::Box
is a Mail::Reporter
= SYNOPSIS
use Mail::Box::IMAP4::SSL;
my $folder = new Mail::Box::IMAP4::SSL(
username => 'johndoe',
password => 'x_marks_the_spot',
server_name => 'imap.example.com',
);
= DESCRIPTION
This is a thin subclass of [Mail::Box::IMAP4] to provide IMAP over SSL (aka
IMAPS). It hides the complexity of setting up Mail::Box::IMAP4 with
[IO::Socket::SSL], [Mail::IMAPClient] and [Mail::Transport::IMAP4].
In all other respects, it resembles [Mail::Box::IMAP4]. See that module
for documentation.
= METHODS
== {Mail::Box::IMAP4::SSL->new( %options )}
my $folder = new Mail::Box::IMAP4::SSL(
username => 'johndoe',
password => 'x_marks_the_spot',
server_name => 'imap.example.com',
%other_options
);
The {username}, {password} and {server_name} options arguments are required.
The {server_port} option is automatically set to the standard IMAPS port 993,
but can be changed if needed. See [Mail::Box::IMAP4] for additional options.
Note: It is an error to provide a {transporter} options, as this class exists
only to create an SSL-secured {transporter} for {Mail::Box::IMAP4}.
= BUGS
Please report any bugs or feature requests using the CPAN Request Tracker.
Bugs can be submitted through the web interface at
[http://rt.cpan.org/Dist/Display.html?Queue=Mail::Box::IMAP4::SSL]
When submitting a bug or request, please include a test-file or a patch to an
existing test-file that illustrates the bug or desired feature.
Please limit your bug/feature reports to SSL-specific issues. All other
issues should be directed to the maintainer of {Mail::Box::IMAP4}.
= SEE ALSO
* [Mail::Box]
* [Mail::Box::IMAP4]
= AUTHOR
David A. Golden (DAGOLDEN)
= COPYRIGHT AND LICENSE
Copyright (c) 2007 by David A. Golden
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
[http://www.apache.org/licenses/LICENSE-2.0]
Files produced as output though the use of this software, shall not be
considered Derivative Works, but shall be considered the original work of the
Licensor.
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
=end wikidoc
=cut