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