r24880 - in /branches/upstream/libmail-imapclient-perl/current: Changes META.yml examples/imap_to_mbox.pl lib/Mail/IMAPClient.pm lib/Mail/IMAPClient.pod
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sat Sep 6 18:46:35 UTC 2008
Author: gregoa
Date: Sat Sep 6 18:46:33 2008
New Revision: 24880
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=24880
Log:
[svn-upgrade] Integrating new upstream version, libmail-imapclient-perl (3.10)
Modified:
branches/upstream/libmail-imapclient-perl/current/Changes
branches/upstream/libmail-imapclient-perl/current/META.yml
branches/upstream/libmail-imapclient-perl/current/examples/imap_to_mbox.pl
branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm
branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod
Modified: branches/upstream/libmail-imapclient-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/Changes?rev=24880&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/Changes (original)
+++ branches/upstream/libmail-imapclient-perl/current/Changes Sat Sep 6 18:46:33 2008
@@ -3,6 +3,35 @@
All changes from 2.99_01 upward are made by Mark Overmeer. The changes
before that are applied by David Kernen
+version 3.10: Sun Aug 24 21:26:27 CEST 2008
+
+ Fixes:
+
+ - INET socket scope error, introduced by 3.09
+ rt.cpan.org#38689 [Matt Moen]
+
+version 3.09: Fri Aug 22 16:38:25 CEST 2008
+
+ Fixes:
+
+ - return status of append_message reversed.
+ rt.cpan.org#36726 [Jakob Hirsch]
+
+ - no line-breaks in base64 encoded strings when logging-in
+ rt.cpan.org#36879 [David Jonas]
+
+ - fix MD5 authentication.
+ rt.cpan.org#38654 [Thomas Jarosch]
+
+ Improvements:
+
+ - extensions and clean-ups in examples/imap_to_mbox.pl by
+ [Ralph Sobek]
+
+ - an absolute path as Server setting will open a local ::UNIX
+ socket, not an ::INET
+ rt.cpan.org#38655 [Thomas Jarosch]
+
version 3.08: Tue Jun 3 09:36:24 CEST 2008
Fixes:
@@ -13,7 +42,7 @@
- oops, distribution released with OODoc/oodist, not make dist.
[Randy Harmon]
- - fix parsing of body-structure information for multi-parts
+ - fix parsing of body-structure information for multi-parts.
rt.cpan.org#36279 [Doug Claar]
Improvements:
Modified: branches/upstream/libmail-imapclient-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/META.yml?rev=24880&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/META.yml (original)
+++ branches/upstream/libmail-imapclient-perl/current/META.yml Sat Sep 6 18:46:33 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Mail-IMAPClient
-version: 3.08
+version: 3.10
abstract: IMAP4 client library
license: ~
author: ~
Modified: branches/upstream/libmail-imapclient-perl/current/examples/imap_to_mbox.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/examples/imap_to_mbox.pl?rev=24880&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/examples/imap_to_mbox.pl (original)
+++ branches/upstream/libmail-imapclient-perl/current/examples/imap_to_mbox.pl Sat Sep 6 18:46:33 2008
@@ -1,140 +1,205 @@
-#!/usr/bin/perl
+#!/usr/local/bin/perl
# (c) 1999 Thomas Stromberg, Research Triangle Commerce, Inc.
-# This software is protected by the BSD License. No rights reserved anyhow.
+# This software is protected by the BSD License. No rights reserved anyhow.
# <tstromberg at rtci.com>
# DESC: Reads a users IMAP folders, and converts them to mbox
# Good for an interim switch-over from say, Exchange to Cyrus IMAP.
-# $Header: /usr/CvsRepository/Mail/IMAPClient/examples/imap_to_mbox.pl,v 19991216.7 2002/08/23 13:29:48 dkernen Exp $
-
# TODO:
-# -----
-# lsub instead of list option
# correct header printing From
-
-use Mail::IMAPClient; # a nice set of perl libs for imap
-use Getopt::Std; # for the command-line overrides. good for user
-use File::Path; # create full file paths. (yummy!)
-use File::Basename; # find a nice basename for a folder.
+use Mail::IMAPClient; # a nice set of perl libs for imap
+use IO::Socket::SSL;
+use Getopt::Std; # for the command-line overrides. good for user
+use File::Path; # create full file paths. (yummy!)
+use File::Basename; # find a nice basename for a folder.
+use Date::Manip; # to create From header date
$| = 1;
-# Config for the imap migration kit.
-
-getopts('u:p:P:s:i:f::b:dh');
-
-if ($opt_h) {
- # print help here
-}
-
-$SERVER = $opt_s || 'mailhost';
+sub connect_imap();
+sub find_folders();
+sub write_folder($$$$);
+
+# Config for the imap migration kit.
+
+getopts('u:p:P:s:i:f::b:c:W:Sdh');
+
+$SSL = $opt_S || 0;
+$SERVER = $opt_s || 'dell2';
$USER = $opt_u || 'userid';
$PASSWORD = $opt_p || 'password';
$PORT = $opt_P || '143';
-$INBOX_PATH = $opt_i || "./mail/$USER";
-$FOLDERS_PATH = $opt_f || "./folders/$USER";
-$DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl';
+$INBOX_PATH = $opt_i || "/var/mail/$USER";
+$FOLDERS_PATH = $opt_f || "./folders/$USER";
+$DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl';
$READ_DELIMITER = $opt_r || '/';
-$WRITE_DELIMITER= $opt_w || '/';
-$BANNED_CHARS = $opt_b || '.|^|%';
+$WRITE_DELIMITER= $opt_w || '/';
+$WRITE_MODE = $opt_W || '>';
+$BANNED_CHARS = $opt_b || '.|^|%';
+$CR = $opt_c || "\r";
+$DELETE = $opt_D || 0;
$DEBUG = $opt_d || "0";
-
+$FAIL = 0;
+
+if ($opt_h) {
+ # print help here
+ print "imap_to_mbox.pl - with the following optional arguments:
+ -S Use an SSL connection (default $SSL)
+ -s <s> Server specification (default $SERVER)
+ -u <u> User login (default $USER)
+ -p <p> User password
+ -P <p> Server Port (default $PORT)
+ -i <i> INBOX save path (default $INBOX_PATH)
+ -f <f> Save path for other folders (default $FOLDERS_PATH)
+ -m <r> Regexp for IMAP folders not to be saved:
+ $DONT_MOVE
+ -r <r> Read delimiter (default \"$READ_DELIMITER\")
+ -w <w> Write Delimiter (default \"$WRITE_DELIMITER\")
+ -b <b> Banned chars (default \"$BANNED_CHARS\")
+ -c <c> Strip CRs from saved files [for Unix] (default \"$CR\")
+ -D Delete files downloaded on server
+ -d Debug mode (default $DEBUG)\n";
+ exit 1;
+}
## do our magic tricks ######################################
-&connect_imap;
-&find_folders;
-
-
-sub connect_imap {
- $imap = Mail::IMAPClient->new(
- Server => "$SERVER",
- User => "$USER",
- Password => "$PASSWORD",
- Port => "$PORT",
- Debug => "$DEBUG",
- Uid => '0',
- Clear => '1',
- )
- || die ("Could not connect to $SERVER:$PORT with $USER: $! $?\n");
-};
-
-sub find_folders {
- my (@folders, $folder, $message_count, $new_folder, $path);
-
- @folders = $imap->folders;
- push(@folders, "INBOX");
- foreach $folder (@folders) {
- $message_count = $imap->message_count($folder);
- if (! $message_count) {
- print("* $folder is empty, skipping.\n");
- next;
- }
- if ($folder =~ /$DONT_MOVE/) {
- print("! $folder matches DONT_MOVE ruleset, skipping\n");
- next;
- }
-
- $new_folder = $folder;
- $new_folder =~ s/\./_/g;
- $new_folder =~ s/$READ_DELIMITER/$WRITE_DELIMITER/g;
- if ($new_folder eq "INBOX") {
- $path = "$INBOX_PATH";
- } else {
- $path = "$FOLDERS_PATH/$new_folder";
- }
-
- printf("x %4i %-45.45s => %s", $message_count, $folder, $path);
- &write_folder($folder, $path, 1, $message_count);
- }
-}
-
-
-sub write_folder {
- my($folder, $newpath, $first_message, $last_message) = @_;
- my($msg_header, $msg_body);
-
- $imap->select($folder) || print("Could not examine $folder: $!");
- $new_dir = dirname($newpath);
- $new_file = basename($newpath);
- mkpath("$new_dir", 0700) unless -d "$new_dir";
- open(mbox, ">$newpath");
-
- for ($i=$first_message; $i<$last_message+1; ++$i) {
- if ( ($i / 25) == int($i / 25) ) { print("."); }
- $msg_header = $imap->fetch($i, "FAST") || print("Could not fetch header $i from $folder\n");
- $msg_rfc822 = $imap->fetch($i, "RFC822") || print("Could not fetch RFC822 $i from $folder\n");
- undef $start;
- foreach (@$msg_rfc822) {
- if (($_ =~ /: /) && (! $message)) { ++$message; print(mbox "From imap\@to.mbox Wed Oct 27 17:02:53 1999\n");}
- if (/^\)\r/) { undef $message; print(mbox "\n\n");}
- next unless $message;
- $_ =~ s/\r$//;
- print(mbox "$_");
-
- }
- }
- close(mbox);
- print("\n");
-}
-
-# $Id: imap_to_mbox.pl,v 19991216.7 2002/08/23 13:29:48 dkernen Exp $
-# $Log: imap_to_mbox.pl,v $
+connect_imap;
+find_folders;
+
+
+sub connect_imap()
+{
+# Open an SSL session to the IMAP server
+# Handles the SSL setup, and gives us back a socket
+ my $ssl;
+ if ($opt_S) {
+ $ssl=IO::Socket::SSL->new(
+ PeerHost => "$SERVER:imaps"
+# , SSL_version => 'SSLv2'
+ );
+
+ defined $ssl
+ or die "Error connecting to $SERVER:imaps - $@";
+
+ $ssl->autoflush(1);
+ }
+
+ $imap = Mail::IMAPClient->new(
+ Socket => ($opt_S ? $ssl : 0),
+ Server => $SERVER,
+ User => $USER,
+ Password => $PASSWORD,
+ Port => $PORT,
+ Debug => $DEBUG,
+ Uid => 0,
+ Clear => 1,
+ )
+ or die ("Could not connect to $SERVER:$PORT with $USER: $! $?\n");
+}
+
+sub find_folders()
+{
+ my @folders = $imap->folders;
+# push(@folders, "INBOX");
+
+ foreach my $folder (@folders)
+ { my $message_count = $imap->message_count($folder);
+ if(! $message_count) {
+ print("* $folder is empty, skipping.\n");
+ next;
+ }
+ if($folder =~ /$DONT_MOVE/) {
+ print("! $folder matches DONT_MOVE ruleset, skipping\n");
+ next;
+ }
+
+ my $new_folder = $folder;
+ $new_folder =~ s/\./_/g;
+ $new_folder =~ s/\Q$READ_DELIMITER/$WRITE_DELIMITER/g;
+ my $path
+ = $new_folder eq "INBOX" ? "$INBOX_PATH"
+ : "$FOLDERS_PATH/$new_folder";
+
+ printf "x %4i %-45.45s => %s", $message_count, $folder, $path;
+ write_folder $folder, $path, 1, $message_count;
+ }
+}
+
+sub write_folder($$$$)
+{ my($folder, $newpath, $first_message, $last_message) = @_;
+
+ $imap->select($folder)
+ or warn "Could not examine $folder: $!";
+
+ my $new_dir = dirname $newpath;
+ my $new_file = basename $newpath;
+
+ -d $new_dir
+ or mkpath($new_dir, 0700)
+ or die "Cannot create $new_dir:$!\n";
+
+ open mbox, $WRITE_MODE, $newpath
+ or die "Cannot create file $newpath: $!\n";
+
+ for (my $i=$first_message; $i<$last_message+1; ++$i)
+ { my $date = UnixDate(ParseDate($imap->internaldate($i)),
+ "%a %b %e %T %Y");
+ my $user = $imap->get_envelope($i)->from_addresses;
+ $user =~ s/^.*\<([^>]*)\>/$1/;
+ $user = '-' unless $user;
+ print '.' if $i%25 == 0;
+
+ my $msg_header = $imap->fetch($i, "FAST")
+ or warn "Could not fetch header $i from $folder\n";
+
+ my $msg_rfc822 = $imap->fetch($i, "RFC822");
+ unless($msg_rfc822)
+ { warn "Could not fetch RFC822 $i from $folder\n";
+ $FAIL=1
+ }
+
+ undef $start;
+ foreach (@$msg_rfc822)
+ { if($_ =~ /\: / && !$message)
+ { ++$message;
+ print mbox "From $user $date\n";
+ }
+
+ if(/^\)\r/)
+ { undef $message;
+ print mbox "\n\n";
+ }
+ next unless $message;
+ $_ =~ s/\r$//;
+ $_ = $imap->Strip_cr($_) if $CR;
+ print mbox "$_";
+
+ }
+ if($DELETE && ! $FAIL)
+ { $imap->delete_message($i)
+ or warn "Could not delete_message: $@\n";
+ $FAIL = 0;
+ }
+ }
+
+ close mbox
+ or die "Write errors to $newpath: $!\n";
+
+ if($DELETE)
+ { $imap->expunge($folder)
+ or warn "Could not expunge: $@\n";
+ }
+
+ print "\n";
+}
+
+# 2008/08/07 - Added SSL support, fixed From header printing, and CR
+# elimination (sobek)
+#
# Revision 19991216.7 2002/08/23 13:29:48 dkernen
#
-# Modified Files: Changes IMAPClient.pm INSTALL MANIFEST Makefile Makefile.PL README Todo test.txt
-# Made changes to create version 2.1.6.
-# Modified Files:
-# imap_to_mbox.pl populate_mailbox.pl
-# Added Files:
-# cleanTest.pl migrate_mbox.pl
-#
# Revision 19991216.6 2000/12/11 21:58:52 dkernen
-#
-# Modified Files:
-# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl
-# imap_to_mbox.pl populate_mailbox.pl
-# to add CVS data
#
# Revision 19991216.5 1999/12/16 17:19:12 dkernen
# Bring up to same level
@@ -150,5 +215,3 @@
#
# Revision 1.3 1999/11/23 17:51:06 dkernen
# Committing version 1.06 distribution copy
-#
-
Modified: branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm?rev=24880&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pm Sat Sep 6 18:46:33 2008
@@ -2,7 +2,7 @@
use strict;
package Mail::IMAPClient;
-our $VERSION = '3.08';
+our $VERSION = '3.10';
use Mail::IMAPClient::MessageSet;
@@ -19,6 +19,7 @@
use Errno qw/EAGAIN/;
use List::Util qw/first min max sum/;
use MIME::Base64;
+use File::Spec ();
use constant Unconnected => 0;
use constant Connected => 1; # connected; not logged in
@@ -240,15 +241,26 @@
my $port = $self->Port;
my @timeout = $self->Timeout ? (Timeout => $self->Timeout) : ();
- $self->_debug("Connecting to $server port $port");
-
- my $sock = IO::Socket::INET->new
- ( PeerAddr => $server
- , PeerPort => $port
- , Proto => 'tcp'
- , Debug => $self->Debug
- , @timeout
- );
+ my $sock;
+
+ if(File::Spec->file_name_is_absolute($server))
+ { $self->_debug("Connecting to unix socket $server");
+ $sock = IO::Socket::UNIX->new
+ ( Peer => $server
+ , Debug => $self->Debug
+ , @timeout
+ );
+ }
+ else
+ { $self->_debug("Connecting to $server port $port");
+ $sock = IO::Socket::INET->new
+ ( PeerAddr => $server
+ , PeerPort => $port
+ , Proto => 'tcp'
+ , Debug => $self->Debug
+ , @timeout
+ );
+ }
unless($sock)
{ $self->LastError("Unable to connect to $server: $@");
@@ -2478,7 +2490,7 @@
}
$fh->close;
- $code eq 'OK' ? undef
+ $code ne 'OK' ? undef
: defined $uid ? $uid
: $self;
}
@@ -2525,7 +2537,7 @@
{ my ($code, $client) = @_;
use Digest::HMAC_MD5;
my $hmac = Digest::HMAC_MD5::hmac_md5_hex(decode_base64($code), $client->Password);
- encode_base64($client->User." ".$hmac);
+ encode_base64($client->User." ".$hmac, '');
};
}
elsif($scheme eq 'DIGEST-MD5')
@@ -2550,7 +2562,7 @@
my $conn = $sasl->client_new('imap', 'localhost', '');
my $answer = $conn->client_step(decode_base64 $code);
- encode_base64($response, '')
+ encode_base64($answer, '')
if defined $answer;
};
}
@@ -2558,7 +2570,7 @@
{ $response ||= sub
{ my ($code, $client) = @_;
encode_base64($client->User . chr(0) . $client->Proxy
- . chr(0) . $client->Password);
+ . chr(0) . $client->Password, '');
};
}
elsif($scheme eq 'NTLM')
Modified: branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod?rev=24880&op=diff
==============================================================================
--- branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod (original)
+++ branches/upstream/libmail-imapclient-perl/current/lib/Mail/IMAPClient.pod Sat Sep 6 18:46:33 2008
@@ -902,8 +902,9 @@
returns a pointer to the B<IMAPClient> object.
The I<Server> parameter must be set (either during L<new> method
-invocation or via the L<Server> object method) before invoking
-B<connect>. If the L<Server> parameter is supplied to the L<new> method
+invocation or via the L<Server> object method) before invoking B<connect>.
+When the parameter is an absolute file path, an UNIX socket will get
+opened. If the L<Server> parameter is supplied to the L<new> method
then B<connect> is implicitly called during object construction.
The B<connect> method sets the state of the object to C<connected> if
@@ -3716,10 +3717,7 @@
=back
This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU
-General Public License or the Artistic License for more details. All your
-base are belong to us.
-
-
-my $not_void = 0; # This is a documentation-only file!
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU General Public
+License or the Artistic License for more details. All your base are
+belong to us.
More information about the Pkg-perl-cvs-commits
mailing list