1use 5.006; 2use strict; 3use warnings; 4 5package Mail::Box::IMAP4::SSL; 6# ABSTRACT: handle IMAP4 folders with SSL 7our $VERSION = '0.03'; # VERSION 8 9use superclass 'Mail::Box::IMAP4' => 2.079; 10use IO::Socket::SSL 1.12; 11use Mail::Reporter 2.079 qw(); 12use Mail::Transport::IMAP4 2.079 qw(); 13use Mail::IMAPClient 3.02; 14 15my $imaps_port = 993; # standard port for IMAP over SSL 16 17#--------------------------------------------------------------------------# 18# init 19#--------------------------------------------------------------------------# 20 21sub init { 22 my ( $self, $args ) = @_; 23 24 # until we're connected, mark as closed in case we exit early 25 # (otherwise, Mail::Box::DESTROY will try to close/unlock, which dies) 26 $self->{MB_is_closed}++; 27 28 # if no port is provided, use the default 29 $args->{server_port} ||= $imaps_port; 30 31 # Mail::Box::IMAP4 wants a folder or it throws warnings 32 $args->{folder} ||= '/'; 33 34 # Use messages classes from our superclass type 35 $args->{message_type} ||= 'Mail::Box::IMAP4::Message'; 36 37 # giving us a transport argument is an error since our only purpose 38 # is to create the right kind of transport object 39 if ( $args->{transporter} ) { 40 Mail::Reporter->log( 41 ERROR => "The 'transporter' option is not valid for " . __PACKAGE__ ); 42 return; 43 } 44 45 # some arguments are required to connect to a server 46 for my $req (qw/ server_name username password/) { 47 if ( not defined $args->{$req} ) { 48 Mail::Reporter->log( ERROR => "The '$req' option is required for " . __PACKAGE__ ); 49 return; 50 } 51 } 52 53 # trying to create the transport object 54 55 my $verify_mode = 56 $ENV{MAIL_BOX_IMAP4_SSL_NOVERIFY} ? SSL_VERIFY_NONE() : SSL_VERIFY_PEER(); 57 58 my $ssl_socket = IO::Socket::SSL->new( 59 Proto => 'tcp', 60 PeerAddr => $args->{server_name}, 61 PeerPort => $args->{server_port}, 62 SSL_verify_mode => $verify_mode, 63 ); 64 65 unless ($ssl_socket) { 66 Mail::Reporter->log( ERROR => "Couldn't connect to '$args->{server_name}': " 67 . IO::Socket::SSL::errstr() ); 68 return; 69 } 70 71 my $imap = Mail::IMAPClient->new( 72 User => $args->{username}, 73 Password => $args->{password}, 74 Socket => $ssl_socket, 75 Uid => 1, # Mail::Transport::IMAP4 does this 76 Peek => 1, # Mail::Transport::IMAP4 does this 77 ); 78 my $imap_err = $@; 79 80 unless ( $imap && $imap->IsAuthenticated ) { 81 Mail::Reporter->log( ERROR => "Login rejected for user '$args->{username}'" 82 . " on server '$args->{server_name}': $imap_err" ); 83 return; 84 } 85 86 $args->{transporter} = Mail::Transport::IMAP4->new( imap_client => $imap, ); 87 88 unless ( $args->{transporter} ) { 89 Mail::Reporter->log( 90 ERROR => "Error creating Mail::Transport::IMAP4 from the SSL connection." ); 91 return; 92 } 93 94 # now that we have a valid transporter, mark ourselves open 95 # and let the superclass initialize 96 delete $self->{MB_is_closed}; 97 $self->SUPER::init($args); 98 99} 100 101sub type { 'imaps' } 102 1031; 104 105__END__ 106 107=pod 108 109=encoding UTF-8 110 111=head1 NAME 112 113Mail::Box::IMAP4::SSL - handle IMAP4 folders with SSL 114 115=head1 VERSION 116 117version 0.03 118 119=head1 SYNOPSIS 120 121 # standalone 122 use Mail::Box::IMAP4::SSL; 123 124 my $folder = new Mail::Box::IMAP4::SSL( 125 username => 'johndoe', 126 password => 'wbuaqbr', 127 server_name => 'imap.example.com', 128 ); 129 130 # with Mail::Box::Manager 131 use Mail::Box::Manager; 132 133 my $mbm = Mail::Box::Manager->new; 134 $mbm->registerType( imaps => 'Mail::Box::IMAP4::SSL' ); 135 136 my $inbox = $mbm->open( 137 folder => 'imaps://johndoe:wbuaqbr@imap.example.com/INBOX', 138 ); 139 140=head1 DESCRIPTION 141 142This is a thin subclass of L<Mail::Box::IMAP4> to provide IMAP over SSL (aka 143IMAPS). It hides the complexity of setting up Mail::Box::IMAP4 with 144L<IO::Socket::SSL>, L<Mail::IMAPClient> and L<Mail::Transport::IMAP4>. 145 146In all other respects, it resembles L<Mail::Box::IMAP4>. See that module 147for documentation. 148 149=for Pod::Coverage init 150 151=head1 INHERITANCE 152 153 Mail::Box::IMAP4::SSL 154 is a Mail::Box::IMAP4 155 is a Mail::Box::Net 156 is a Mail::Box 157 is a Mail::Reporter 158 159=head1 METHODS 160 161=head2 C<<< Mail::Box::IMAP4::SSL->new( %options ) >>> 162 163 my $folder = new Mail::Box::IMAP4::SSL( 164 username => 'johndoe', 165 password => 'wbuaqbr', 166 server_name => 'imap.example.com', 167 %other_options 168 ); 169 170The C<<< username >>>, C<<< password >>> and C<<< server_name >>> options arguments are required. 171The C<<< server_port >>> option is automatically set to the standard IMAPS port 993, 172but can be changed if needed. See L<Mail::Box::IMAP4> for additional options. 173 174Note: It is an error to provide a C<<< transporter >>> options, as this class exists 175only to create an SSL-secured C<<< transporter >>> for C<<< Mail::Box::IMAP4 >>>. 176 177=head1 SEE ALSO 178 179=over 180 181=item * 182 183L<Mail::Box> 184 185=item * 186 187L<Mail::Box::IMAP4> 188 189=back 190 191=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan 192 193=head1 SUPPORT 194 195=head2 Bugs / Feature Requests 196 197Please report any bugs or feature requests through the issue tracker 198at L<https://github.com/dagolden/Mail-Box-IMAP4-SSL/issues>. 199You will be notified automatically of any progress on your issue. 200 201=head2 Source Code 202 203This is open source software. The code repository is available for 204public review and contribution under the terms of the license. 205 206L<https://github.com/dagolden/Mail-Box-IMAP4-SSL> 207 208 git clone https://github.com/dagolden/Mail-Box-IMAP4-SSL.git 209 210=head1 AUTHOR 211 212David Golden <dagolden@cpan.org> 213 214=head1 COPYRIGHT AND LICENSE 215 216This software is Copyright (c) 2013 by David Golden. 217 218This is free software, licensed under: 219 220 The Apache License, Version 2.0, January 2004 221 222=cut 223