Subject: | Support TLS in IMAP4 connection |
It is obvious that one should never use plain text authentication over
en unencrypted connection in the internet. Most IMAP4 servers thus
support the connection to be encrypted using Transport Layer Security
(TLS), many even require TLS to be used. Therefore, it would be
desirable for Mail::Box to also support TLS for IMAP4 folders.
Fortunately, the underlying module Mail::IMAPClient already supports
TLS. One only need to pass the appropriate options to
Mail::IMAPClient to switch TLS on. The attached patch does just this
in Mail::Transport::IMAP4.
I modified the method createImapClient to accept additional arguments
that will be passed through to the call of Mail::IMAPClient->new.
Then I modified the constructor of Mail::Transport::IMAP4 to accept a
new optional argument "starttls" that will be passed to
Mail::IMAPClient via createImapClient, if present.
Using this patch, the following code now will connect to the IMAP
server using TLS:
use Mail::Box::IMAP4;
my $imaphost = 'mail.example.org';
my $imapuser = 'USER';
my $imappass = 'PASS';
my $mailbox = 'INBOX';
my $folder = new Mail::Box::IMAP4(server_name => $imaphost,
username => $imapuser,
password => $imappass,
folder => $mailbox,
starttls => 1);
print $folder->nrMessages, " messages\n";
Since the argument "starttls" is passed through unmodified, its
semantic is the same as for Mail::IMAPClient, see the man page for
this module for details.
Subject: | Mail-Box-IMAP-TLS.patch |
--- Makefile.PL.orig 2012-11-28 12:26:12.000000000 +0100
+++ Makefile.PL 2013-01-27 22:10:27.735400383 +0100
@@ -54,7 +54,7 @@
#break your Mail::Box installing process.
#WARN
- [ Mail::IMAPClient => '3.00', reason => <<'REASON' ]
+ [ Mail::IMAPClient => '3.22', reason => <<'REASON' ]
Required for IMAP4 support.
REASON
--- lib/Mail/Transport/IMAP4.pm.orig 2012-11-28 12:28:35.000000000 +0100
+++ lib/Mail/Transport/IMAP4.pm 2013-01-27 22:17:45.172156091 +0100
@@ -39,7 +39,9 @@
$self->{MTI_domain} = $args->{domain};
unless(ref $imap)
- { $imap = $self->createImapClient($imap) or return undef;
+ { my @clientargs = defined($args->{starttls}) ?
+ ( Starttls => $args->{starttls} ) : ();
+ $imap = $self->createImapClient($imap, @clientargs) or return undef;
}
$self->imapClient($imap) or return undef;
@@ -114,16 +116,15 @@
}
-sub createImapClient($)
-{ my ($self, $class) = @_;
+sub createImapClient($@)
+{ my ($self, $class, @args) = @_;
my ($host, $port) = $self->remoteHost;
my $debug_level = $self->logPriority('DEBUG')+0;
- my @debug;
if($self->log <= $debug_level || $self->trace <= $debug_level)
{ tie *dh, 'Mail::IMAPClient::Debug', $self;
- @debug = (Debug => 1, Debug_fh => \*dh);
+ push @args, (Debug => 1, Debug_fh => \*dh);
}
my $client = $class->new
@@ -131,7 +132,7 @@
, User => undef, Password => undef # disable auto-login
, Uid => 1 # Safer
, Peek => 1 # Don't set \Seen automaticly
- , @debug
+ , @args
);
$self->log(ERROR => $@), return undef if $@;
--- lib/Mail/Transport/IMAP4.pod.orig 2012-11-28 12:28:43.000000000 +0100
+++ lib/Mail/Transport/IMAP4.pod 2013-01-27 22:10:27.735400383 +0100
@@ -216,9 +216,10 @@
Add a folder.
-=item $obj-E<gt>B<createImapClient>(CLASS)
+=item $obj-E<gt>B<createImapClient>(CLASS, [ARGS])
Create an object of CLASS, which extends L<Mail::IMAPClient>.
+The optional additional ARGS will be passed to the constructor of CLASS.
=item $obj-E<gt>B<currentFolder>([FOLDERNAME])