mirror of
https://github.com/imapsync/imapsync.git
synced 2025-07-24 11:08:15 +02:00
1.836
This commit is contained in:
Nick Bebout
parent
3afeea4a16
commit
8d76e44c5e
243 changed files with 57452 additions and 10330 deletions
|
|
@ -1,13 +1,13 @@
|
|||
|
||||
<!-- $Id: bc-payment.html,v 1.4 2016/07/27 21:51:57 gilles Exp gilles $ -->
|
||||
<!-- $Id: bc-payment.html,v 1.11 2017/09/11 03:04:46 gilles Exp gilles $ -->
|
||||
|
||||
<a
|
||||
class="coinbase-button"
|
||||
data-code="5c8544cfe2d17f92401e60fd9299760f"
|
||||
href="https://www.coinbase.com/checkouts/5c8544cfe2d17f92401e60fd9299760f">Pay with bitcoins</a>
|
||||
class="coinbase-button"
|
||||
href="https://www.coinbase.com/checkouts/5c8544cfe2d17f92401e60fd9299760f"
|
||||
data-code="5c8544cfe2d17f92401e60fd9299760f">Pay with bitcoins</a>
|
||||
<script
|
||||
src="https://www.coinbase.com/assets/button.js"
|
||||
type="text/javascript">
|
||||
</script>
|
||||
|
||||
|
||||
<!-- data-code="5c8544cfe2d17f92401e60fd9299760f" -->
|
||||
|
|
|
|||
|
|
@ -18,21 +18,24 @@
|
|||
<link rel="icon" type="image/png" href="../S/images/logo_imapsync_s.png" />
|
||||
<link href="../S/style.css" rel="stylesheet" type="text/css"/>
|
||||
|
||||
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1" />
|
||||
<!--
|
||||
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" />
|
||||
-->
|
||||
</head>
|
||||
|
||||
<body>
|
||||
|
||||
<h1>Similar softwares <a id="similar" href="../#TOP"><small>(back to menu)</small></a>
|
||||
<h1>Similar software <a id="similar" href="../#TOP"><small>(back to menu)</small></a>
|
||||
</h1>
|
||||
|
||||
|
||||
<ul>
|
||||
<li> <b>imapsync</b>: <a href="https://github.com/imapsync/imapsync">https://github.com/imapsync/imapsync</a> (imapsync copy, sometimes delayed)</li>
|
||||
<li> imap_tools: <a href="http://www.athensfbc.com/imap_tools/">http://www.athensfbc.com/imap_tools/</a></li>
|
||||
<li> davmail: <a href="http://davmail.sourceforge.net/">http://davmail.sourceforge.net/</a></li>
|
||||
|
||||
<li> <b>imapsync</b>: <a href="https://github.com/imapsync/imapsync">https://github.com/imapsync/imapsync</a> (this is an imapsync copy, sometimes delayed)</li>
|
||||
<li> imap_tools: <a href="https://web-beta.archive.org/web/20160927133511/http://www.athensfbc.com/imap-tools">http://www.athensfbc.com/imap_tools/</a></li>
|
||||
<li> imaputils: <a href="http://code.google.com/p/imaputils/">http://code.google.com/p/imaputils/</a> (imap_tools fork)</li>
|
||||
<li> Doveadm-Sync: <a href="http://wiki2.dovecot.org/Tools/Doveadm/Sync">http://wiki2.dovecot.org/Tools/Doveadm/Sync</a> ( Dovecot sync tool )</li>
|
||||
<li> davmail: <a href="http://davmail.sourceforge.net/">http://davmail.sourceforge.net/</a></li>
|
||||
<li> <b>offlineimap</b>: <a href="http://offlineimap.org/">http://offlineimap.org/</a></li>
|
||||
<li> <b>mbsync</b>: <a href="http://isync.sourceforge.net/">http://isync.sourceforge.net/</a></li>
|
||||
<li> mailsync: <a href="http://mailsync.sourceforge.net/">http://mailsync.sourceforge.net/</a></li>
|
||||
|
|
@ -50,7 +53,7 @@
|
|||
<li> wonko_imapsync: <a href="http://web.archive.org/web/20130807173030/http://wonko.com/post/ruby_script_to_sync_email_from_any_imap_server_to_gmail">http://wonko.com/article/554</a> (superseded by larch)</li>
|
||||
<li> pop2imap: <a href="http://www.linux-france.org/prj/pop2imap/">http://www.linux-france.org/prj/pop2imap/</a></li>
|
||||
<li> exchange-away: <a href="http://exchange-away.sourceforge.net/">http://exchange-away.sourceforge.net/</a></li>
|
||||
<li> SyncBackPro <a href="http://www.2brightsparks.com/syncback/sbpro.html">http://www.2brightsparks.com/syncback/sbpro.html</a></li>
|
||||
<li> SyncBackPro <a href="http://www.2brightsparks.com/syncback/sbpro.html">http://www.2brightsparks.com/syncback/sbpro.html</a></li>
|
||||
|
||||
</ul>
|
||||
|
||||
|
|
@ -62,11 +65,13 @@ I don't think they use Imapsync.
|
|||
Prices are given par mailbox and may be outdated (December 2011).</p>
|
||||
|
||||
<ul>
|
||||
<li> French Ovh imapcopy <b>0 EUR</b>: <a href="https://ssl0.ovh.net/fr/imapcopy/">https://ssl0.ovh.net/fr/imapcopy/</a></li>
|
||||
<li> Imapsync.love <b>0 EUR</b>: <a href="http://imapsync.love/">http://imapsync.love/</a></li>
|
||||
<li> French Ovh imapcopy <b>0 EUR</b>: <a href="https://mail.ovh.net/fr/imapcopy/">https://mail.ovh.net/fr/imapcopy/</a></li>
|
||||
<li> Turkish imapcopy.net <b>0 TRY</b>: <a href="http://imapcopy.net/">http://imapcopy.net/</a></li>
|
||||
<li> Rackspace migration <b>0 USD</b>: <a href="http://www.rackspace.com/email-hosting/migrations">http://www.rackspace.com/email-hosting/migrations</a></li>
|
||||
<li> Movemymail free for the first and 5 USD thereafter: <a href="https://movemymail.net">https://movemymail.net</a> .</li>
|
||||
<li> Migrationwiz 10 USD: <a href="https://www.bittitan.com/products/migrationwiz/">https://www.bittitan.com/products/migrationwiz/</a></li>
|
||||
<li> Rackspace migration 5 USD: <a href="http://www.rackspace.com/email-hosting/migrations">http://www.rackspace.com/email-hosting/migrations</a></li>
|
||||
<li> Migrationwiz 10 USD: <a href="https://www.bittitan.com/products/migrationwiz/">https://www.bittitan.com/products/migrationwiz/</a>
|
||||
(See this remarkable comparaison <a href="https://blog.bittitan.com/imapsync-vs-migrationwiz/">Imapsync vs Migrationwiz</a>!)</li>
|
||||
<li> Audriga Gmbh 9.99 EUR: <a href="https://www.email-umzug.de/en.html">https://www.email-umzug.de/</a></li>
|
||||
<li> Yippiemove 15 USD: <a href="http://www.yippiemove.com">http://www.yippiemove.com/</a></li>
|
||||
<li> Dell ondemand-migration-for-email (price unknown): <a href="http://software.dell.com/products/ondemand-migration-for-email/">http://software.dell.com/products/ondemand-migration-for-email/</a></li>
|
||||
|
|
@ -100,7 +105,7 @@ alt="Viewable With Any Browser" />
|
|||
<!--#config timefmt="%D" -->
|
||||
<!--#config timefmt="%A %B %d, %Y" -->
|
||||
<b>This document last modified on <!--#echo var="LAST_MODIFIED" --></b>
|
||||
($Id: external.shtml,v 1.7 2016/03/19 22:05:24 gilles Exp gilles $)<br/>
|
||||
($Id: external.shtml,v 1.20 2017/09/11 03:04:46 gilles Exp gilles $)<br/>
|
||||
<a href="#TOP">Top of the page</a>
|
||||
</p>
|
||||
|
||||
|
|
|
|||
BIN
S/favicon.ico
Normal file
BIN
S/favicon.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 9.3 KiB |
57
S/guestbook.shtml
Executable file
57
S/guestbook.shtml
Executable file
|
|
@ -0,0 +1,57 @@
|
|||
<!DOCTYPE html>
|
||||
|
||||
<html lang="en" id="TOP">
|
||||
<!-- $Id: guestbook.shtml,v 1.17 2017/09/11 03:04:46 gilles Exp gilles $ -->
|
||||
<head>
|
||||
<meta charset="utf-8" >
|
||||
<title>Imapsync Guestbook</title>
|
||||
<meta name="author" content="Gilles LAMIRAL" >
|
||||
<meta name="copyright" content="None">
|
||||
|
||||
<link rel="icon" type="image/png" href="../S/images/logo_imapsync_s.png" >
|
||||
<link href="../S/style.css" rel="stylesheet" type="text/css">
|
||||
|
||||
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1" />
|
||||
<!--
|
||||
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" />
|
||||
-->
|
||||
|
||||
|
||||
<!--
|
||||
The link to the HTML5Shiv must be placed in the <head> element, after any stylesheets
|
||||
http://www.w3schools.com/html/html5_browsers.asp
|
||||
-->
|
||||
<!--[if lt IE 9]>
|
||||
<script src="http://cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv.js"></script>
|
||||
<![endif]-->
|
||||
|
||||
</head>
|
||||
|
||||
<body>
|
||||
|
||||
<section>
|
||||
<h1>Imapsync Guestbook</h1>
|
||||
<p>
|
||||
Your name is mandatory to post but don't hesitate to use a pseudonym!
|
||||
Email address is optional, only needed if you want a personnal reply.
|
||||
Have fun!
|
||||
</p>
|
||||
|
||||
|
||||
Feedback can also be done via:
|
||||
<div class="email">An email to the author <a href="mailto:gilles.lamiral@laposte.net?subject=Imapsync_feedback" class="email">gilles.lamiral@laposte.net</a></div>
|
||||
<div class="twitter">A tweet to the author <a href="https://twitter.com/imapsync" class="website">@imapsync</a></div>
|
||||
|
||||
|
||||
<!-- Bravenet Embedded Service Code -->
|
||||
<script src="http://apps.bravenet.com/go.js?service=guestbook;id=1;usernum=2854376880" type="text/javascript" charset="utf-8">
|
||||
</script>
|
||||
|
||||
</section>
|
||||
|
||||
<footer>
|
||||
</footer>
|
||||
</body>
|
||||
</html>
|
||||
|
||||
BIN
S/images/logo_imapsync_Xn.png
Normal file
BIN
S/images/logo_imapsync_Xn.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 43 KiB |
BIN
S/images/logo_paypal.png
Normal file
BIN
S/images/logo_paypal.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 8 KiB |
3
S/images/memo
Normal file
3
S/images/memo
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
|
||||
convert logo_imapsync.png -gravity center -resize 190x60 -extent 190x60 logo_paypal.png
|
||||
|
||||
BIN
S/imap_tools.V1.333/IMAP_Tools_User_Guide.pdf
Normal file
BIN
S/imap_tools.V1.333/IMAP_Tools_User_Guide.pdf
Normal file
Binary file not shown.
959
S/imap_tools.V1.333/IMAPtoMbox.pl
Executable file
959
S/imap_tools.V1.333/IMAPtoMbox.pl
Executable file
|
|
@ -0,0 +1,959 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# $Header: /mhub4/sources/imap-tools/IMAPtoMbox.pl,v 1.13 2015/04/30 12:22:21 rick Exp $
|
||||
|
||||
#######################################################################
|
||||
# Program name IMAPtoMbox.pl #
|
||||
# Written by Rick Sanders #
|
||||
# #
|
||||
# Description #
|
||||
# #
|
||||
# IMAPtoMbox.pl is a utility for extracting all of the mailboxes #
|
||||
# in an IMAP user's account and writing them to files in the #
|
||||
# Unix mbx format. #
|
||||
# #
|
||||
# The user supplies host/user/password information and the name #
|
||||
# of a directory on the local system. IMAPtoMbox.pl connects to #
|
||||
# the IMAP server and extracts each message in the user's IMAP #
|
||||
# mailboxes. Those messages are written to a file with the same #
|
||||
# name as the IMAP mailbox into the specified directory. #
|
||||
# #
|
||||
# For example: #
|
||||
# ./IMAPtoMbox.pl -i localhost/rfs/mypass -m /var/rfs #
|
||||
# #
|
||||
# Optional arguments: #
|
||||
# -d debug #
|
||||
# -L logfile #
|
||||
# -M IMAP mailbox list (dumps the specified mailboxes, see #
|
||||
# the usage notes for syntax) #
|
||||
#######################################################################
|
||||
|
||||
use Socket;
|
||||
use FileHandle;
|
||||
use Fcntl;
|
||||
use Getopt::Std;
|
||||
use MIME::Base64 qw(encode_base64 decode_base64);
|
||||
use POSIX qw(strftime);
|
||||
|
||||
#################################################################
|
||||
# Main program. #
|
||||
#################################################################
|
||||
|
||||
$dir = init();
|
||||
|
||||
# Get list of all messages on the source host by Message-Id
|
||||
#
|
||||
connectToHost($sourceHost, \$dst);
|
||||
login($sourceUser,$sourcePwd, $dst);
|
||||
namespace($dst, \$prefix, \$delim );
|
||||
|
||||
@mbxs = getMailboxList( $prefix, $dst );
|
||||
$number = $#mbxs + 1;
|
||||
|
||||
foreach $mbx ( @mbxs ) {
|
||||
my $mbxname = $mbx;
|
||||
$mbxname =~ s/^$prefix// if $prefix;
|
||||
@msgs = ();
|
||||
Log(" $mbxname");
|
||||
getMsgList( $mbx, \@msgs, $dst );
|
||||
|
||||
$mbxname =~ s/\//-/g; # Don't allow slashes in filename
|
||||
$mbxfn = "$dir/$mbxname";
|
||||
if ( !open (M, ">>$mbxfn") ) {
|
||||
Log("Error opening $mbxfn: $!");
|
||||
print STDERR "Error opening $mbxfn\n";
|
||||
next;
|
||||
}
|
||||
$summary{"$mbx"} = 0;
|
||||
next if $#msgs == -1;
|
||||
existingMboxMsgs( $mbxfn, \%mbox ) if $no_duplicates;
|
||||
$copied=0;
|
||||
next unless @msgs;
|
||||
foreach $msg ( @msgs ) {
|
||||
fetchMsg( $msg, $mbx, $dst, \$message, \$msgid );
|
||||
if ( $no_duplicates and ($mbox{"$msgid"}) ) {
|
||||
Log(" message $msgid already exists") if $debug;
|
||||
next;
|
||||
}
|
||||
print M $message;
|
||||
print M "\n";
|
||||
$copied++;
|
||||
|
||||
if ( $msgs_per_folder ) {
|
||||
# opt_F allows us to limit number of messages copied per folder
|
||||
last if $copied == $msgs_per_folder;
|
||||
}
|
||||
}
|
||||
close M;
|
||||
|
||||
`chown $opt_o "$mbxfn"` if $opt_o; # Set ownership
|
||||
|
||||
$summary{"$mbx"} = $copied++;
|
||||
}
|
||||
|
||||
logout( $dst );
|
||||
|
||||
Log("\nSummary of results");
|
||||
while (($x,$y) = each(%summary)) {
|
||||
$x =~ s/^$prefix// if $prefix;
|
||||
$line = pack("A50 A10\n", $x, $y);
|
||||
push( @summary, $line );
|
||||
}
|
||||
@summary = sort @summary;
|
||||
foreach $line ( @summary ) {
|
||||
Log("$line");
|
||||
}
|
||||
|
||||
exit;
|
||||
|
||||
|
||||
sub init {
|
||||
|
||||
$os = $ENV{'OS'};
|
||||
|
||||
$dir = processArgs();
|
||||
|
||||
$timeout = 60 if !$timeout;
|
||||
|
||||
# Open the logFile
|
||||
#
|
||||
if ( $logfile ) {
|
||||
if ( !open(LOG, ">> $logfile")) {
|
||||
print STDOUT "Can't open $logfile: $!\n";
|
||||
}
|
||||
select(LOG); $| = 1;
|
||||
}
|
||||
Log("\n$0 starting");
|
||||
Log("arguments i = $opt_i m = $opt_m");
|
||||
Log("Mailfiles will be written to $dir");
|
||||
# Determine whether we have SSL support via openSSL and IO::Socket::SSL
|
||||
$ssl_installed = 1;
|
||||
eval 'use IO::Socket::SSL';
|
||||
if ( $@ ) {
|
||||
$ssl_installed = 0;
|
||||
}
|
||||
|
||||
$installed = 1;
|
||||
@date_modules = qw( DateTime Date::Parse POSIX);
|
||||
foreach $module ( @date_modules ) {
|
||||
eval "use $module";
|
||||
if ( $@ ) {
|
||||
print STDERR "The Perl module $module is not installed. Please install it before proceeding.\n";
|
||||
$installed = 0;
|
||||
}
|
||||
}
|
||||
exit if $installed == 0;
|
||||
|
||||
return $dir;
|
||||
}
|
||||
|
||||
#
|
||||
# sendCommand
|
||||
#
|
||||
# This subroutine formats and sends an IMAP protocol command to an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub sendCommand
|
||||
{
|
||||
local($fd) = shift @_;
|
||||
local($cmd) = shift @_;
|
||||
|
||||
print $fd "$cmd\r\n";
|
||||
|
||||
if ($showIMAP) { Log (">> $cmd",2); }
|
||||
}
|
||||
|
||||
#
|
||||
# readResponse
|
||||
#
|
||||
# This subroutine reads and formats an IMAP protocol response from an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub readResponse {
|
||||
|
||||
local($fd) = shift @_;
|
||||
|
||||
$response = <$fd>;
|
||||
chop $response;
|
||||
$response =~ s/\r//g;
|
||||
push (@response,$response);
|
||||
if ($showIMAP) { Log ("<< $response",2); }
|
||||
}
|
||||
|
||||
#
|
||||
# Log
|
||||
#
|
||||
# This subroutine formats and writes a log message to STDERR.
|
||||
#
|
||||
|
||||
sub Log {
|
||||
|
||||
my $str = shift;
|
||||
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
|
||||
if ($year < 99) { $yr = 2000; }
|
||||
else { $yr = 1900; }
|
||||
$line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n",
|
||||
$mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str);
|
||||
print LOG "$line";
|
||||
print STDERR "$str\n";
|
||||
|
||||
}
|
||||
|
||||
# connectToHost
|
||||
#
|
||||
# Make a connection to a host
|
||||
#
|
||||
sub connectToHost {
|
||||
|
||||
my $host = shift;
|
||||
my $conn = shift;
|
||||
|
||||
Log("Connecting to $host") if $debug;
|
||||
|
||||
($host,$port) = split(/:/, $host);
|
||||
$port = 143 unless $port;
|
||||
|
||||
# We know whether to use SSL for ports 143 and 993. For any
|
||||
# other ones we'll have to figure it out.
|
||||
$mode = sslmode( $host, $port );
|
||||
|
||||
if ( $mode eq 'SSL' ) {
|
||||
unless( $ssl_installed == 1 ) {
|
||||
warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
exit;
|
||||
}
|
||||
Log("Attempting an SSL connection") if $debug;
|
||||
$$conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
Domain => AF_INET,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
$error = IO::Socket::SSL::errstr();
|
||||
Log("Error connecting to $host: $error");
|
||||
warn("Error connecting to $host: $error");
|
||||
exit;
|
||||
}
|
||||
} else {
|
||||
# Non-SSL connection
|
||||
Log("Attempting a non-SSL connection") if $debug;
|
||||
$$conn = IO::Socket::INET->new(
|
||||
Proto => "tcp",
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
Log("Error connecting to $host:$port: $@");
|
||||
warn "Error connecting to $host:$port: $@";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
Log("Connected to $host on port $port");
|
||||
|
||||
select( $$conn ); $| = 1;
|
||||
while (1) {
|
||||
readResponse ( $$conn );
|
||||
if ( $response =~ /^\* OK/i ) {
|
||||
last;
|
||||
}
|
||||
else {
|
||||
Log ("Bad response from host on port $port: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
Log ("connected to $host") if $debug;
|
||||
|
||||
select( $$conn ); $| = 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub sslmode {
|
||||
|
||||
my $host = shift;
|
||||
my $port = shift;
|
||||
my $mode;
|
||||
|
||||
# Determine whether to make an SSL connection
|
||||
# to the host. Return 'SSL' if so.
|
||||
|
||||
if ( $port == 143 ) {
|
||||
# Standard non-SSL port
|
||||
return '';
|
||||
} elsif ( $port == 993 ) {
|
||||
# Standard SSL port
|
||||
return 'SSL';
|
||||
}
|
||||
|
||||
unless ( $ssl_installed ) {
|
||||
# We don't have SSL installed on this machine
|
||||
return '';
|
||||
}
|
||||
|
||||
# For any other port we need to determine whether it supports SSL
|
||||
|
||||
my $conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
if ( $conn ) {
|
||||
close( $conn );
|
||||
$mode = 'SSL';
|
||||
} else {
|
||||
$mode = '';
|
||||
}
|
||||
|
||||
return $mode;
|
||||
}
|
||||
|
||||
|
||||
# trim
|
||||
#
|
||||
# remove leading and trailing spaces from a string
|
||||
sub trim {
|
||||
|
||||
local (*string) = @_;
|
||||
|
||||
$string =~ s/^\s+//;
|
||||
$string =~ s/\s+$//;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
# login
|
||||
#
|
||||
# login in at the IMAP host with the user's name and password
|
||||
#
|
||||
sub login {
|
||||
|
||||
my $user = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
if ( $admin_user ) {
|
||||
# An AUTHENTICATE = PLAIN login has been requested
|
||||
($authuser,$authpwd) = split(/:/, $admin_user );
|
||||
login_plain( $user, $authuser, $authpwd, $conn ) or exit;
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ( $pwd =~ /^oauth2:(.+)/i ) {
|
||||
$token = $1;
|
||||
Log("password is an OAUTH2 token") if $debug;
|
||||
login_xoauth2( $user, $token, $conn );
|
||||
return 1;
|
||||
}
|
||||
|
||||
sendCommand ($conn, "1 LOGIN $user \"$pwd\"");
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
if ($response =~ /^1 OK/i) {
|
||||
last;
|
||||
}
|
||||
elsif ($response =~ /NO/) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
}
|
||||
Log("Logged in as $user") if $debug;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# login_plain
|
||||
#
|
||||
# login in at the source host with the user's name and password. If provided
|
||||
# with administrator credential, use them as this eliminates the need for the
|
||||
# user's password.
|
||||
#
|
||||
sub login_plain {
|
||||
|
||||
my $user = shift;
|
||||
my $admin = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it.
|
||||
|
||||
if ( !$admin ) {
|
||||
# Log in as the user
|
||||
$admin = $user
|
||||
}
|
||||
|
||||
$login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd);
|
||||
$login_str = encode_base64("$login_str", "");
|
||||
$len = length( $login_str );
|
||||
|
||||
sendCommand ($conn, "1 AUTHENTICATE PLAIN" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
last if $response =~ /\+/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
sendCommand ($conn, "$login_str" );
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
|
||||
if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) {
|
||||
# The destination is an Exchange server
|
||||
$exchange = 1;
|
||||
Log("The destination is an Exchange server");
|
||||
}
|
||||
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
|
||||
# logout
|
||||
#
|
||||
# log out from the host
|
||||
#
|
||||
sub logout {
|
||||
|
||||
my $conn = shift;
|
||||
|
||||
++$lsn;
|
||||
undef @response;
|
||||
sendCommand ($conn, "$lsn LOGOUT");
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^$lsn OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected LOGOUT response: $response");
|
||||
last;
|
||||
}
|
||||
}
|
||||
close $conn;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
# getMailboxList
|
||||
#
|
||||
# get a list of the user's mailboxes from the source host
|
||||
#
|
||||
sub getMailboxList {
|
||||
|
||||
my $prefix = shift;
|
||||
my $conn = shift;
|
||||
my @mbxs;
|
||||
|
||||
# Get a list of the user's mailboxes
|
||||
#
|
||||
|
||||
Log("Get list of user's mailboxes",2) if $debugMode;
|
||||
|
||||
if ( $mbxList ) {
|
||||
foreach $mbx ( split(/,/, $mbxList) ) {
|
||||
$mbx = $prefix . $mbx if $prefix;
|
||||
if ( $opt_r ) {
|
||||
# Get all submailboxes under the ones specified
|
||||
$mbx .= '*';
|
||||
@mailboxes = listMailboxes( $mbx, $conn);
|
||||
push( @mbxs, @mailboxes );
|
||||
} else {
|
||||
push( @mbxs, $mbx );
|
||||
}
|
||||
}
|
||||
} else {
|
||||
# Get all mailboxes
|
||||
@mbxs = listMailboxes( '*', $conn);
|
||||
}
|
||||
|
||||
return @mbxs;
|
||||
}
|
||||
|
||||
# listMailboxes
|
||||
#
|
||||
sub listMailboxes {
|
||||
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
|
||||
sendCommand ($conn, "1 LIST \"\" \"$mbx\"");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
%nosel_mbxs = ();
|
||||
@mbxs = ();
|
||||
for $i (0 .. $#response) {
|
||||
$response[$i] =~ s/\s+/ /;
|
||||
if ( $response[$i] =~ /"$/ ) {
|
||||
$response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i;
|
||||
$mbx = $3;
|
||||
} else {
|
||||
$response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i;
|
||||
$mbx = $3;
|
||||
}
|
||||
$mbx =~ s/^\s+//; $mbx =~ s/\s+$//;
|
||||
|
||||
next if $response[$i] =~ /NOSELECT/i;
|
||||
|
||||
if (($mbx =~ /^\#/) && ($user ne 'anonymous')) {
|
||||
# Skip public mbxs unless we are migrating them
|
||||
next;
|
||||
}
|
||||
if ($mbx =~ /^\./) {
|
||||
# Skip mailboxes starting with a dot
|
||||
next;
|
||||
}
|
||||
push ( @mbxs, $mbx ) if $mbx ne '';
|
||||
}
|
||||
|
||||
return @mbxs;
|
||||
}
|
||||
|
||||
# getMsgList
|
||||
#
|
||||
# Get a list of the user's messages in the indicated mailbox on
|
||||
# the source host
|
||||
#
|
||||
sub getMsgList {
|
||||
|
||||
my $mailbox = shift;
|
||||
my $msgs = shift;
|
||||
my $conn = shift;
|
||||
my $seen;
|
||||
my $empty;
|
||||
my $msgnum;
|
||||
my $from;
|
||||
|
||||
trim( *mailbox );
|
||||
sendCommand ($conn, "1 EXAMINE \"$mailbox\"");
|
||||
undef @response;
|
||||
$empty=0;
|
||||
select($conn);
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ / 0 EXISTS/i ) { $empty=1; }
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
# print STDERR "response $response\n";
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected response: $response");
|
||||
# print STDERR "Error: $response\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
return if $empty;
|
||||
|
||||
Log("Fetch the header info") if $debug;
|
||||
|
||||
sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (From Date)])");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
# print STDERR "response $response\n";
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
undef @msgs;
|
||||
undef $flags;
|
||||
for $i (0 .. $#response) {
|
||||
$seen=0;
|
||||
$_ = $response[$i];
|
||||
|
||||
last if /OK FETCH complete/;
|
||||
|
||||
if ( $response[$i] =~ /^From:\s*(.+)/i ) {
|
||||
$from = $1 if !$from;
|
||||
}
|
||||
|
||||
if ( $response[$i] =~ /^Date: (.+)/ ) {
|
||||
# Firstly assume that the date is formatted correctly and split accordingly.
|
||||
$origdate = $1;
|
||||
$date = $origdate;
|
||||
$date =~ s/,//g;
|
||||
($date) = split(/-/, $date);
|
||||
($wkday,$mday,$mon,$yr,$time) = split(/\s+/, $date);
|
||||
$mday = '0' . $mday if length($mday) == 1;
|
||||
$date = "$wkday $mon $mday $time $yr";
|
||||
|
||||
# Now actually parse the date to check that it is formatted correctly.
|
||||
# Assume GMT if timezone is omitted.
|
||||
my @parseddate = strptime ($origdate, "GMT");
|
||||
# If the number of seconds were omitted then assume 0.
|
||||
if ( !defined $parseddate[0] ) {
|
||||
$parseddate[0] = 0;
|
||||
}
|
||||
# If the year was given as 2 digits, assume it can't be less than the UNIX epoch of 1970.
|
||||
if ( $parseddate[5] < 70 ) {
|
||||
$parseddate[5] += 100;
|
||||
}
|
||||
# strptime returns the timezone as an offset in seconds. Convert back to +/-HHMM format.
|
||||
if ( $parseddate[6] < 0 ) {
|
||||
$parseddate[6] = sprintf ("-%02d%02d", int (-$parseddate[6] / 3600), int ((-$parseddate[6] % 3600) / 60));
|
||||
} else {
|
||||
$parseddate[6] = sprintf ("+%02d%02d", int ($parseddate[6] / 3600), int (($parseddate[6] % 3600) / 60));
|
||||
}
|
||||
eval '
|
||||
$dt = DateTime->new (second => $parseddate[0],
|
||||
minute => $parseddate[1],
|
||||
hour => $parseddate[2],
|
||||
day => $parseddate[3],
|
||||
month => $parseddate[4] + 1, # needs to be 1-12 and not 0-11.
|
||||
year => $parseddate[5] + 1900, # needs to be an absolute year.
|
||||
time_zone => $parseddate[6]);
|
||||
';
|
||||
|
||||
if ( length( $@ ) != 0 ) {
|
||||
# The date is too badly formatted to fix. Use today's date instead.
|
||||
Log("The date $date is badly formatted, using today's date instead");
|
||||
$date = strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time()));
|
||||
} else {
|
||||
$newdate = $dt->strftime ("%a %b %d %H:%M:%S %Y");
|
||||
|
||||
# Compare the parsed date with that formed by assuming the date was correctly formatted.
|
||||
# Let the user know if they differ so they can judge if the calculated date is correct.
|
||||
if ( $date ne $newdate ) {
|
||||
Log ("badly formatted date in message: " . $origdate);
|
||||
Log (" calculated replacement date as: " . $newdate);
|
||||
$date = $newdate;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $response[$i] =~ /\* (.+) FETCH/ ) {
|
||||
($msgnum) = split(/\s+/, $1);
|
||||
}
|
||||
|
||||
if ( $response[$i] =~ /^\)/ or ( $response[$i] =~ /\)\)$/ ) ) {
|
||||
push (@$msgs,"$msgnum|$from|$date");
|
||||
$msgnum = $date = '';
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
#
|
||||
## Fetch a message from the IMAP server
|
||||
#
|
||||
|
||||
sub fetchMsg {
|
||||
|
||||
my $msg = shift;
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
my $message = shift;
|
||||
my $msgid = shift;
|
||||
|
||||
my ($msgnum,$from,$date) = split(/\|/, $msg);
|
||||
Log(" Fetching msg $msgnum...") if $debug;
|
||||
sendCommand ($conn, "1 EXAMINE \"$mbx\"");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
last if ( $response =~ /^1 OK/i );
|
||||
}
|
||||
|
||||
sendCommand( $conn, "1 FETCH $msgnum (rfc822)");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
$size = length($message);
|
||||
last;
|
||||
}
|
||||
elsif ( $response =~ /^1 NO|^1 BAD/ ) {
|
||||
last;
|
||||
}
|
||||
elsif ($response =~ /message number out of range/i) {
|
||||
Log ("Error fetching uid $uid: out of range",2);
|
||||
$stat=0;
|
||||
last;
|
||||
}
|
||||
elsif ($response =~ /Bogus sequence in FETCH/i) {
|
||||
Log ("Error fetching uid $uid: Bogus sequence in FETCH",2);
|
||||
$stat=0;
|
||||
last;
|
||||
}
|
||||
elsif ( $response =~ /message could not be processed/i ) {
|
||||
Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)");
|
||||
push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)");
|
||||
$stat=0;
|
||||
last;
|
||||
}
|
||||
elsif
|
||||
($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) {
|
||||
($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i);
|
||||
$cc = 0;
|
||||
$$message = "";
|
||||
while ( $cc < $len ) {
|
||||
$n = 0;
|
||||
$n = read ($conn, $segment, $len - $cc);
|
||||
if ( $n == 0 ) {
|
||||
Log ("unable to read $len bytes");
|
||||
return 0;
|
||||
}
|
||||
$$message .= $segment;
|
||||
$cc += $n;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$$message =~ s/\r//g;
|
||||
if ( $$message !~ /^From / ) {
|
||||
$$message = "From $from $date\n$$message";
|
||||
}
|
||||
|
||||
# Some servers don't like single-digit days in the timestamp
|
||||
# in the "From " line
|
||||
for $i (0 .. 9 ) {
|
||||
$$message =~ s/ $i / 0$i /;
|
||||
}
|
||||
|
||||
$$message =~ /Message-ID:\s*\<(.+)\>/i;
|
||||
$$msgid = $1 if $1;
|
||||
|
||||
}
|
||||
|
||||
#
|
||||
## Display the usage message
|
||||
#
|
||||
|
||||
sub usage {
|
||||
|
||||
print STDOUT "\nusage:";
|
||||
print STDOUT "IMAPtoMbox.pl -i Host/User/Password -m <dir> [-M] [-d] [-I] [-o <user>] \n";
|
||||
print STDOUT "\n Optional arguments:\n";
|
||||
print STDOUT " -M IMAP mailbox list (eg \"Inbox, Drafts, Notes\". Default all mailboxes)\n";
|
||||
print STDOUT " -o <user> sets ownership of mailfile\n";
|
||||
print STDOUT " -A <admin_user:admin_pwd>\n";
|
||||
print STDOUT " -L logfile\n";
|
||||
print STDOUT " -d debug\n";
|
||||
print STDOUT " -I show IMAP protocal exchanges\n";
|
||||
print STDOUT " -n don't copy if message already exists in mbox file\n";
|
||||
print STDOUT " -r include submailboxes when used with -M\n\n";
|
||||
exit;
|
||||
|
||||
}
|
||||
|
||||
#
|
||||
## Get command-line arguments
|
||||
#
|
||||
sub processArgs {
|
||||
|
||||
if ( !getopts( "di:L:m:hM:Io:nrF:A:" ) ) {
|
||||
usage();
|
||||
}
|
||||
|
||||
($sourceHost,$sourceUser,$sourcePwd) = split(/\//, $opt_i);
|
||||
$mbxList = $opt_M;
|
||||
$logfile = $opt_L;
|
||||
$dir = $opt_m;
|
||||
$owner = $opt_o;
|
||||
$no_duplicates = 1 if $opt_n;
|
||||
$submbxs = 1 if $opt_r;
|
||||
$debug = 1 if $opt_d;
|
||||
$showIMAP = 1 if $opt_I;
|
||||
$msgs_per_folder = $opt_F;
|
||||
$admin_user = $opt_A;
|
||||
|
||||
if ( !$dir ) {
|
||||
print "You must specify the file directory where messages will\n";
|
||||
print "be written using the -m argument.\n\n";
|
||||
usage();
|
||||
exit;
|
||||
}
|
||||
|
||||
if ( !-d $dir ) {
|
||||
print "Fatal Error: $dir does not exist\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
usage() if $opt_h;
|
||||
|
||||
return $dir;
|
||||
|
||||
}
|
||||
|
||||
sub existingMboxMsgs {
|
||||
|
||||
my $mbx = shift;
|
||||
my $msgs = shift;
|
||||
|
||||
|
||||
# Build an index of messages in an mbox by messageID.
|
||||
|
||||
%$msgs = ();
|
||||
unless ( open(F, "<$mbx") ) {
|
||||
Log("Error opening mbox file $mbox: $!");
|
||||
return;
|
||||
}
|
||||
|
||||
while ( <F> ) {
|
||||
if ( /^Message-ID:\s*\<(.+)\>/i ) {
|
||||
$$msgs{"$1"} = 1;
|
||||
}
|
||||
}
|
||||
close F;
|
||||
|
||||
}
|
||||
|
||||
sub namespace {
|
||||
|
||||
my $conn = shift;
|
||||
my $prefix = shift;
|
||||
my $delimiter = shift;
|
||||
|
||||
# Query the server with NAMESPACE so we can determine its
|
||||
# mailbox prefix (if any) and hierachy delimiter.
|
||||
|
||||
@response = ();
|
||||
sendCommand( $conn, "1 NAMESPACE");
|
||||
while ( 1 ) {
|
||||
readResponse( $conn );
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
} elsif ( $response =~ /NO|BAD/i ) {
|
||||
Log("Unexpected response to NAMESPACE command: $response");
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
foreach $_ ( @response ) {
|
||||
if ( /NAMESPACE/i ) {
|
||||
my $i = index( $_, '((' );
|
||||
my $j = index( $_, '))' );
|
||||
my $val = substr($_,$i+2,$j-$i-3);
|
||||
($val) = split(/\)/, $val);
|
||||
($$prefix,$$delimiter) = split( / /, $val );
|
||||
$$prefix =~ s/"//g;
|
||||
$$delimiter =~ s/"//g;
|
||||
last;
|
||||
}
|
||||
last if /^NO|^BAD/;
|
||||
}
|
||||
|
||||
if ( $debug ) {
|
||||
Log("prefix $$prefix");
|
||||
Log("delim $$delimiter");
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub mailboxName {
|
||||
|
||||
my $mbx = shift;
|
||||
my $prefix = shift;
|
||||
my $delim = shift;
|
||||
|
||||
# Adjust the mailbox name if necessary using the mailbox hierarchy
|
||||
# prefix and delimiter.
|
||||
|
||||
$mbx =~ s#^$srcPrefix##;
|
||||
$mbx = $srcmbx;
|
||||
|
||||
if ( $srcDelim ne $dstDelim ) {
|
||||
# Need to substitute the dst's hierarchy delimiter for the src's one
|
||||
$srcDelim = '\\' . $srcDelim if $srcDelim eq '.';
|
||||
$dstDelim = "\\" . $dstDelim if $dstDelim eq '.';
|
||||
$dstmbx =~ s#$srcDelim#$dstDelim#g;
|
||||
$dstmbx =~ s/\\//g;
|
||||
}
|
||||
if ( $srcPrefix ne $dstPrefix ) {
|
||||
# Replace the source prefix with the dest prefix
|
||||
$dstmbx =~ s#^$srcPrefix## if $srcPrefix;
|
||||
if ( $dstPrefix ) {
|
||||
$dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX';
|
||||
}
|
||||
$dstDelim = "\\$dstDelim" if $dstDelim eq '.';
|
||||
$dstmbx =~ s#^$dstDelim##;
|
||||
}
|
||||
|
||||
if ( $root_mbx ) {
|
||||
# Put folders under a 'root' folder on the dst
|
||||
$dstDelim =~ s/\./\\./g;
|
||||
$dstmbx =~ s/^$dstPrefix//;
|
||||
$dstmbx =~ s/^$dstDelim//;
|
||||
$dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx;
|
||||
if ( uc($srcmbx) eq 'INBOX' ) {
|
||||
# Special case for the INBOX
|
||||
$dstmbx =~ s/INBOX$//i;
|
||||
$dstmbx =~ s/$dstDelim$//;
|
||||
}
|
||||
$dstmbx =~ s/\\//g;
|
||||
}
|
||||
|
||||
return $dstmbx;
|
||||
}
|
||||
|
||||
# login_xoauth2
|
||||
#
|
||||
# login in at the source host with the user's name and an XOAUTH2 token.
|
||||
#
|
||||
sub login_xoauth2 {
|
||||
|
||||
my $user = shift;
|
||||
my $token = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = XOAUTH2 login
|
||||
|
||||
$login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", '');
|
||||
sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^\+ (.+)/ ) {
|
||||
$error = decode_base64( $1 );
|
||||
Log("XOAUTH authentication as $user failed: $error");
|
||||
exit;
|
||||
}
|
||||
last if $response =~ /^1 OK/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
Log("login complete") if $debug;
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
1189
S/imap_tools.V1.333/MboxtoIMAP.pl
Executable file
1189
S/imap_tools.V1.333/MboxtoIMAP.pl
Executable file
File diff suppressed because it is too large
Load diff
1238
S/imap_tools.V1.333/delIMAPdups.pl
Executable file
1238
S/imap_tools.V1.333/delIMAPdups.pl
Executable file
File diff suppressed because it is too large
Load diff
1251
S/imap_tools.V1.333/delIMAPdups.pl.files
Normal file
1251
S/imap_tools.V1.333/delIMAPdups.pl.files
Normal file
File diff suppressed because it is too large
Load diff
1304
S/imap_tools.V1.333/delete_imap_mailboxes.pl
Executable file
1304
S/imap_tools.V1.333/delete_imap_mailboxes.pl
Executable file
File diff suppressed because it is too large
Load diff
924
S/imap_tools.V1.333/dumptoIMAP.pl
Executable file
924
S/imap_tools.V1.333/dumptoIMAP.pl
Executable file
|
|
@ -0,0 +1,924 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# $Header: /mhub4/sources/imap-tools/dumptoIMAP.pl,v 1.14 2014/11/10 12:55:43 rick Exp $
|
||||
|
||||
#######################################################################
|
||||
# dumptoIMAP.pl is used to load the mailboxes and messages exported #
|
||||
# from an IMAP server by the imapdump.pl script. See usage() notes #
|
||||
# for a list of the arguments used to run it. #
|
||||
# #
|
||||
# If you ran imapdump.pl -S host/user/pwd -f /tmp/BACKUP #
|
||||
# then you could restore all of the mailboxes & messages with the #
|
||||
# following command: #
|
||||
# #
|
||||
# ./dumptoIMAP.pl -i host/user/pwd -D /tmp/BACKUP #
|
||||
# #
|
||||
# If you wanted to restore just the INBOX and the Sent mailboxes you #
|
||||
# would add -m "INBOX,Sent" #
|
||||
#######################################################################
|
||||
|
||||
use Socket;
|
||||
use IO::Socket;
|
||||
use FileHandle;
|
||||
use File::Find;
|
||||
use Fcntl;
|
||||
use Getopt::Std;
|
||||
use MIME::Base64 qw(decode_base64 encode_base64);
|
||||
|
||||
init();
|
||||
|
||||
connectToHost($imapHost, \$conn);
|
||||
|
||||
if ( $imapUser =~ /(.+):(.+)/ ) {
|
||||
# An AUTHENTICATE = PLAIN login has been requested
|
||||
$imapUser = $1;
|
||||
$authuser = $2;
|
||||
login_plain( $imapUser, $authuser, $imapPwd, $conn ) or exit;
|
||||
} else {
|
||||
if ( !login($imapUser,$imapPwd, $conn) ) {
|
||||
Log("Check your username and password");
|
||||
print STDOUT "Login failed: Check your username and password\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
if ( $opt_y ) {
|
||||
# User-supplied mbx delimiter and prefix
|
||||
($mbx_delim,$prefix) = split(/\s+/, $opt_y );
|
||||
} else {
|
||||
namespace( $conn, \$prefix, \$mbx_delim );
|
||||
}
|
||||
|
||||
get_mbx_list( $dir, \@mbxs );
|
||||
|
||||
foreach $mbx ( @mbxs ) {
|
||||
$copied=0;
|
||||
Log("mbx = >$mbx<") if $debug;
|
||||
Log("Full path to $mbx is >$dir/$mbx<") if $debug;
|
||||
|
||||
Log("Copying messages from $dir/$mbx to $mbx folder on the IMAP server");
|
||||
get_messages( "$dir/$mbx", \@msgs );
|
||||
$n = scalar @msgs;
|
||||
Log("$mbx has $n messages");
|
||||
|
||||
$mbx =~ s/\//$mbx_delim/g unless $mbx_delim eq '/';
|
||||
if ( $prefix ) {
|
||||
$mbx = $prefix . $mbx unless $mbx =~ /^INBOX/i;
|
||||
}
|
||||
|
||||
foreach $_ ( @msgs ) {
|
||||
next unless $_;
|
||||
my $msg; my $date; my $seen;
|
||||
|
||||
$flags = '';
|
||||
if ( /,S$/ ) {
|
||||
$flags = '\\SEEN';
|
||||
}
|
||||
|
||||
Log("Opening $_") if $debug;
|
||||
unless ( open(F, "<$_") ) {
|
||||
Log("Error opening $_: $!");
|
||||
next;
|
||||
}
|
||||
Log("Opened $_ successfully") if $debug;
|
||||
while( <F> ) {
|
||||
# Log("Reading line $_") if $debug;
|
||||
if ( /^Date: (.+)/ ) {
|
||||
$date = $1 unless $date;
|
||||
$date =~ s/\r|\m//g;
|
||||
chomp $date;
|
||||
}
|
||||
s/\r+$//g;
|
||||
$msg .= $_;
|
||||
chomp $msg;
|
||||
$msg .= "\r\n";
|
||||
|
||||
}
|
||||
close F;
|
||||
|
||||
$size = length( $msg );
|
||||
Log("The message is $size bytes") if $debug;
|
||||
# Log("$msg") if $debug;
|
||||
|
||||
if ( $size == 0 ) {
|
||||
Log("The message file is empty") if $debug;
|
||||
next;
|
||||
}
|
||||
|
||||
$copied++ if insertMsg($mbx, \$msg, $flags, $date, $conn);
|
||||
|
||||
if ( $msgs_per_folder ) {
|
||||
# opt_F allows us to limit number of messages copied per folder
|
||||
last if $copied == $msgs_per_folder;
|
||||
}
|
||||
|
||||
if ( $copied/100 == int($copied/100)) { Log("$copied messages copied "); }
|
||||
}
|
||||
$total += $copied;
|
||||
|
||||
}
|
||||
|
||||
logout( $conn );
|
||||
|
||||
Log("Done. $total messages were copied.");
|
||||
exit;
|
||||
|
||||
|
||||
sub init {
|
||||
|
||||
if ( !getopts('m:L:i:dD:Ix:XRA:F:y:') ) {
|
||||
usage();
|
||||
}
|
||||
|
||||
$mbx_list = $opt_m;
|
||||
$dir = $opt_D;
|
||||
$logfile = $opt_L;
|
||||
$extension = $opt_x;
|
||||
$debug = 1 if $opt_d;
|
||||
$showIMAP = 1 if $opt_I;
|
||||
$admin_user = $opt_A;
|
||||
$msgs_per_folder = $opt_F;
|
||||
($imapHost,$imapUser,$imapPwd) = split(/\//, $opt_i);
|
||||
|
||||
if ( $logfile ) {
|
||||
if ( ! open (LOG, ">> $logfile") ) {
|
||||
print "Can't open logfile $logfile: $!\n";
|
||||
$logfile = '';
|
||||
}
|
||||
}
|
||||
Log("Starting");
|
||||
|
||||
# Determine whether we have SSL support via openSSL and IO::Socket::SSL
|
||||
$ssl_installed = 1;
|
||||
eval 'use IO::Socket::SSL';
|
||||
if ( $@ ) {
|
||||
$ssl_installed = 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub usage {
|
||||
|
||||
print "Usage: dumptoIMAP.pl\n";
|
||||
print " -D <path to the mailboxes>\n";
|
||||
print " -i <server/username/password>\n";
|
||||
print " (if the password is an OAUTH2 token then prefix it with 'oauth2:'\n";
|
||||
print " [-A <admin_user:admin_pwd>\n";
|
||||
print " [-m <mbx1,mbx2,..,mbxn> copy only the listed mailboxes]\n";
|
||||
print " [-x <extension> Import only files with this extension\n";
|
||||
print " [-L <logfile>]\n";
|
||||
print " [-d debug]\n";
|
||||
print " [-I log IMAP protocol exchanges]\n";
|
||||
|
||||
}
|
||||
|
||||
sub get_messages {
|
||||
|
||||
my $dir = shift;
|
||||
my $msgs = shift;
|
||||
|
||||
# Get a list of the message files
|
||||
|
||||
if ( $debug ) {
|
||||
Log("Get list of messages in $dir");
|
||||
}
|
||||
|
||||
opendir D, $dir;
|
||||
my @files = readdir( D );
|
||||
closedir D;
|
||||
foreach $_ ( @files ) {
|
||||
next if /^\./;
|
||||
if ( $extension ) {
|
||||
next unless /$extension$/;
|
||||
}
|
||||
Log(" $dir/$_") if $debug;
|
||||
push( @$msgs, "$dir/$_");
|
||||
}
|
||||
}
|
||||
|
||||
# Print a message to STDOUT and to the logfile if
|
||||
# the opt_L option is present.
|
||||
#
|
||||
|
||||
sub Log {
|
||||
|
||||
my $line = shift;
|
||||
my $msg;
|
||||
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time);
|
||||
$msg = sprintf ("%.2d-%.2d-%.4d.%.2d:%.2d:%.2d %s",
|
||||
$mon + 1, $mday, $year + 1900, $hour, $min, $sec, $line);
|
||||
|
||||
if ( $logfile ) {
|
||||
print LOG "$msg\n";
|
||||
}
|
||||
print STDOUT "$line\n";
|
||||
|
||||
}
|
||||
|
||||
# connectToHost
|
||||
#
|
||||
# Make an IMAP connection to a host
|
||||
#
|
||||
sub connectToHost {
|
||||
|
||||
my $host = shift;
|
||||
my $conn = shift;
|
||||
|
||||
Log("Connecting to $host") if $debug;
|
||||
|
||||
$sockaddr = 'S n a4 x8';
|
||||
($name, $aliases, $proto) = getprotobyname('tcp');
|
||||
($host,$port) = split(/:/, $host);
|
||||
$port = 143 unless $port;
|
||||
|
||||
if ($host eq "") {
|
||||
Log ("no remote host defined");
|
||||
close LOG;
|
||||
exit (1);
|
||||
}
|
||||
|
||||
# We know whether to use SSL for ports 143 and 993. For any
|
||||
# other ones we'll have to figure it out.
|
||||
$mode = sslmode( $host, $port );
|
||||
|
||||
if ( $mode eq 'SSL' ) {
|
||||
unless( $ssl_installed == 1 ) {
|
||||
warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
exit;
|
||||
}
|
||||
Log("Attempting an SSL connection") if $debug;
|
||||
$$conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
Domain => AF_INET,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
$error = IO::Socket::SSL::errstr();
|
||||
Log("Error connecting to $host: $error");
|
||||
exit;
|
||||
}
|
||||
} else {
|
||||
# Non-SSL connection
|
||||
Log("Attempting a non-SSL connection") if $debug;
|
||||
$$conn = IO::Socket::INET->new(
|
||||
Proto => "tcp",
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
Log("Error connecting to $host:$port: $@");
|
||||
warn "Error connecting to $host:$port: $@";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
select( $$conn ); $| = 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
#
|
||||
# login in at the IMAP host with the user's name and password
|
||||
#
|
||||
sub login {
|
||||
|
||||
my $user = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
if ( $admin_user ) {
|
||||
# An AUTHENTICATE = PLAIN login has been requested
|
||||
($authuser,$authpwd) = split(/:/, $admin_user );
|
||||
login_plain( $user, $authuser, $authpwd, $conn ) or exit;
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ( $pwd =~ /^oauth2:(.+)/i ) {
|
||||
$token = $1;
|
||||
Log("password is an OAUTH2 token");
|
||||
login_xoauth2( $user, $token, $conn );
|
||||
return 1;
|
||||
}
|
||||
|
||||
Log("Logging in as $user") if $debug;
|
||||
$rsn = 1;
|
||||
sendCommand ($conn, "$rsn LOGIN $user $pwd");
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
if ($response =~ /^$rsn OK/i) {
|
||||
last;
|
||||
}
|
||||
elsif ($response =~ /NO/) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
Log("Logged in as $user") if $debug;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# login_plain
|
||||
#
|
||||
# login in at the source host with the user's name and password. If provided
|
||||
# with administrator credential, use them as this eliminates the need for the
|
||||
# user's password.
|
||||
#
|
||||
sub login_plain {
|
||||
|
||||
my $user = shift;
|
||||
my $admin = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it.
|
||||
|
||||
if ( !$admin ) {
|
||||
# Log in as the user
|
||||
$admin = $user
|
||||
}
|
||||
|
||||
$login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd);
|
||||
$login_str = encode_base64("$login_str", "");
|
||||
$len = length( $login_str );
|
||||
|
||||
# sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" );
|
||||
sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
last if $response =~ /^1 OK/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
# login_xoauth2
|
||||
#
|
||||
# login in at the source host with the user's name and an XOAUTH2 token.
|
||||
#
|
||||
sub login_xoauth2 {
|
||||
|
||||
my $user = shift;
|
||||
my $token = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = XOAUTH2 login
|
||||
|
||||
$login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", '');
|
||||
sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^\+ (.+)/ ) {
|
||||
$error = decode_base64( $1 );
|
||||
Log("XOAUTH authentication as $user failed: $error");
|
||||
exit;
|
||||
}
|
||||
last if $response =~ /^1 OK/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
Log("login complete") if $debug;
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
|
||||
# logout
|
||||
#
|
||||
# log out from the host
|
||||
#
|
||||
sub logout {
|
||||
|
||||
my $conn = shift;
|
||||
|
||||
++$lsn;
|
||||
undef @response;
|
||||
sendCommand ($conn, "$lsn LOGOUT");
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^$lsn OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected LOGOUT response: $response");
|
||||
last;
|
||||
}
|
||||
}
|
||||
close $conn;
|
||||
return;
|
||||
}
|
||||
|
||||
# readResponse
|
||||
#
|
||||
# This subroutine reads and formats an IMAP protocol response from an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub readResponse {
|
||||
|
||||
my $fd = shift;
|
||||
|
||||
$response = <$fd>;
|
||||
chop $response;
|
||||
$response =~ s/\r//g;
|
||||
push (@response,$response);
|
||||
Log(">>$response") if $showIMAP;
|
||||
}
|
||||
|
||||
#
|
||||
# sendCommand
|
||||
#
|
||||
# This subroutine formats and sends an IMAP protocol command to an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub sendCommand {
|
||||
|
||||
my $fd = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
print $fd "$cmd\r\n";
|
||||
Log(">>$cmd") if $showIMAP;
|
||||
}
|
||||
|
||||
#
|
||||
# insertMsg
|
||||
#
|
||||
# Append a message to an IMAP mailbox
|
||||
#
|
||||
|
||||
sub insertMsg {
|
||||
|
||||
my $mbx = shift;
|
||||
my $message = shift;
|
||||
my $flags = shift;
|
||||
my $date = shift;
|
||||
my $conn = shift;
|
||||
my ($lsn,$lenx);
|
||||
|
||||
Log(" Inserting message") if $debug;
|
||||
$lenx = length($$message);
|
||||
|
||||
# Log("$$message");
|
||||
|
||||
($date) = split(/\s*\(/, $date);
|
||||
if ( $date =~ /,/ ) {
|
||||
$date =~ /(.+),\s+(.+)\s+(.+)\s+(.+)\s+(.+)\s+(.+)/;
|
||||
$date = "$2-$3-$4 $5 $6";
|
||||
} else {
|
||||
$date =~ s/\s/-/;
|
||||
$date =~ s/\s/-/;
|
||||
}
|
||||
|
||||
# Create the mailbox unless we have already done so
|
||||
++$lsn;
|
||||
if ($destMbxs{"$mbx"} eq '') {
|
||||
sendCommand ($conn, "$lsn CREATE \"$mbx\"");
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^$rsn OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
if (!($response =~ /already exists|reserved mailbox name/i)) {
|
||||
Log ("WARNING: $response");
|
||||
}
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
$destMbxs{"$mbx"} = '1';
|
||||
|
||||
$flags =~ s/\\Recent//i;
|
||||
|
||||
if ( $date ) {
|
||||
sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}");
|
||||
} else {
|
||||
sendCommand ($conn, "1 APPEND \"$mbx\" ($flags) \{$lenx\}");
|
||||
}
|
||||
readResponse ($conn);
|
||||
if ( $response !~ /^\+/ ) {
|
||||
Log ("unexpected APPEND response to $cmd");
|
||||
push(@errors,"Error appending message to $mbx for $user");
|
||||
return 0;
|
||||
}
|
||||
|
||||
if ( $opt_X ) {
|
||||
print $conn "$$message\n";
|
||||
} else {
|
||||
print $conn "$$message\r\n";
|
||||
}
|
||||
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^$lsn OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected APPEND response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# getMsgList
|
||||
#
|
||||
# Get a list of the user's messages in the indicated mailbox on
|
||||
# the IMAP host
|
||||
#
|
||||
sub getMsgList {
|
||||
|
||||
my $mailbox = shift;
|
||||
my $msgs = shift;
|
||||
my $conn = shift;
|
||||
my $seen;
|
||||
my $empty;
|
||||
my $msgnum;
|
||||
|
||||
Log("Getting list of msgs in $mailbox") if $debug;
|
||||
trim( *mailbox );
|
||||
sendCommand ($conn, "$rsn EXAMINE \"$mailbox\"");
|
||||
undef @response;
|
||||
$empty=0;
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ / 0 EXISTS/i ) { $empty=1; }
|
||||
if ( $response =~ /^$rsn OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sendCommand ( $conn, "$rsn FETCH 1:* (uid flags internaldate body[header.fields (Message-Id)])");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^$rsn OK/i ) {
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
# Get a list of the msgs in the mailbox
|
||||
#
|
||||
undef @msgs;
|
||||
undef $flags;
|
||||
for $i (0 .. $#response) {
|
||||
$seen=0;
|
||||
$_ = $response[$i];
|
||||
|
||||
last if /OK FETCH complete/;
|
||||
|
||||
if ( $response[$i] =~ /FETCH \(UID / ) {
|
||||
$response[$i] =~ /\* ([^FETCH \(UID]*)/;
|
||||
$msgnum = $1;
|
||||
}
|
||||
|
||||
if ($response[$i] =~ /FLAGS/) {
|
||||
# Get the list of flags
|
||||
$response[$i] =~ /FLAGS \(([^\)]*)/;
|
||||
$flags = $1;
|
||||
$flags =~ s/\\Recent//i;
|
||||
}
|
||||
if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) {
|
||||
### $response[$i] =~ /INTERNALDATE (.+) ([^BODY]*)/i;
|
||||
$response[$i] =~ /INTERNALDATE (.+) BODY/i;
|
||||
$date = $1;
|
||||
$date =~ s/"//g;
|
||||
}
|
||||
if ( $response[$i] =~ /^Message-Id:/i ) {
|
||||
($label,$msgid) = split(/: /, $response[$i]);
|
||||
push (@$msgs,$msgid);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# trim
|
||||
#
|
||||
# remove leading and trailing spaces from a string
|
||||
sub trim {
|
||||
|
||||
local (*string) = @_;
|
||||
|
||||
$string =~ s/^\s+//;
|
||||
$string =~ s/\s+$//;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub sslmode {
|
||||
|
||||
my $host = shift;
|
||||
my $port = shift;
|
||||
my $mode;
|
||||
|
||||
# Determine whether to make an SSL connection
|
||||
# to the host. Return 'SSL' if so.
|
||||
|
||||
if ( $port == 143 ) {
|
||||
# Standard non-SSL port
|
||||
return '';
|
||||
} elsif ( $port == 993 ) {
|
||||
# Standard SSL port
|
||||
return 'SSL';
|
||||
}
|
||||
|
||||
unless ( $ssl_installed ) {
|
||||
# We don't have SSL installed on this machine
|
||||
return '';
|
||||
}
|
||||
|
||||
# For any other port we need to determine whether it supports SSL
|
||||
|
||||
my $conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
if ( $conn ) {
|
||||
close( $conn );
|
||||
$mode = 'SSL';
|
||||
} else {
|
||||
$mode = '';
|
||||
}
|
||||
|
||||
return $mode;
|
||||
}
|
||||
|
||||
sub get_mbx_list {
|
||||
|
||||
my $dir = shift;
|
||||
my $mbxs = shift;
|
||||
my %MBXS;
|
||||
|
||||
if ( $mbx_list ) {
|
||||
# The user has supplied a list of mailboxes.
|
||||
@$mbxs = split(/,/, $mbx_list );
|
||||
return;
|
||||
}
|
||||
|
||||
@dirs = ();
|
||||
push( @dirs, $dir );
|
||||
@messages = ();
|
||||
find( \&findMsgs, @dirs ); # Returns @messages
|
||||
foreach $fn ( @messages ) {
|
||||
Log("fn = $fn") if $debug;
|
||||
$fn =~ s/$dir//;
|
||||
Log("fn = $fn") if $debug;
|
||||
$i = rindex($fn,'/');
|
||||
Log("find rightmost slash, i = $i") if $debug;
|
||||
if ( $fn =~ /^\// ) {
|
||||
$mbx = substr($fn,1,$i);
|
||||
} else {
|
||||
$mbx = substr($fn,0,$i);
|
||||
}
|
||||
Log("mbx = $mbx") if $debug;
|
||||
$mbx =~ s/\/$//;
|
||||
Log("mbx = >$mbx<") if $debug;
|
||||
push( @$mbxs, $mbx ) if !$MBXS{"$mbx"};
|
||||
Log("Add >$mbx< to the list of mailboxes") if $debug;
|
||||
$MBXS{"$mbx"} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
sub findMsgs {
|
||||
|
||||
return if not -f;
|
||||
|
||||
my $fn = $File::Find::name;
|
||||
push( @messages, $fn );
|
||||
|
||||
}
|
||||
|
||||
sub namespace {
|
||||
|
||||
my $conn = shift;
|
||||
my $prefix = shift;
|
||||
my $delimiter = shift;
|
||||
|
||||
# Query the server with NAMESPACE so we can determine its
|
||||
# mailbox prefix (if any) and hierachy delimiter.
|
||||
|
||||
@response = ();
|
||||
sendCommand( $conn, "1 NAMESPACE");
|
||||
while ( 1 ) {
|
||||
readResponse( $conn );
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
} elsif ( $response =~ /^1 NO|^1 BAD|^\* BYE/i ) {
|
||||
Log("Unexpected response to NAMESPACE command: $response");
|
||||
Log("Cannot determine the mailbox delimiter and prefix. Use -y '<delimiter prefix>' to supply it");
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
foreach $_ ( @response ) {
|
||||
if ( /NAMESPACE/i ) {
|
||||
my $i = index( $_, '((' );
|
||||
my $j = index( $_, '))' );
|
||||
my $val = substr($_,$i+2,$j-$i-3);
|
||||
($val) = split(/\)/, $val);
|
||||
($$prefix,$$delimiter) = split( / /, $val );
|
||||
$$prefix =~ s/"//g;
|
||||
$$delimiter =~ s/"//g;
|
||||
|
||||
# Experimental
|
||||
if ( $public_mbxs ) {
|
||||
# Figure out the public mailbox settings
|
||||
/\(\((.+)\)\)\s+\(\((.+)\s+\(\((.+)\)\)/;
|
||||
$public = $3;
|
||||
$public =~ /"(.+)"\s+"(.+)"/;
|
||||
$src_public_prefix = $1 if $conn eq $src;
|
||||
$src_public_delim = $2 if $conn eq $src;
|
||||
$dst_public_prefix = $1 if $conn eq $dst;
|
||||
$dst_public_delim = $2 if $conn eq $dst;
|
||||
}
|
||||
last;
|
||||
}
|
||||
last if /^1 NO|^1 BAD|^\* BYE/;
|
||||
}
|
||||
|
||||
unless ( $$delimiter ) {
|
||||
# NAMESPACE command is not supported by the server
|
||||
# so we will have to figure it out another way.
|
||||
$delim = getDelimiter( $conn );
|
||||
$$delimiter = $delim;
|
||||
$$prefix = '';
|
||||
}
|
||||
|
||||
if ( $debug ) {
|
||||
Log("prefix >$$prefix<");
|
||||
Log("delim >$$delimiter<");
|
||||
}
|
||||
}
|
||||
|
||||
sub mailboxName {
|
||||
|
||||
my $srcmbx = shift;
|
||||
my $srcPrefix = shift;
|
||||
my $srcDelim = shift;
|
||||
my $dstPrefix = shift;
|
||||
my $dstDelim = shift;
|
||||
my $dstmbx;
|
||||
my $substChar = '_';
|
||||
|
||||
if ( $public_mbxs ) {
|
||||
my ($public_src,$public_dst) = split(/:/, $public_mbxs );
|
||||
# If the mailbox starts with the public mailbox prefix then
|
||||
# map it to the public mailbox destination prefix
|
||||
|
||||
if ( $srcmbx =~ /^$public_src/ ) {
|
||||
Log("src: $srcmbx is a public mailbox") if $debug;
|
||||
$dstmbx = $srcmbx;
|
||||
$dstmbx =~ s/$public_src/$public_dst/;
|
||||
Log("dst: $dstmbx") if $debug;
|
||||
return $dstmbx;
|
||||
}
|
||||
}
|
||||
|
||||
# Change the mailbox name if the user has supplied mapping rules.
|
||||
|
||||
if ( $mbx_map{"$srcmbx"} ) {
|
||||
$srcmbx = $mbx_map{"$srcmbx"}
|
||||
}
|
||||
|
||||
# Adjust the mailbox name if the source and destination server
|
||||
# have different mailbox prefixes or hierarchy delimiters.
|
||||
|
||||
if ( ($srcmbx =~ /[$dstDelim]/) and ($dstDelim ne $srcDelim) ) {
|
||||
# The mailbox name has a character that is used on the destination
|
||||
# as a mailbox hierarchy delimiter. We have to replace it.
|
||||
$srcmbx =~ s^[$dstDelim]^$substChar^g;
|
||||
}
|
||||
|
||||
if ( $debug ) {
|
||||
Log("src mbx $srcmbx");
|
||||
Log("src prefix $srcPrefix");
|
||||
Log("src delim $srcDelim");
|
||||
Log("dst prefix $dstPrefix");
|
||||
Log("dst delim $dstDelim");
|
||||
}
|
||||
|
||||
$srcmbx =~ s/^$srcPrefix//;
|
||||
$srcmbx =~ s/\\$srcDelim/\//g;
|
||||
|
||||
if ( ($srcPrefix eq $dstPrefix) and ($srcDelim eq $dstDelim) ) {
|
||||
# No adjustments necessary
|
||||
# $dstmbx = $srcmbx;
|
||||
if ( lc( $srcmbx ) eq 'inbox' ) {
|
||||
$dstmbx = $srcmbx;
|
||||
} else {
|
||||
$dstmbx = $srcPrefix . $srcmbx;
|
||||
}
|
||||
if ( $root_mbx ) {
|
||||
# Put folders under a 'root' folder on the dst
|
||||
$dstmbx =~ s/^$dstPrefix//;
|
||||
$dstDelim =~ s/\./\\./g;
|
||||
$dstmbx =~ s/^$dstDelim//;
|
||||
$dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx;
|
||||
if ( uc($srcmbx) eq 'INBOX' ) {
|
||||
# Special case for the INBOX
|
||||
$dstmbx =~ s/INBOX$//i;
|
||||
$dstmbx =~ s/$dstDelim$//;
|
||||
}
|
||||
$dstmbx =~ s/\\//g;
|
||||
}
|
||||
return $dstmbx;
|
||||
}
|
||||
|
||||
$srcmbx =~ s#^$srcPrefix##;
|
||||
$dstmbx = $srcmbx;
|
||||
|
||||
if ( $srcDelim ne $dstDelim ) {
|
||||
# Need to substitute the dst's hierarchy delimiter for the src's one
|
||||
$srcDelim = '\\' . $srcDelim if $srcDelim eq '.';
|
||||
$dstDelim = "\\" . $dstDelim if $dstDelim eq '.';
|
||||
$dstmbx =~ s#$srcDelim#$dstDelim#g;
|
||||
$dstmbx =~ s/\\//g;
|
||||
}
|
||||
if ( $srcPrefix ne $dstPrefix ) {
|
||||
# Replace the source prefix with the dest prefix
|
||||
$dstmbx =~ s#^$srcPrefix## if $srcPrefix;
|
||||
if ( $dstPrefix ) {
|
||||
$dstmbx = "$dstPrefix$dstmbx" unless uc($srcmbx) eq 'INBOX';
|
||||
}
|
||||
$dstDelim = "\\$dstDelim" if $dstDelim eq '.';
|
||||
$dstmbx =~ s#^$dstDelim##;
|
||||
}
|
||||
|
||||
if ( $root_mbx ) {
|
||||
# Put folders under a 'root' folder on the dst
|
||||
$dstDelim =~ s/\./\\./g;
|
||||
$dstmbx =~ s/^$dstPrefix//;
|
||||
$dstmbx =~ s/^$dstDelim//;
|
||||
$dstmbx = $dstPrefix . $root_mbx . $dstDelim . $dstmbx;
|
||||
if ( uc($srcmbx) eq 'INBOX' ) {
|
||||
# Special case for the INBOX
|
||||
$dstmbx =~ s/INBOX$//i;
|
||||
$dstmbx =~ s/$dstDelim$//;
|
||||
}
|
||||
$dstmbx =~ s/\\//g;
|
||||
}
|
||||
|
||||
return $dstmbx;
|
||||
}
|
||||
|
||||
sub getDelimiter {
|
||||
|
||||
my $conn = shift;
|
||||
my $delimiter;
|
||||
|
||||
# Issue a 'LIST "" ""' command to find out what the
|
||||
# mailbox hierarchy delimiter is.
|
||||
|
||||
sendCommand ($conn, '1 LIST "" ""');
|
||||
@response = '';
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
for $i (0 .. $#response) {
|
||||
$response[$i] =~ s/\s+/ /;
|
||||
if ( $response[$i] =~ /\* LIST \((.*)\) "(.*)" "(.*)"/i ) {
|
||||
$delimiter = $2;
|
||||
}
|
||||
}
|
||||
|
||||
return $delimiter;
|
||||
}
|
||||
|
||||
BIN
S/imap_tools.V1.333/flag_de.gif
Normal file
BIN
S/imap_tools.V1.333/flag_de.gif
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 953 B |
BIN
S/imap_tools.V1.333/flag_en.gif
Normal file
BIN
S/imap_tools.V1.333/flag_en.gif
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 884 B |
502
S/imap_tools.V1.333/imapCapability.pl
Executable file
502
S/imap_tools.V1.333/imapCapability.pl
Executable file
|
|
@ -0,0 +1,502 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# $Header: /mhub4/sources/imap-tools/imapCapability.pl,v 1.9 2014/10/15 21:42:58 rick Exp $
|
||||
|
||||
###########################################################################
|
||||
# Program name imapCapability.pl #
|
||||
# Written by Rick Sanders #
|
||||
# Date 23 December 2007 #
|
||||
# #
|
||||
# Description #
|
||||
# #
|
||||
# imapCapability.pl is a simple program for querying an IMAP #
|
||||
# server for a list of the IMAP features it supports. #
|
||||
# #
|
||||
# Description #
|
||||
# #
|
||||
# imapCapability is used to discover what services an IMAP #
|
||||
# server supports. #
|
||||
# #
|
||||
# Usage: imapCapability.pl -h <host> -u <user> -p <password> #
|
||||
# Optional arguments: -d (debug) -m (list folders) #
|
||||
# #
|
||||
# Sample output: #
|
||||
# The server supports the following IMAP capabilities: #
|
||||
# #
|
||||
# IMAP4 IMAP4REV1 ACL NAMESPACE UIDPLUS IDLE LITERAL+ QUOTA #
|
||||
# ID MULTIAPPEND LISTEXT CHILDREN BINARY LOGIN-REFERRALS #
|
||||
# UNSELECT STARTTLS AUTH=LOGIN AUTH=PLAIN AUTH=CRAM-MD5 #
|
||||
# AUTH=DIGEST-MD5 AUTH=GSSAPI AUTH=MSN AUTH=NTLM #
|
||||
###########################################################################
|
||||
|
||||
############################################################################
|
||||
# Copyright (c) 2012 Rick Sanders <rfs9999@earthlink.net> #
|
||||
# #
|
||||
# Permission to use, copy, modify, and distribute this software for any #
|
||||
# purpose with or without fee is hereby granted, provided that the above #
|
||||
# copyright notice and this permission notice appear in all copies. #
|
||||
# #
|
||||
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES #
|
||||
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF #
|
||||
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR #
|
||||
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES #
|
||||
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN #
|
||||
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF #
|
||||
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. #
|
||||
############################################################################
|
||||
|
||||
use Socket;
|
||||
use FileHandle;
|
||||
use Fcntl;
|
||||
use Getopt::Std;
|
||||
use IO::Socket;
|
||||
eval 'use Encode qw/encode decode/';
|
||||
eval 'use Encode::IMAPUTF7 qw/encode decode/';
|
||||
use MIME::Base64 qw(encode_base64 decode_base64);
|
||||
|
||||
#################################################################
|
||||
# Main program. #
|
||||
#################################################################
|
||||
|
||||
($host,$user,$pwd) = getArgs();
|
||||
|
||||
unless ( $host and $user and $pwd ) {
|
||||
print "Host:Port > ";
|
||||
chomp($host = <>);
|
||||
print "Username > ";
|
||||
chomp($user = <>);
|
||||
print "Password > ";
|
||||
chomp($pwd = <>);
|
||||
}
|
||||
|
||||
unless ( $host and $user and $pwd ) {
|
||||
print "Please supply host, username, and password\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
init();
|
||||
|
||||
connectToHost($host, \$conn) or exit;
|
||||
login($user,$pwd, $conn) or exit;
|
||||
capability( $conn );
|
||||
|
||||
if ( $list_mbxs ) {
|
||||
print STDOUT "\nList of mailboxes for $user:\n\n";
|
||||
@mbxs = listMailboxes( $conn );
|
||||
|
||||
foreach $mbx ( @mbxs ) {
|
||||
$mbx1 = decode( 'IMAP-UTF-7', $mbx );
|
||||
if ( $mbx eq $mbx1 ) {
|
||||
print STDOUT " $mbx\n";
|
||||
} elsif( $utf7_installed ) {
|
||||
print STDOUT " $mbx ($mbx1)\n";
|
||||
} else {
|
||||
print STDOUT " $mbx\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
logout( $conn );
|
||||
|
||||
sub init {
|
||||
|
||||
# Determine whether we have SSL support via openSSL and IO::Socket::SSL
|
||||
$ssl_installed = 1;
|
||||
eval 'use IO::Socket::SSL';
|
||||
if ( $@ ) {
|
||||
$ssl_installed = 0;
|
||||
}
|
||||
|
||||
$utf7_installed = 1;
|
||||
eval 'use Encode::IMAPUTF7 qw/decode/';
|
||||
if ( $@ ) {
|
||||
$utf7_installed = 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub getArgs {
|
||||
|
||||
getopts( "h:u:p:dmA:I" );
|
||||
$host = $opt_h;
|
||||
$user = $opt_u;
|
||||
$pwd = $opt_p;
|
||||
$debug = $opt_d;
|
||||
$admin_user = $opt_A;
|
||||
$list_mbxs = 1 if $opt_m;
|
||||
$showIMAP = 1 if $opt_I;
|
||||
|
||||
if ( $admin_user ) {
|
||||
# Don't need user password
|
||||
$pwd = 'XXXX';
|
||||
}
|
||||
|
||||
if ( $opt_H ) {
|
||||
usage();
|
||||
}
|
||||
|
||||
if ( !$host or !$user or !$pwd ) {
|
||||
usage();
|
||||
}
|
||||
|
||||
return ($host,$user,$pwd);
|
||||
|
||||
}
|
||||
|
||||
sub usage {
|
||||
|
||||
print STDOUT "usage: imapCapability.pl -h <host> -u <user> -p <password>\n";
|
||||
print STDOUT " Option argument: -m (list mailboxes)\n";
|
||||
exit;
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub connectToHost {
|
||||
|
||||
my $host = shift;
|
||||
my $conn = shift;
|
||||
|
||||
($host,$port) = split(/:/, $host);
|
||||
$port = 143 unless $port;
|
||||
|
||||
# We know whether to use SSL for ports 143 and 993. For any
|
||||
# other ones we'll have to figure it out.
|
||||
$mode = sslmode( $host, $port );
|
||||
|
||||
if ( $mode eq 'SSL' ) {
|
||||
unless( $ssl_installed == 1 ) {
|
||||
warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
exit;
|
||||
}
|
||||
print "Attempting an SSL connection\n" if $debug;
|
||||
$$conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
Domain => AF_INET,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
$error = IO::Socket::SSL::errstr();
|
||||
print "Error connecting to $host: $error\n";
|
||||
exit;
|
||||
}
|
||||
} else {
|
||||
# Non-SSL connection
|
||||
print "Attempting a non-SSL connection\n" if $debug;
|
||||
$$conn = IO::Socket::INET->new(
|
||||
Proto => "tcp",
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
print "Error connecting to $host:$port: $@\n";
|
||||
warn "Error connecting to $host:$port: $@";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
print "Connected to $host on port $port\n";
|
||||
|
||||
}
|
||||
|
||||
sub sslmode {
|
||||
|
||||
my $host = shift;
|
||||
my $port = shift;
|
||||
my $mode;
|
||||
|
||||
# Determine whether to make an SSL connection
|
||||
# to the host. Return 'SSL' if so.
|
||||
|
||||
if ( $port == 143 ) {
|
||||
# Standard non-SSL port
|
||||
return '';
|
||||
} elsif ( $port == 993 ) {
|
||||
# Standard SSL port
|
||||
return 'SSL';
|
||||
}
|
||||
|
||||
unless ( $ssl_installed ) {
|
||||
# We don't have SSL installed on this machine
|
||||
return '';
|
||||
}
|
||||
|
||||
# For any other port we need to determine whether it supports SSL
|
||||
|
||||
my $conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
if ( $conn ) {
|
||||
close( $conn );
|
||||
$mode = 'SSL';
|
||||
} else {
|
||||
$mode = '';
|
||||
}
|
||||
|
||||
return $mode;
|
||||
}
|
||||
|
||||
|
||||
sub login {
|
||||
|
||||
my $user = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
if ( $admin_user ) {
|
||||
# An AUTHENTICATE = PLAIN login has been requested
|
||||
($authuser,$authpwd) = split(/:/, $admin_user );
|
||||
login_plain( $user, $authuser, $authpwd, $conn ) or exit;
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ( $pwd =~ /^oauth2:(.+)/i ) {
|
||||
$token = $1;
|
||||
Log("password is an OAUTH2 token");
|
||||
login_xoauth2( $user, $token, $conn );
|
||||
return 1;
|
||||
}
|
||||
|
||||
sendCommand ($conn, "1 LOGIN $user $pwd");
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ($response =~ /^1 NO|^1 BAD/i) {
|
||||
print "Unexpected LOGIN response: $response\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
print "Logged in as $user\n" if $debug;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# login_plain
|
||||
#
|
||||
# login in at the source host with the user's name and password. If provided
|
||||
# with administrator credential, use them as this eliminates the need for the
|
||||
# user's password.
|
||||
#
|
||||
sub login_plain {
|
||||
|
||||
my $user = shift;
|
||||
my $admin = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it.
|
||||
|
||||
if ( !$admin ) {
|
||||
# Log in as the user
|
||||
$admin = $user
|
||||
}
|
||||
|
||||
$login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd);
|
||||
$login_str = encode_base64("$login_str", "");
|
||||
$len = length( $login_str );
|
||||
|
||||
# sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" );
|
||||
sendCommand ($conn, "1 AUTHENTICATE PLAIN" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
last if $response =~ /\+/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
sendCommand ($conn, "$login_str" );
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
|
||||
if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) {
|
||||
# The destination is an Exchange server
|
||||
$exchange = 1;
|
||||
Log("The destination is an Exchange server");
|
||||
}
|
||||
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
# login_xoauth2
|
||||
#
|
||||
# login in at the source host with the user's name and an XOAUTH2 token.
|
||||
#
|
||||
sub login_xoauth2 {
|
||||
|
||||
my $user = shift;
|
||||
my $token = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = XOAUTH2 login
|
||||
|
||||
$login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", '');
|
||||
sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^\+ (.+)/ ) {
|
||||
$error = decode_base64( $1 );
|
||||
Log("XOAUTH authentication as $user failed: $error");
|
||||
return 0;
|
||||
}
|
||||
last if $response =~ /^1 OK/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
Log("login complete") if $debug;
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
sub capability {
|
||||
|
||||
my $conn = shift;
|
||||
my @response;
|
||||
my $capability;
|
||||
|
||||
sendCommand ($conn, "1 CAPABILITY");
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
$capability = $response if $response =~ /\* CAPABILITY/i;
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ($response =~ /^1 NO|^1 BAD/i) {
|
||||
print "Unexpected response: $response\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
print STDOUT "\nThe server supports the following IMAP capabilities:\n\n";
|
||||
$capability =~ s/^\* CAPABILITY //;
|
||||
print "$capability\n";
|
||||
|
||||
}
|
||||
|
||||
sub logout {
|
||||
|
||||
my $conn = shift;
|
||||
|
||||
undef @response;
|
||||
sendCommand ($conn, "1 LOGOUT");
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
print "Unexpected LOGOUT response: $response\n";
|
||||
last;
|
||||
}
|
||||
}
|
||||
close $conn;
|
||||
return;
|
||||
}
|
||||
|
||||
sub sendCommand {
|
||||
|
||||
my $fd = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
print $fd "$cmd\r\n";
|
||||
print STDOUT "$cmd\n" if $showIMAP;
|
||||
}
|
||||
|
||||
sub readResponse {
|
||||
|
||||
my $fd = shift;
|
||||
|
||||
$response = <$fd>;
|
||||
chop $response;
|
||||
$response =~ s/\r//g;
|
||||
push (@response,$response);
|
||||
print STDOUT "$response\n" if $showIMAP;
|
||||
}
|
||||
|
||||
|
||||
# listMailboxes
|
||||
#
|
||||
# Get a list of the user's mailboxes
|
||||
#
|
||||
sub listMailboxes {
|
||||
|
||||
my $conn = shift;
|
||||
|
||||
sendCommand ($conn, "1 LIST \"\" *");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
&readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
&Log ("unexpected response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
@mbxs = ();
|
||||
for $i (0 .. $#response) {
|
||||
$response[$i] =~ s/\s+/ /;
|
||||
if ( $response[$i] =~ /"$/ ) {
|
||||
$response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i;
|
||||
$mbx = $3;
|
||||
} elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) {
|
||||
$mbx = $2;
|
||||
} else {
|
||||
$response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i;
|
||||
$mbx = $3;
|
||||
}
|
||||
$mbx =~ s/^\s+//; $mbx =~ s/\s+$//;
|
||||
push ( @mbxs, $mbx ) if $mbx ne '';
|
||||
}
|
||||
|
||||
return @mbxs;
|
||||
}
|
||||
|
||||
sub isAscii {
|
||||
|
||||
my $str = shift;
|
||||
my $ascii = 1;
|
||||
|
||||
# Determine whether a string contains non-ASCII characters
|
||||
|
||||
my $test = $str;
|
||||
$test=~s/\P{IsASCII}/?/g;
|
||||
$ascii = 0 unless $test eq $str;
|
||||
|
||||
return $ascii;
|
||||
|
||||
}
|
||||
|
||||
sub Log {
|
||||
|
||||
my $str = shift;
|
||||
|
||||
print STDERR "$str\n";
|
||||
|
||||
}
|
||||
488
S/imap_tools.V1.333/imapPing.pl
Executable file
488
S/imap_tools.V1.333/imapPing.pl
Executable file
|
|
@ -0,0 +1,488 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# $Header: /mhub4/sources/imap-tools/imapPing.pl,v 1.3 2013/09/30 14:27:38 rick Exp $
|
||||
|
||||
############################################################################
|
||||
# Program imapPing.pl #
|
||||
# Date 20 January 2008 #
|
||||
# #
|
||||
# Description #
|
||||
# #
|
||||
# This script performs some basic IMAP operations on a user's #
|
||||
# account and displays the time as each one is executed. The #
|
||||
# operations are: #
|
||||
# 1. Connect to the IMAP server #
|
||||
# 2. Log in with the user's name and password #
|
||||
# 3. Get a list of mailboxes in the user's account #
|
||||
# 4. Select the INBOX #
|
||||
# 5. Get a list of messages in the INBOX #
|
||||
# 6. Log off the server #
|
||||
# #
|
||||
# Usage: imapPing.pl -h <host> -u <user> -p <password> #
|
||||
# #
|
||||
############################################################################
|
||||
# Copyright (c) 2008 Rick Sanders <rfs9999@earthlink.net> #
|
||||
# #
|
||||
# Permission to use, copy, modify, and distribute this software for any #
|
||||
# purpose with or without fee is hereby granted, provided that the above #
|
||||
# copyright notice and this permission notice appear in all copies. #
|
||||
# #
|
||||
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES #
|
||||
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF #
|
||||
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR #
|
||||
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES #
|
||||
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN #
|
||||
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF #
|
||||
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. #
|
||||
############################################################################
|
||||
|
||||
use Getopt::Std;
|
||||
use Socket;
|
||||
use FileHandle;
|
||||
use Fcntl;
|
||||
use IO::Socket;
|
||||
use MIME::Base64 qw(encode_base64);
|
||||
|
||||
init();
|
||||
($host,$user,$pwd) = getArgs();
|
||||
|
||||
print STDOUT pack( "A35 A10", "Connecting to $host", getTime() );
|
||||
connectToHost( $host, \$conn );
|
||||
|
||||
print STDOUT pack( "A35 A10","Logging in as $user", getTime() );
|
||||
login( $user,$pwd, $conn );
|
||||
|
||||
print STDOUT pack( "A35 A10","Get list of mailboxes", getTime() );
|
||||
getMailboxList( $conn );
|
||||
|
||||
print STDOUT pack( "A35 A10","Selecting the INBOX", getTime() );
|
||||
selectMbx( 'INBOX', $conn ) if $rc;
|
||||
|
||||
print STDOUT pack( "A35 A10","Get list of msgs in INBOX", getTime() );
|
||||
getMsgList( 'INBOX', $conn );
|
||||
|
||||
print STDOUT pack( "A35 A10","Logging out", getTime() );
|
||||
logout( $conn );
|
||||
|
||||
print STDOUT pack( "A35 A10","Done", getTime() );
|
||||
|
||||
exit;
|
||||
|
||||
exit 1;
|
||||
|
||||
|
||||
sub init {
|
||||
|
||||
# Determine whether we have SSL support via openSSL and IO::Socket::SSL
|
||||
$ssl_installed = 1;
|
||||
eval 'use IO::Socket::SSL';
|
||||
if ( $@ ) {
|
||||
$ssl_installed = 0;
|
||||
}
|
||||
|
||||
getTime();
|
||||
$debug = 1;
|
||||
}
|
||||
|
||||
sub getTime {
|
||||
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
|
||||
if ($year < 99) { $yr = 2000; }
|
||||
else { $yr = 1900; }
|
||||
$date = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d \n",
|
||||
$mon+1,$mday,$year+$yr,$hour,$min,$sec);
|
||||
$time = sprintf ("%.2d:%.2d:%.2d \n",$hour,$min,$sec);
|
||||
|
||||
return $time;
|
||||
}
|
||||
|
||||
sub getArgs {
|
||||
|
||||
getopts( "h:u:p:A:" );
|
||||
$host = $opt_h;
|
||||
$user = $opt_u;
|
||||
$pwd = $opt_p;
|
||||
$admin_user = $opt_A;
|
||||
$showIMAP = 1 if $opt_I;
|
||||
|
||||
if ( $opt_H ) {
|
||||
usage();
|
||||
}
|
||||
|
||||
if ( $admin_user ) {
|
||||
$pwd = 'XXX'; # Don't need the user's password
|
||||
}
|
||||
|
||||
unless ( $host and $user and $pwd ) {
|
||||
usage();
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
return ($host,$user,$pwd);
|
||||
|
||||
}
|
||||
|
||||
# sendCommand
|
||||
#
|
||||
# This subroutine formats and sends an IMAP protocol command to an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub sendCommand
|
||||
{
|
||||
local($fd) = shift @_;
|
||||
local($cmd) = shift @_;
|
||||
|
||||
print $fd "$cmd\r\n";
|
||||
print STDOUT ">> $cmd\n" if $showIMAP;
|
||||
}
|
||||
|
||||
#
|
||||
# readResponse
|
||||
#
|
||||
# This subroutine reads and formats an IMAP protocol response from an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub readResponse
|
||||
{
|
||||
local($fd) = shift @_;
|
||||
|
||||
$response = <$fd>;
|
||||
chop $response;
|
||||
$response =~ s/\r//g;
|
||||
push (@response,$response);
|
||||
print STDOUT "<< $response\n" if $showIMAP;
|
||||
}
|
||||
|
||||
# Make a connection to an IMAP host
|
||||
|
||||
sub connectToHost {
|
||||
|
||||
my $host = shift;
|
||||
my $conn = shift;
|
||||
|
||||
($host,$port) = split(/:/, $host);
|
||||
$port = 143 unless $port;
|
||||
|
||||
# We know whether to use SSL for ports 143 and 993. For any
|
||||
# other ones we'll have to figure it out.
|
||||
$mode = sslmode( $host, $port );
|
||||
|
||||
if ( $mode eq 'SSL' ) {
|
||||
unless( $ssl_installed == 1 ) {
|
||||
warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
exit;
|
||||
}
|
||||
$$conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
Domain => AF_INET,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
$error = IO::Socket::SSL::errstr();
|
||||
warn("Error connecting to $host: $error");
|
||||
exit;
|
||||
}
|
||||
} else {
|
||||
# Non-SSL connection
|
||||
$$conn = IO::Socket::INET->new(
|
||||
Proto => "tcp",
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
warn "Error connecting to $host:$port: $@";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub sslmode {
|
||||
|
||||
my $host = shift;
|
||||
my $port = shift;
|
||||
my $mode;
|
||||
|
||||
# Determine whether to make an SSL connection
|
||||
# to the host. Return 'SSL' if so.
|
||||
|
||||
if ( $port == 143 ) {
|
||||
# Standard non-SSL port
|
||||
return '';
|
||||
} elsif ( $port == 993 ) {
|
||||
# Standard SSL port
|
||||
return 'SSL';
|
||||
}
|
||||
|
||||
unless ( $ssl_installed ) {
|
||||
# We don't have SSL installed on this machine
|
||||
return '';
|
||||
}
|
||||
|
||||
# For any other port we need to determine whether it supports SSL
|
||||
|
||||
my $conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
if ( $conn ) {
|
||||
close( $conn );
|
||||
$mode = 'SSL';
|
||||
} else {
|
||||
$mode = '';
|
||||
}
|
||||
|
||||
return $mode;
|
||||
}
|
||||
|
||||
|
||||
# login
|
||||
#
|
||||
# login in at the source host with the user's name and password
|
||||
#
|
||||
sub login {
|
||||
|
||||
my $user = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
if ( $admin_user ) {
|
||||
# An AUTHENTICATE = PLAIN login has been requested
|
||||
($authuser,$authpwd) = split(/:/, $admin_user );
|
||||
login_plain( $user, $authuser, $authpwd, $conn ) or exit;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sendCommand ($conn, "1 LOGIN $user $pwd");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
if ($response =~ /^1 OK/i) {
|
||||
last;
|
||||
}
|
||||
elsif ($response !~ /^\*/) {
|
||||
print STDOUT "Unexpected login response $response\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# login_plain
|
||||
#
|
||||
# login in at the source host with the user's name and password. If provided
|
||||
# with administrator credential, use them as this eliminates the need for the
|
||||
# user's password.
|
||||
#
|
||||
sub login_plain {
|
||||
|
||||
my $user = shift;
|
||||
my $admin = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it.
|
||||
|
||||
if ( !$admin ) {
|
||||
# Log in as the user
|
||||
$admin = $user
|
||||
}
|
||||
|
||||
$login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd);
|
||||
$login_str = encode_base64("$login_str", "");
|
||||
$len = length( $login_str );
|
||||
|
||||
# sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" );
|
||||
sendCommand ($conn, "1 AUTHENTICATE PLAIN" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
last if $response =~ /\+/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
sendCommand ($conn, "$login_str" );
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
|
||||
if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) {
|
||||
# The destination is an Exchange server
|
||||
$exchange = 1;
|
||||
Log("The destination is an Exchange server");
|
||||
}
|
||||
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
|
||||
# logout
|
||||
#
|
||||
# log out from the source host
|
||||
#
|
||||
sub logout {
|
||||
|
||||
my $conn = shift;
|
||||
|
||||
# print STDOUT "Logging out\n" if $debug;
|
||||
sendCommand ($conn, "1 LOGOUT");
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
print STDOUT "unexpected LOGOUT response: $response\n";
|
||||
last;
|
||||
}
|
||||
}
|
||||
close $conn;
|
||||
|
||||
return;
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub usage {
|
||||
|
||||
print STDOUT "\nUsage: imapPing.pl <args> \n\n";
|
||||
print STDOUT " -h <hostname>\n";
|
||||
print STDOUT " -u <user>\n";
|
||||
print STDOUT " -p <password>\n";
|
||||
|
||||
exit;
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub selectInbox {
|
||||
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Select a mailbox
|
||||
|
||||
sendCommand ($conn, "1 SELECT $mbx");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
if ($response =~ /^1 OK/i) {
|
||||
last;
|
||||
}
|
||||
elsif ($response !~ /^\*/) {
|
||||
print STDOUT "Unexpected SELECT INBOX response: $response\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub getMailboxList {
|
||||
|
||||
my $conn = shift;
|
||||
|
||||
# Get a list of the user's mailboxes
|
||||
|
||||
sendCommand ($conn, "1 LIST \"\" *");
|
||||
@response = ();
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
last if $response =~ /^1 OK/i;
|
||||
|
||||
if ( $response !~ /^\*/ ) {
|
||||
print STDOUT "unexpected response: $response\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
@mbxs = ();
|
||||
for $i (0 .. $#response) {
|
||||
# print STDERR "$response[$i]\n";
|
||||
$response[$i] =~ s/\s+/ /;
|
||||
($dmy,$mbx) = split(/"\/"/,$response[$i]);
|
||||
$mbx =~ s/^\s+//; $mbx =~ s/\s+$//;
|
||||
$mbx =~ s/"//g;
|
||||
|
||||
if ($mbx =~ /^\#/) {
|
||||
# Skip public mbxs
|
||||
next;
|
||||
}
|
||||
|
||||
if ($mbx ne '') {
|
||||
push(@mbxs,$mbx);
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub getMsgList {
|
||||
|
||||
my $mailbox = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Select the mailbox in read-only mode
|
||||
|
||||
sendCommand ($conn, "1 EXAMINE \"$mailbox\"");
|
||||
undef @response;
|
||||
$empty=0;
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
|
||||
last if $response =~ /^1 OK/i;
|
||||
|
||||
if ( $response !~ /^\*/ ) {
|
||||
print STDOUT "Error: $response\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sendCommand ($conn, "1 FETCH 1:* (UID FLAGS)");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ( $response !~ /^\*/ ) {
|
||||
print STDOUT "Unexpected response: $response\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
# Get a list of the msgs in the mailbox
|
||||
#
|
||||
undef @msgs;
|
||||
for $i (0 .. $#response) {
|
||||
$_ = $response[$i];
|
||||
$_ =~ /\* ([^FETCH]*)/;
|
||||
$uid = $1;
|
||||
$uid =~ s/\s+$//;
|
||||
if ($response[$i] =~ /\\Seen/) { $seen = 1; }
|
||||
if (($uid ne 'OK') && ($uid ne '')) {
|
||||
push (@msgs,"$uid $seen");
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
1913
S/imap_tools.V1.333/imap_audit.pl
Executable file
1913
S/imap_tools.V1.333/imap_audit.pl
Executable file
File diff suppressed because it is too large
Load diff
1940
S/imap_tools.V1.333/imap_search.pl
Executable file
1940
S/imap_tools.V1.333/imap_search.pl
Executable file
File diff suppressed because it is too large
Load diff
1118
S/imap_tools.V1.333/imap_to_maildir.pl
Executable file
1118
S/imap_tools.V1.333/imap_to_maildir.pl
Executable file
File diff suppressed because it is too large
Load diff
5
S/imap_tools.V1.333/imapcopy.cf
Normal file
5
S/imap_tools.V1.333/imapcopy.cf
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
LOGFILE: imapcopy.log
|
||||
IMAPCOPY: imapcopy.pl
|
||||
PROCESS_LIMIT: 8
|
||||
DEBUG: 0
|
||||
SHOWIMAP: 0
|
||||
598
S/imap_tools.V1.333/imapcopy.cgi
Normal file
598
S/imap_tools.V1.333/imapcopy.cgi
Normal file
|
|
@ -0,0 +1,598 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# $Header: /mhub4/sources/imap-tools/imapcopy.cgi,v 1.9 2014/08/18 15:17:22 rick Exp $
|
||||
|
||||
#######################################################################
|
||||
# Program name imapcopy.cgi #
|
||||
# Written by Rick Sanders #
|
||||
# #
|
||||
# Description #
|
||||
# #
|
||||
# imapcopy.cgi is used to manage the imapcopy.pl script in CGI #
|
||||
# mode. #
|
||||
#######################################################################
|
||||
|
||||
use Socket;
|
||||
use FileHandle;
|
||||
use Fcntl;
|
||||
use Getopt::Std;
|
||||
use CGI;
|
||||
use CGI::Carp qw(fatalsToBrowser);
|
||||
use IO::Socket;
|
||||
use POSIX 'setsid';
|
||||
use Cwd;
|
||||
|
||||
init();
|
||||
get_html();
|
||||
|
||||
# Check the source and dest logins in case the user has provided
|
||||
# invalid credentials or host names
|
||||
|
||||
test_logins();
|
||||
|
||||
# To prevent someone from seeing the passwords in ps pass them
|
||||
# as ENV variables.
|
||||
|
||||
$ENV{SOURCEPWD} = $sourcePwd;
|
||||
$ENV{DESTPWD} = $destPwd;
|
||||
|
||||
my $cmd = "$imapcopy ";
|
||||
$cmd .= "-S $sourceHost/$sourceUser/SOURCEPWD ";
|
||||
$cmd .= "-D $destHost/$destUser/DESTPWD ";
|
||||
$cmd .= "-I " if $DEFAULTS{'SHOWIMAP'} == 1;
|
||||
$cmd .= "-d " if $DEFAULTS{'DEBUG'} == 1;
|
||||
$cmd .= "-L $logfile " if $logfile;
|
||||
$cmd .= "-m \"$mbxList\" " if $mbxList;
|
||||
$cmd .= "-e \"$excludeMbxs\" " if $excludeMbxs;
|
||||
$cmd .= "-a $sent_after " if $sent_after;
|
||||
$cmd .= "-b $sent_before " if $sent_before;
|
||||
$cmd .= "-U " if $update;
|
||||
$cmd .= "$DEFAULTS{ARGUMENTS} " if $DEFAULTS{ARGUMENTS};
|
||||
|
||||
launch_daemon( $cmd );
|
||||
|
||||
print STDOUT "<b><br>Your copy job has been started. You will be notified when it has completed</b><br>";
|
||||
|
||||
exit;
|
||||
|
||||
|
||||
sub init {
|
||||
|
||||
$os = $ENV{'OS'};
|
||||
|
||||
print "Content-type: text/html\n\n<html>\n";
|
||||
print '<meta equiv="refresh" content="5">';
|
||||
print '</head>';
|
||||
print '<title>IMAP Copy</title>';
|
||||
print '<body style="background-color:#FFF8C6" bgproperties="fixed" bgcolor="#FFFFFF" text="#000000"
|
||||
link="#050473" vlink="#6B6AF5" alink="#840000">';
|
||||
|
||||
if ( -e "imapcopy.cf" ) {
|
||||
open(CF, "<imapcopy.cf") or print "Can't open imapcopy.cf: $!";
|
||||
}
|
||||
while( <CF> ) {
|
||||
chomp;
|
||||
($kw,$value) = split(/\s*:\s*/, $_, 2);
|
||||
$DEFAULTS{$kw} = $value;
|
||||
}
|
||||
close CF;
|
||||
|
||||
if ( $DEFAULTS{'IMAPCOPY'} ) {
|
||||
$imapcopy = $DEFAULTS{'IMAPCOPY'};
|
||||
} else {
|
||||
my $here = getcwd;
|
||||
$imapcopy = "$here/imapcopy.pl";
|
||||
}
|
||||
|
||||
$logfile = $DEFAULTS{'LOGFILE'};
|
||||
if ( $logfile ) {
|
||||
if ( !open(LOG, ">> $logfile")) {
|
||||
print STDOUT "Can't open $logfile: $!\n";
|
||||
exit;
|
||||
}
|
||||
select(LOG); $| = 1;
|
||||
}
|
||||
Log("$0 starting");
|
||||
|
||||
$count = count_imapcopy_processes();
|
||||
if ( $DEFAULTS{PROCESS_LIMIT} ) {
|
||||
exit if $count > $DEFAULTS{PROCESS_LIMIT};
|
||||
}
|
||||
|
||||
# Determine whether we have SSL support via openSSL and IO::Socket::SSL
|
||||
$ssl_installed = 1;
|
||||
eval 'use IO::Socket::SSL';
|
||||
if ( $@ ) {
|
||||
$ssl_installed = 0;
|
||||
}
|
||||
|
||||
# Set up signal handling
|
||||
$SIG{'ALRM'} = 'signalHandler';
|
||||
$SIG{'HUP'} = 'signalHandler';
|
||||
$SIG{'INT'} = 'signalHandler';
|
||||
$SIG{'TERM'} = 'signalHandler';
|
||||
$SIG{'URG'} = 'signalHandler';
|
||||
|
||||
}
|
||||
|
||||
sub launch_daemon {
|
||||
|
||||
my $cmd = shift;
|
||||
my $parent = $$;
|
||||
use POSIX 'setsid';
|
||||
|
||||
# The purpose of this routine is to launch imapcopy as a grandkid which detaches
|
||||
# it from the Apache process so that it will not die if the user closes his browser.
|
||||
|
||||
print STDOUT "Your copy job has been started. You will be notified when it has completed.";
|
||||
|
||||
if ( !defined (my $kid = fork) ) {
|
||||
print STDOUT "Cannot fork a child process: $!<br>";
|
||||
Log("Cannot fork: $!");
|
||||
exit;
|
||||
}
|
||||
if ( $kid ) {
|
||||
exit(0);
|
||||
} else {
|
||||
close STDIN;
|
||||
close STDOUT;
|
||||
close STDERR;
|
||||
if ( !setsid ) {
|
||||
Log("Cannot execute 'setsid', exiting");
|
||||
exit;
|
||||
}
|
||||
|
||||
umask(0027); # create files with perms -rw-r-----
|
||||
if ( !chdir '/' ) {
|
||||
Log("Can't chdir to /: $!");
|
||||
exit;
|
||||
}
|
||||
|
||||
if ( !(open STDIN, '<', '/dev/null') ) {
|
||||
Log("Cannot redirect STDIN: $!");
|
||||
exit;
|
||||
}
|
||||
|
||||
if ( !(open STDOUT, '>', '/dev/null') ) {
|
||||
Log("Cannot redirect STDOUT: $!");
|
||||
exit;
|
||||
}
|
||||
|
||||
if ( !(open STDERR, '>>', $logfile) ) {
|
||||
Log("Cannot redirect STDERR to $logfile: $!");
|
||||
Log("Check the path and permissions on $logfile");
|
||||
exit;
|
||||
}
|
||||
|
||||
if ( !defined (my $grandkid = fork) ) {
|
||||
exit;
|
||||
} else {
|
||||
if ( $grandkid != 0 and $$ != $parent ) {
|
||||
Log("Execute $cmd");
|
||||
$rc = `$cmd`;
|
||||
Log("rc = $rc");
|
||||
}
|
||||
exit(0);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub get_html {
|
||||
|
||||
my $fields = shift;
|
||||
my $formData=0;
|
||||
|
||||
# Get the HTML form values
|
||||
#
|
||||
my $query = new CGI;
|
||||
|
||||
$sourceHost = $query->param('sourceHost');
|
||||
$sourceUser = $query->param('sourceUser');
|
||||
$sourcePwd = $query->param('sourcePwd');
|
||||
|
||||
$destHost = $query->param('destHost');
|
||||
$destUser = $query->param('destUser');
|
||||
$destPwd = $query->param('destPwd');
|
||||
|
||||
$mbxList = $query->param('mbxList');
|
||||
$excludeMbxs = $query->param('excludeMbxList');
|
||||
$sent_after = $query->param('sent_after');
|
||||
$sent_before = $query->param('sent_before');
|
||||
$update = $query->param('update');
|
||||
|
||||
$update = 1 if $update eq 'on';
|
||||
|
||||
}
|
||||
|
||||
sub Log {
|
||||
|
||||
my $str = shift;
|
||||
|
||||
if ( $logfile ) {
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
|
||||
if ($year < 99) { $yr = 2000; }
|
||||
else { $yr = 1900; }
|
||||
$line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s\n",
|
||||
$mon + 1, $mday, $year + $yr, $hour, $min, $sec,$str);
|
||||
print LOG "$line";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
# login
|
||||
#
|
||||
# login in at the source host with the user's name and password
|
||||
#
|
||||
sub login {
|
||||
|
||||
my $user = shift;
|
||||
my $pwd = shift;
|
||||
my $host = shift;
|
||||
my $conn = shift;
|
||||
my $method = shift;
|
||||
|
||||
Log("method $method") if $debug;
|
||||
|
||||
return 1 if $method eq 'PREAUTH'; # Server pre-authenticates users
|
||||
|
||||
Log("Authenticating to $host as $user");
|
||||
if ( uc( $method ) eq 'CRAM-MD5' ) {
|
||||
# A CRAM-MD5 login is requested
|
||||
Log("login method $method");
|
||||
my $rc = login_cram_md5( $user, $pwd, $conn );
|
||||
return $rc;
|
||||
}
|
||||
|
||||
if ( $user =~ /(.+):(.+)/ ) {
|
||||
# An AUTHENTICATE = PLAIN login has been requested
|
||||
$sourceUser = $1;
|
||||
$authuser = $2;
|
||||
login_plain( $sourceUser, $authuser, $pwd, $conn ) or exit;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Otherwise do an ordinary login
|
||||
|
||||
sendCommand ($conn, "1 LOGIN $user \"$pwd\"");
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
|
||||
if ( $response =~ /Cyrus/i and $conn eq $dst ) {
|
||||
Log("Destination is a Cyrus server");
|
||||
$cyrus = 1;
|
||||
}
|
||||
|
||||
if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) {
|
||||
# The destination is an Exchange server
|
||||
unless ( $exchange_override ) {
|
||||
$exchange = 1;
|
||||
Log("The destination is an Exchange server");
|
||||
}
|
||||
}
|
||||
last if $response =~ /^1 OK/i;
|
||||
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
Log("Logged in as $user") if $debug;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
sub login_cram_md5 {
|
||||
|
||||
my $user = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
sendCommand ($conn, "1 AUTHENTICATE CRAM-MD5");
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
last if $response =~ /^\+/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
my ($challenge) = $response =~ /^\+ (.+)/;
|
||||
|
||||
Log("challenge $challenge") if $debug;
|
||||
$response = cram_md5( $challenge, $user, $pwd );
|
||||
Log("response $response") if $debug;
|
||||
|
||||
sendCommand ($conn, $response);
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
|
||||
if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) {
|
||||
# The destination is an Exchange server
|
||||
$exchange = 1;
|
||||
Log("The destination is an Exchange server");
|
||||
}
|
||||
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
Log("Logged in as $user") if $debug;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# login_plain
|
||||
#
|
||||
# login in at the source host with the user's name and password. If provided
|
||||
# with administrator credential, use them as this eliminates the need for the
|
||||
# user's password.
|
||||
#
|
||||
sub login_plain {
|
||||
|
||||
my $user = shift;
|
||||
my $admin = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it.
|
||||
|
||||
if ( !$admin ) {
|
||||
# Log in as the user
|
||||
$admin = $user
|
||||
}
|
||||
|
||||
$login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd);
|
||||
$login_str = encode_base64("$login_str", "");
|
||||
$len = length( $login_str );
|
||||
|
||||
# sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" );
|
||||
sendCommand ($conn, "1 AUTHENTICATE PLAIN" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
last if $response =~ /\+/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
sendCommand ($conn, "$login_str" );
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
|
||||
if ( $response =~ /Cyrus/i and $conn eq $dst ) {
|
||||
Log("Destination is a Cyrus server");
|
||||
$cyrus = 1;
|
||||
}
|
||||
|
||||
if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) {
|
||||
# The destination is an Exchange server
|
||||
$exchange = 1;
|
||||
Log("The destination is an Exchange server");
|
||||
}
|
||||
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
# logout
|
||||
#
|
||||
# log out from the host
|
||||
#
|
||||
sub logout {
|
||||
|
||||
my $conn = shift;
|
||||
|
||||
undef @response;
|
||||
sendCommand ($conn, "1 LOGOUT");
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected LOGOUT response: $response");
|
||||
last;
|
||||
}
|
||||
}
|
||||
close $conn;
|
||||
return;
|
||||
}
|
||||
|
||||
# Make a connection to a IMAP host
|
||||
|
||||
sub connectToHost {
|
||||
|
||||
my $host = shift;
|
||||
my $conn = shift;
|
||||
|
||||
Log("Connecting to $host") if $debug;
|
||||
|
||||
($host,$port) = split(/:/, $host);
|
||||
$port = 143 unless $port;
|
||||
|
||||
# We know whether to use SSL for ports 143 and 993. For any
|
||||
# other ones we'll have to figure it out.
|
||||
$mode = sslmode( $host, $port );
|
||||
|
||||
if ( $mode eq 'SSL' ) {
|
||||
unless( $ssl_installed == 1 ) {
|
||||
warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
exit;
|
||||
}
|
||||
Log("Attempting an SSL connection") if $debug;
|
||||
$$conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
Domain => AF_INET,
|
||||
Timeout => 10,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
$error = IO::Socket::SSL::errstr();
|
||||
Log("Error connecting to $host: $error");
|
||||
print STDOUT "<font color=red><b>Error: Can't connect to $host.<br>";
|
||||
print STDOUT "Hit the Back button on your browser, correct the info, and try again.";
|
||||
exit;
|
||||
}
|
||||
} else {
|
||||
# Non-SSL connection
|
||||
Log("Attempting a non-SSL connection") if $debug;
|
||||
$$conn = IO::Socket::INET->new(
|
||||
Proto => "tcp",
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
Timeout => 10,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
Log("Error connecting to $host:$port: $@");
|
||||
print STDOUT "<font color=red><b>Error: Can't connect to $host.<br>";
|
||||
print STDOUT "Hit the Back button on your browser, correct the info, and try again.";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
Log("Connected to $host on port $port");
|
||||
|
||||
}
|
||||
|
||||
sub sslmode {
|
||||
|
||||
my $host = shift;
|
||||
my $port = shift;
|
||||
my $mode;
|
||||
|
||||
# Determine whether to make an SSL connection
|
||||
# to the host. Return 'SSL' if so.
|
||||
|
||||
if ( $port == 143 ) {
|
||||
# Standard non-SSL port
|
||||
return '';
|
||||
} elsif ( $port == 993 ) {
|
||||
# Standard SSL port
|
||||
return 'SSL';
|
||||
}
|
||||
|
||||
unless ( $ssl_installed ) {
|
||||
# We don't have SSL installed on this machine
|
||||
return '';
|
||||
}
|
||||
|
||||
# For any other port we need to determine whether it supports SSL
|
||||
|
||||
my $conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
if ( $conn ) {
|
||||
close( $conn );
|
||||
$mode = 'SSL';
|
||||
} else {
|
||||
$mode = '';
|
||||
}
|
||||
|
||||
return $mode;
|
||||
}
|
||||
|
||||
sub test_logins {
|
||||
|
||||
# Verify that we can log in at the source and destination before launching
|
||||
# the copy job.
|
||||
|
||||
print "<br><br>";
|
||||
if ( !connectToHost($sourceHost, \$src) ) {
|
||||
print STDOUT "<font color=red> <b>Error: Can't connect to $sourceHost. Check that $sourceHost is correct.<br>";
|
||||
print STDOUT "Hit the Back button on your browser, correct the info, and try again.";
|
||||
exit;
|
||||
}
|
||||
if ( !login($sourceUser,$sourcePwd, $sourceHost, $src, $srcMethod) ) {
|
||||
print STDOUT "<font color=red><b>Error: Can't login as $sourceUser. Check your username and password<br>";
|
||||
print STDOUT "Hit the Back button on your browser, correct the info, and try again.";
|
||||
exit;
|
||||
}
|
||||
if ( !connectToHost($destHost, \$dst) ) {
|
||||
print STDOUT "<font color=red><b>Error: Can't connect to $destHost. Check that $destHost is correct.\n";
|
||||
print STDOUT "Hit the Back button on your browser, correct the info, and try again.";
|
||||
exit;
|
||||
}
|
||||
if ( !login($destUser,$destPwd, $destHost, $dst, $dstMethod) ) {
|
||||
print STDOUT "<font color=red><b>Error: Can't login as $destUser. Check your username and password<br>";
|
||||
print STDOUT "Hit the Back button on your browser, correct the info, and try again.";
|
||||
exit;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub sendCommand {
|
||||
|
||||
my $fd = shift;
|
||||
my $cmd = shift;
|
||||
|
||||
print $fd "$cmd\r\n";
|
||||
|
||||
Log (">> $cmd") if $showIMAP;
|
||||
}
|
||||
|
||||
#
|
||||
# readResponse
|
||||
#
|
||||
# This subroutine reads and formats an IMAP protocol response from an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub readResponse {
|
||||
|
||||
my $fd = shift;
|
||||
|
||||
$response = <$fd>;
|
||||
chop $response;
|
||||
$response =~ s/\r//g;
|
||||
push (@response,$response);
|
||||
Log ("<< $response") if $showIMAP;
|
||||
}
|
||||
|
||||
sub count_imapcopy_processes {
|
||||
|
||||
my $count;
|
||||
|
||||
# Count how many imapcopy processes are currently running
|
||||
# and exit if the max has been reached.
|
||||
|
||||
foreach $_ ( `ps -ef | grep imapcopy.pl` ) {
|
||||
next unless /imapcopy.pl/;
|
||||
next if /grep/;
|
||||
$count++;
|
||||
}
|
||||
|
||||
$process_limit = $DEFAULTS{PROCESS_LIMIT};
|
||||
if ( $process_limit > 0 and $count > $process_limit ) {
|
||||
print STDOUT "<br><br><b>The maximum number of IMAP copies is already running. Please try again later.<br>";
|
||||
}
|
||||
return $count;
|
||||
|
||||
}
|
||||
|
||||
86
S/imap_tools.V1.333/imapcopy.html
Normal file
86
S/imap_tools.V1.333/imapcopy.html
Normal file
|
|
@ -0,0 +1,86 @@
|
|||
|
||||
<html>
|
||||
<title>IMAPCOPY</title>
|
||||
<head>
|
||||
|
||||
<FORM name="imapcopy" method=post action="../cgi-bin/imapcopy.cgi" ENCTYPE="multipart/form-data">
|
||||
|
||||
<script language="javascript">
|
||||
var pageLoaded = false;
|
||||
function validate() {
|
||||
if ( !document.imapcopy.sourceHost.value ||
|
||||
!document.imapcopy.sourceUser.value ||
|
||||
!document.imapcopy.sourcePwd.value ||
|
||||
!document.imapcopy.destHost.value ||
|
||||
!document.imapcopy.destUser.value ||
|
||||
!document.imapcopy.destPwd.value
|
||||
) {
|
||||
alert("Please enter values for source & destination servers, source & destination usernames, and source & destination passwords");
|
||||
return false;
|
||||
} else {
|
||||
return true;
|
||||
}
|
||||
}
|
||||
</script>
|
||||
|
||||
</head>
|
||||
<body style="background-color:#FFF8C6" bgproperties="fixed" bgcolor="#FFFFFF" text="#000000"
|
||||
link="#050473" vlink="#6B6AF5" alink="#840000">
|
||||
|
||||
<H3><font size=6 color="#0000ff"> IMAPCOPY</font></H3>
|
||||
|
||||
<br>
|
||||
|
||||
<table>
|
||||
<tr>
|
||||
<td>Source server
|
||||
<td><input type=text name=sourceHost value=SOURCEHOST>
|
||||
|
||||
<tr>
|
||||
<td>Destination server
|
||||
<td><input type=text name=destHost value=DESTHOST>
|
||||
<tr>
|
||||
<td>Source username <td><input type=text name=sourceUser>
|
||||
<td>Source password <td><input type=password name=sourcePwd>
|
||||
|
||||
<tr>
|
||||
<td>Destination username <td><input type=text name=destUser>
|
||||
<td>Destination password <td><input type=password name=destPwd>
|
||||
</table>
|
||||
|
||||
<br><br>
|
||||
<table>
|
||||
<tr>
|
||||
<td>Copy only these folders
|
||||
<td><input type=text name="mbxList" size=35> folder1,folder2,...
|
||||
|
||||
<tr>
|
||||
<td>Exclude these folders
|
||||
<td><input type=text name="excludeMbxList" size=35> folder1,folder2,...
|
||||
|
||||
<tr>
|
||||
<td>After date
|
||||
<td><input type=text name=sent_after> DD-MMM-YYYY
|
||||
|
||||
<tr>
|
||||
<td>Before Date
|
||||
<td><input type=text name=sent_before> DD-MMM-YYYY
|
||||
|
||||
<tr>
|
||||
<td>Update Mode
|
||||
<td><input type=checkbox name=update><br>
|
||||
</table>
|
||||
|
||||
<br><br>
|
||||
<input type=submit value="Submit" onclick="return validate()">
|
||||
<input type=reset value="Clear form">
|
||||
|
||||
<br><br>
|
||||
After clicking on Submit the copy process will start.
|
||||
Depending on the size of your
|
||||
account it will take a few minutes or more to copy everything over.
|
||||
When it finishes you will receive an e-mail notifying of the results.
|
||||
|
||||
</form>
|
||||
</body>
|
||||
</html>
|
||||
3133
S/imap_tools.V1.333/imapcopy.pl
Executable file
3133
S/imap_tools.V1.333/imapcopy.pl
Executable file
File diff suppressed because it is too large
Load diff
86
S/imap_tools.V1.333/imapcopy_de.html
Normal file
86
S/imap_tools.V1.333/imapcopy_de.html
Normal file
|
|
@ -0,0 +1,86 @@
|
|||
<html>
|
||||
<title>IMAPCOPY</title>
|
||||
<head>
|
||||
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
|
||||
<FORM name="imapcopy" method=post action="imapcopy.cgi" ENCTYPE="multipart/form-data">
|
||||
|
||||
<script language="javascript">
|
||||
var pageLoaded = false;
|
||||
function validate() {
|
||||
if ( !document.imapcopy.sourceHost.value ||
|
||||
!document.imapcopy.sourceUser.value ||
|
||||
!document.imapcopy.sourcePwd.value ||
|
||||
!document.imapcopy.destHost.value ||
|
||||
!document.imapcopy.destUser.value ||
|
||||
!document.imapcopy.destPwd.value
|
||||
) {
|
||||
alert("Please enter values for source & destination servers, source & destination usernames, and source & destination passwords");
|
||||
return false;
|
||||
} else {
|
||||
return true;
|
||||
}
|
||||
}
|
||||
</script>
|
||||
|
||||
</head>
|
||||
<body style="background-color:#FFF8C6" bgproperties="fixed" bgcolor="#FFFFFF" text="#000000"
|
||||
link="#050473" vlink="#6B6AF5" alink="#840000">
|
||||
|
||||
<H3><font size=6 color="#0000ff"> IMAPCOPY</font></H3>
|
||||
|
||||
<p>
|
||||
<a href="imapcopy_en.html"><img src="flag_en.gif" width="50" height="38" border="0" alt="EN"></a>
|
||||
<a href="imapcopy_de.html"><img src="flag_de.gif" width="50" height="38" border="0" alt="DE"></a>
|
||||
</p>
|
||||
|
||||
<br>
|
||||
|
||||
<table>
|
||||
<tr>
|
||||
<td>Quellserver:
|
||||
<td><input type=text name=sourceHost value=imap.quellserver.de>
|
||||
|
||||
<tr>
|
||||
<td>Zielserver:
|
||||
<td><input type=text name=destHost value=imap.zielserver.de>
|
||||
<tr>
|
||||
<td>Benutzername Quellserver:<td><input type=text name=sourceUser>
|
||||
<td>Passwort Quellserver:<td><input type=password name=sourcePwd>
|
||||
|
||||
<tr>
|
||||
<td>Benutzername Zielserver:<td><input type=text name=destUser>
|
||||
<td>Passwort Zielserver:<td><input type=password name=destPwd>
|
||||
</table>
|
||||
|
||||
<br><br>
|
||||
<table>
|
||||
<tr>
|
||||
<td>Nur diese Ordner kopieren:
|
||||
<td><input type=text name="mbxList" size=35> Ordner1,Ordner2, ...
|
||||
|
||||
<tr>
|
||||
<td>Diese Ordner nicht kopieren:
|
||||
<td><input type=text name="excludeMbxList" size=35> Ordner1,Ordner2, ...
|
||||
|
||||
<tr>
|
||||
<td>Nachrichten kopieren nach Datum
|
||||
<td><input type=text name=sent_after> TT-MMM-JJJJ
|
||||
|
||||
<tr>
|
||||
<td>Nachrichten kopieren vor Datum
|
||||
<td><input type=text name=sent_before> TT-MMM-JJJJ
|
||||
|
||||
<tr>
|
||||
<td>Update Mode <br> (nur noch nicht kopierte Nachrichten)
|
||||
<td><input type=checkbox name=update><br>
|
||||
</table>
|
||||
|
||||
<br><br>
|
||||
<input type=submit value="Start imapcopy" onclick="return validate()">
|
||||
<input type=reset value="Formular löschen">
|
||||
|
||||
<br><br>
|
||||
Nach Start imapcopy wird der Kopierprozess gestartet. Abhängig von der Größe der zu kopierenden Accounts kann es einige Minuten oder länger dauern bis alle Nachrichten kopiert sind. Am Ende des Kopierprozesses erhalten Sie eine Nachricht per E-Mail.
|
||||
</form>
|
||||
</body>
|
||||
</html>
|
||||
91
S/imap_tools.V1.333/imapcopy_en.html
Normal file
91
S/imap_tools.V1.333/imapcopy_en.html
Normal file
|
|
@ -0,0 +1,91 @@
|
|||
|
||||
<html>
|
||||
<title>IMAPCOPY</title>
|
||||
<head>
|
||||
|
||||
<FORM name="imapcopy" method=post action="../cgi-bin/imapcopy.cgi" ENCTYPE="multipart/form-data">
|
||||
|
||||
<script language="javascript">
|
||||
var pageLoaded = false;
|
||||
function validate() {
|
||||
if ( !document.imapcopy.sourceHost.value ||
|
||||
!document.imapcopy.sourceUser.value ||
|
||||
!document.imapcopy.sourcePwd.value ||
|
||||
!document.imapcopy.destHost.value ||
|
||||
!document.imapcopy.destUser.value ||
|
||||
!document.imapcopy.destPwd.value
|
||||
) {
|
||||
alert("Please enter values for source & destination servers, source & destination usernames, and source & destination passwords");
|
||||
return false;
|
||||
} else {
|
||||
return true;
|
||||
}
|
||||
}
|
||||
</script>
|
||||
|
||||
</head>
|
||||
<body style="background-color:#FFF8C6" bgproperties="fixed" bgcolor="#FFFFFF" text="#000000"
|
||||
link="#050473" vlink="#6B6AF5" alink="#840000">
|
||||
|
||||
<H3><font size=6 color="#0000ff"> IMAPCOPY</font></H3>
|
||||
|
||||
<p>
|
||||
<a href="imapcopy_en.html"><img src="flag_en.gif" width="50" height="38" border="0" alt="EN"></a>
|
||||
<a href="imapcopy_de.html"><img src="flag_de.gif" width="50" height="38" border="0" alt="DE"></a>
|
||||
</p>
|
||||
|
||||
<br>
|
||||
|
||||
<table>
|
||||
<tr>
|
||||
<td>Source server
|
||||
<td><input type=text name=sourceHost value=SOURCEHOST>
|
||||
|
||||
<tr>
|
||||
<td>Destination server
|
||||
<td><input type=text name=destHost value=DESTHOST>
|
||||
<tr>
|
||||
<td>Source username <td><input type=text name=sourceUser>
|
||||
<td>Source password <td><input type=password name=sourcePwd>
|
||||
|
||||
<tr>
|
||||
<td>Destination username <td><input type=text name=destUser>
|
||||
<td>Destination password <td><input type=password name=destPwd>
|
||||
</table>
|
||||
|
||||
<br><br>
|
||||
<table>
|
||||
<tr>
|
||||
<td>Copy only these folders
|
||||
<td><input type=text name="mbxList" size=35> folder1,folder2,...
|
||||
|
||||
<tr>
|
||||
<td>Exclude these folders
|
||||
<td><input type=text name="excludeMbxList" size=35> folder1,folder2,...
|
||||
|
||||
<tr>
|
||||
<td>After date
|
||||
<td><input type=text name=sent_after> DD-MMM-YYYY
|
||||
|
||||
<tr>
|
||||
<td>Before Date
|
||||
<td><input type=text name=sent_before> DD-MMM-YYYY
|
||||
|
||||
<tr>
|
||||
<td>Update Mode
|
||||
<td><input type=checkbox name=update><br>
|
||||
</table>
|
||||
|
||||
<br><br>
|
||||
<input type=submit value="Submit" onclick="return validate()">
|
||||
<input type=reset value="Clear form">
|
||||
|
||||
<br><br>
|
||||
After clicking on Submit the copy process will start.
|
||||
Depending on the size of your
|
||||
account it will take a few minutes or more to copy everything over.
|
||||
When it finishes you will receive an e-mail notifying of the results.
|
||||
|
||||
</form>
|
||||
</body>
|
||||
</html>
|
||||
1697
S/imap_tools.V1.333/imapdump.pl
Executable file
1697
S/imap_tools.V1.333/imapdump.pl
Executable file
File diff suppressed because it is too large
Load diff
2151
S/imap_tools.V1.333/imapfilter.pl
Normal file
2151
S/imap_tools.V1.333/imapfilter.pl
Normal file
File diff suppressed because it is too large
Load diff
2348
S/imap_tools.V1.333/imapsync.pl
Executable file
2348
S/imap_tools.V1.333/imapsync.pl
Executable file
File diff suppressed because it is too large
Load diff
21
S/imap_tools.V1.333/license.txt
Normal file
21
S/imap_tools.V1.333/license.txt
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
|
||||
############################################################################
|
||||
# Copyright (c) 2012 Rick Sanders <rfs9999@earthlink.net> #
|
||||
# #
|
||||
# Permission to use, copy, and modify this software for any purpose #
|
||||
# is hereby granted, provided that the above copyright notice and this #
|
||||
# permission notice appear in all copies. #
|
||||
# #
|
||||
# This software is not assignable and may not be resold without the #
|
||||
# express written permission of the author. The sofware can be hosted #
|
||||
# on any or all of the license holder's servers and sites. #
|
||||
# #
|
||||
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES #
|
||||
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF #
|
||||
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR #
|
||||
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES #
|
||||
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN #
|
||||
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF #
|
||||
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. #
|
||||
############################################################################
|
||||
|
||||
1183
S/imap_tools.V1.333/list_account_sizes.pl
Executable file
1183
S/imap_tools.V1.333/list_account_sizes.pl
Executable file
File diff suppressed because it is too large
Load diff
1150
S/imap_tools.V1.333/list_imap_folders.pl
Executable file
1150
S/imap_tools.V1.333/list_imap_folders.pl
Executable file
File diff suppressed because it is too large
Load diff
1221
S/imap_tools.V1.333/load_msgs.pl
Normal file
1221
S/imap_tools.V1.333/load_msgs.pl
Normal file
File diff suppressed because it is too large
Load diff
1328
S/imap_tools.V1.333/maildir_to_imap.pl
Executable file
1328
S/imap_tools.V1.333/maildir_to_imap.pl
Executable file
File diff suppressed because it is too large
Load diff
749
S/imap_tools.V1.333/mbxIMAPsync.pl
Executable file
749
S/imap_tools.V1.333/mbxIMAPsync.pl
Executable file
|
|
@ -0,0 +1,749 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use Socket;
|
||||
use FileHandle;
|
||||
use Fcntl;
|
||||
use Getopt::Std;
|
||||
use MIME::Base64 qw(encode_base64 decode_base64);
|
||||
|
||||
######################################################################
|
||||
# Program name mbxIMAPsync.pl #
|
||||
# Written by Rick Sanders #
|
||||
# Date 12 Feb 2004 #
|
||||
# #
|
||||
# Description #
|
||||
# #
|
||||
# mbxIMAPsync is used to synchronize the contents of a Unix #
|
||||
# mailfiles with an IMAP mailbox. The user supplies the location #
|
||||
# & name of the Unix mailbox (eg /var/mail/rfs) and the hostname, #
|
||||
# username, & password of the IMAP account along with the name #
|
||||
# of the IMAP mailbox. For example: #
|
||||
# #
|
||||
# ./mbxIMAPsync.pl -f /var/mail/rfs -i imapsrv/rfs/mypass -m INBOX #
|
||||
# #
|
||||
# mbxIMAPsync compares the messages in the mailfile with those in #
|
||||
# the IMAP mailbox by Message-Id and adds the ones in the mailfile #
|
||||
# which are not in the IMAP mailbox. Then it looks for messages #
|
||||
# in the IMAP mailbox which are not in the mailfile and removes #
|
||||
# them from the IMAP mailbox. #
|
||||
# #
|
||||
# See the Usage() for available options. #
|
||||
######################################################################
|
||||
|
||||
init();
|
||||
|
||||
connectToHost($imapHost, \$conn );
|
||||
login($imapUser,$imapPwd, $conn );
|
||||
|
||||
# Get list of msgs in the mailfile by Message-Id
|
||||
|
||||
$added=$purged=0;
|
||||
print STDOUT "Processing $mailfile\n";
|
||||
print STDOUT "Checking for messages to add\n";
|
||||
@msgs = readMbox( $mailfile );
|
||||
foreach $msg ( @msgs ) {
|
||||
@msgid = grep( /^Message-ID:/i, @$msg );
|
||||
($label,$msgid) = split(/:/, $msgid[0]);
|
||||
chomp $msgid;
|
||||
trim( *msgid );
|
||||
$mailfileMsgs{"$msgid"} = '1';
|
||||
push( @sourceMsgs, $msgid );
|
||||
|
||||
if ( !findMsg( $msgid, $mbx, $conn ) ) {
|
||||
# print STDOUT "Need to add msgid >$msgid<\n";
|
||||
my $message;
|
||||
|
||||
foreach $_ ( @$msg ) { chop $_; $message .= "$_\r\n"; }
|
||||
|
||||
if ( insertMsg($mbx, \$message, $flags, $date, $conn ) ) {
|
||||
$added++;
|
||||
print STDOUT " Added $msgid\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Remove any messages from the IMAP mailbox that no longer
|
||||
# exist in the mailfile
|
||||
|
||||
print STDOUT "Checking for messages to purge\n";
|
||||
getMsgList( $mbx, \@imapMsgs, $conn );
|
||||
foreach $msgid ( @imapMsgs ) {
|
||||
if ( $mailfileMsgs{"$msgid"} eq '' ) {
|
||||
if ( deleteMsg($msgid, $mbx, $conn ) ) {
|
||||
Log(" Marked $msgid for deletion");
|
||||
print STDOUT " Marked msgid $msgid for deletion\n";
|
||||
$deleted++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $deleted ) {
|
||||
# Need to purge the deleted messages
|
||||
$purged = expungeMbx( $mbx, $conn );
|
||||
}
|
||||
|
||||
Log("Done");
|
||||
Log("Added $added messages to IMAP mailbox $mbx");
|
||||
Log("Purged $purged messages from IMAP mailbox $mbx");
|
||||
|
||||
print STDOUT "\nAdded $added messages to IMAP mailbox $mbx\n";
|
||||
print STDOUT "Purged $purged messages from IMAP mailbox $mbx\n";
|
||||
|
||||
exit;
|
||||
|
||||
|
||||
sub init {
|
||||
|
||||
if ( ! getopts('f:m:i:L:dxA:F:I') ) {
|
||||
usage();
|
||||
exit;
|
||||
}
|
||||
|
||||
($imapHost,$imapUser,$imapPwd) = split(/\//, $opt_i);
|
||||
$mailfile = $opt_f;
|
||||
$mbx = $opt_m;
|
||||
$logfile = $opt_L;
|
||||
$admin_user = $opt_A;
|
||||
$msgs_per_folder = $opt_F;
|
||||
$debug = 1 if $opt_d;
|
||||
$showIMAP = 1;
|
||||
|
||||
if ( $logfile ) {
|
||||
if ( ! open (LOG, ">> $logfile") ) {
|
||||
print "Can't open logfile $logfile: $!\n";
|
||||
$logfile = '';
|
||||
}
|
||||
}
|
||||
Log("\nThis is mbxIMAPsync\n");
|
||||
|
||||
if ( !-e $mailfile ) {
|
||||
Log("$mailfile does not exist");
|
||||
exit;
|
||||
}
|
||||
|
||||
# Determine whether we have SSL support via openSSL and IO::Socket::SSL
|
||||
$ssl_installed = 1;
|
||||
eval 'use IO::Socket::SSL';
|
||||
if ( $@ ) {
|
||||
$ssl_installed = 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub usage {
|
||||
|
||||
print "Usage: mbxIMAPsync.pl\n";
|
||||
print " -f <location of mailfiles>\n";
|
||||
print " -i imapHost/imapUser/imapPassword\n";
|
||||
print " -m <IMAP mailbox>\n";
|
||||
print " [-L <logfile>]\n";
|
||||
print " [-d debug]\n";
|
||||
|
||||
}
|
||||
|
||||
sub readMbox {
|
||||
|
||||
my $file = shift;
|
||||
my @mail = ();
|
||||
my $mail = [];
|
||||
my $blank = 1;
|
||||
local *FH;
|
||||
local $_;
|
||||
|
||||
Log("Reading the mailfile") if $debug;
|
||||
open(FH,"< $file") or die "Can't open $file";
|
||||
|
||||
while(<FH>) {
|
||||
if($blank && /\AFrom .*\d{4}/) {
|
||||
push(@mail, $mail) if scalar(@{$mail});
|
||||
$mail = [ $_ ];
|
||||
$blank = 0;
|
||||
}
|
||||
else {
|
||||
$blank = m#\A\Z#o ? 1 : 0;
|
||||
push(@{$mail}, $_);
|
||||
}
|
||||
}
|
||||
|
||||
push(@mail, $mail) if scalar(@{$mail});
|
||||
close(FH);
|
||||
|
||||
return wantarray ? @mail : \@mail;
|
||||
}
|
||||
|
||||
sub Log {
|
||||
|
||||
my $line = shift;
|
||||
my $msg;
|
||||
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time);
|
||||
$msg = sprintf ("%.2d-%.2d-%.4d.%.2d:%.2d:%.2d %s",
|
||||
$mon + 1, $mday, $year + 1900, $hour, $min, $sec, $line);
|
||||
|
||||
if ( $logfile ) {
|
||||
print LOG "$msg\n";
|
||||
}
|
||||
print STDERR "$line\n";
|
||||
|
||||
}
|
||||
|
||||
# Make a connection to a IMAP host
|
||||
|
||||
sub connectToHost {
|
||||
|
||||
my $host = shift;
|
||||
my $conn = shift;
|
||||
|
||||
Log("Connecting to $host") if $debug;
|
||||
|
||||
($host,$port) = split(/:/, $host);
|
||||
$port = 143 unless $port;
|
||||
|
||||
# We know whether to use SSL for ports 143 and 993. For any
|
||||
# other ones we'll have to figure it out.
|
||||
$mode = sslmode( $host, $port );
|
||||
|
||||
if ( $mode eq 'SSL' ) {
|
||||
unless( $ssl_installed == 1 ) {
|
||||
warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
exit;
|
||||
}
|
||||
Log("Attempting an SSL connection") if $debug;
|
||||
$$conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
Domain => AF_INET,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
$error = IO::Socket::SSL::errstr();
|
||||
Log("Error connecting to $host: $error");
|
||||
exit;
|
||||
}
|
||||
} else {
|
||||
# Non-SSL connection
|
||||
Log("Attempting a non-SSL connection") if $debug;
|
||||
$$conn = IO::Socket::INET->new(
|
||||
Proto => "tcp",
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
Log("Error connecting to $host:$port: $@");
|
||||
warn "Error connecting to $host:$port: $@";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
# Log("Connected to $host on port $port");
|
||||
|
||||
}
|
||||
|
||||
sub sslmode {
|
||||
|
||||
my $host = shift;
|
||||
my $port = shift;
|
||||
my $mode;
|
||||
|
||||
# Determine whether to make an SSL connection
|
||||
# to the host. Return 'SSL' if so.
|
||||
|
||||
if ( $port == 143 ) {
|
||||
# Standard non-SSL port
|
||||
return '';
|
||||
} elsif ( $port == 993 ) {
|
||||
# Standard SSL port
|
||||
return 'SSL';
|
||||
}
|
||||
|
||||
unless ( $ssl_installed ) {
|
||||
# We don't have SSL installed on this machine
|
||||
return '';
|
||||
}
|
||||
|
||||
# For any other port we need to determine whether it supports SSL
|
||||
|
||||
my $conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
if ( $conn ) {
|
||||
close( $conn );
|
||||
$mode = 'SSL';
|
||||
} else {
|
||||
$mode = '';
|
||||
}
|
||||
|
||||
return $mode;
|
||||
}
|
||||
|
||||
#
|
||||
# login in at the source host with the user's name and password
|
||||
#
|
||||
sub login {
|
||||
|
||||
my $user = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
if ( $admin_user ) {
|
||||
($admin_user,$admin_pwd) = split(/:/, $admin_user);
|
||||
login_plain( $user, $admin_user, $admin_pwd, $conn ) or exit;
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ( $pwd =~ /^oauth2:(.+)/i ) {
|
||||
$token = $1;
|
||||
Log("password is an OAUTH2 token");
|
||||
login_xoauth2( $user, $token, $conn );
|
||||
return 1;
|
||||
}
|
||||
|
||||
Log("Logging in as $user") if $debug;
|
||||
sendCommand ($conn, "1 LOGIN $user $pwd");
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
if ($response =~ /^1 OK/i) {
|
||||
last;
|
||||
}
|
||||
elsif ($response =~ /NO/) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
Log("Logged in as $user") if $debug;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# login_plain
|
||||
#
|
||||
# login in at the source host with the user's name and password. If provided
|
||||
# with administrator credential, use them as this eliminates the need for the
|
||||
# user's password.
|
||||
#
|
||||
sub login_plain {
|
||||
|
||||
my $user = shift;
|
||||
my $admin = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it.
|
||||
|
||||
if ( !$admin ) {
|
||||
# Log in as the user
|
||||
$admin = $user
|
||||
}
|
||||
|
||||
$login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd);
|
||||
$login_str = encode_base64("$login_str", "");
|
||||
$len = length( $login_str );
|
||||
|
||||
# sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" );
|
||||
sendCommand ($conn, "1 AUTHENTICATE PLAIN" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
last if $response =~ /\+/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
sendCommand ($conn, "$login_str" );
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
|
||||
if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) {
|
||||
# The destination is an Exchange server
|
||||
$exchange = 1;
|
||||
Log("The destination is an Exchange server");
|
||||
}
|
||||
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
# login_xoauth2
|
||||
#
|
||||
# login in at the source host with the user's name and an XOAUTH2 token.
|
||||
#
|
||||
sub login_xoauth2 {
|
||||
|
||||
my $user = shift;
|
||||
my $token = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = XOAUTH2 login
|
||||
|
||||
$login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", '');
|
||||
sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^\+ (.+)/ ) {
|
||||
$error = decode_base64( $1 );
|
||||
Log("XOAUTH authentication as $user failed: $error");
|
||||
return 0;
|
||||
}
|
||||
last if $response =~ /^1 OK/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
Log("login complete") if $debug;
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
|
||||
# logout
|
||||
#
|
||||
# log out from the host
|
||||
#
|
||||
sub logout {
|
||||
|
||||
my $conn = shift;
|
||||
|
||||
++$lsn;
|
||||
undef @response;
|
||||
sendCommand ($conn, "$lsn LOGOUT");
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^$lsn OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected LOGOUT response: $response");
|
||||
last;
|
||||
}
|
||||
}
|
||||
close $conn;
|
||||
return;
|
||||
}
|
||||
|
||||
# readResponse
|
||||
#
|
||||
# This subroutine reads and formats an IMAP protocol response from an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub readResponse
|
||||
{
|
||||
local($fd) = shift @_;
|
||||
|
||||
$response = <$fd>;
|
||||
chop $response;
|
||||
$response =~ s/\r//g;
|
||||
push (@response,$response);
|
||||
Log ("<< $response",2) if $showIMAP;
|
||||
}
|
||||
|
||||
#
|
||||
# sendCommand
|
||||
#
|
||||
# This subroutine formats and sends an IMAP protocol command to an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub sendCommand
|
||||
{
|
||||
local($fd) = shift @_;
|
||||
local($cmd) = shift @_;
|
||||
|
||||
print $fd "$cmd\r\n";
|
||||
|
||||
if ($showIMAP) { Log (">> $cmd",2); }
|
||||
}
|
||||
|
||||
#
|
||||
sub insertMsg {
|
||||
|
||||
my $mbx = shift;
|
||||
my $message = shift;
|
||||
my $flags = shift;
|
||||
my $date = shift;
|
||||
my $conn = shift;
|
||||
my ($lsn,$lenx);
|
||||
|
||||
Log(" Inserting message into mailbox $mbx") if $debug;
|
||||
$lenx = length($$message);
|
||||
|
||||
# Create the mailbox unless we have already done so
|
||||
++$lsn;
|
||||
if ($destMbxs{"$mbx"} eq '') {
|
||||
Log("creating mailbox $mbx") if $debug;
|
||||
sendCommand (IMAP, "$lsn CREATE \"$mbx\"");
|
||||
while ( 1 ) {
|
||||
readResponse (IMAP);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
if (!($response =~ /already exists|reserved mailbox name/i)) {
|
||||
Log ("WARNING: $response");
|
||||
}
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$destMbxs{"$mbx"} = '1';
|
||||
|
||||
++$lsn;
|
||||
$flags =~ s/\\Recent//i;
|
||||
|
||||
# &sendCommand (IMAP, "$lsn APPEND \"$mbx\" ($flags) \"$date\" \{$lenx\}");
|
||||
sendCommand (IMAP, "$lsn APPEND \"$mbx\" \{$lenx\}");
|
||||
readResponse (IMAP);
|
||||
if ( $response !~ /^\+/ ) {
|
||||
Log ("unexpected APPEND response: $response");
|
||||
# next;
|
||||
push(@errors,"Error appending message to $mbx for $user");
|
||||
return 0;
|
||||
}
|
||||
|
||||
print IMAP "$$message\r\n";
|
||||
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse (IMAP);
|
||||
if ( $response =~ /^$lsn OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected APPEND response: $response");
|
||||
# next;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# getMsgList
|
||||
#
|
||||
# Get a list of the user's messages in the indicated mailbox on
|
||||
# the IMAP host
|
||||
#
|
||||
sub getMsgList {
|
||||
|
||||
my $mailbox = shift;
|
||||
my $msgs = shift;
|
||||
my $conn = shift;
|
||||
my $seen;
|
||||
my $empty;
|
||||
my $msgnum;
|
||||
|
||||
Log("Getting list of msgs in $mailbox") if $debug;
|
||||
trim( *mailbox );
|
||||
sendCommand ($conn, "1 EXAMINE \"$mailbox\"");
|
||||
undef @response;
|
||||
$empty=0;
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ / 0 EXISTS/i ) { $empty=1; }
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
# print STDERR "response $response\n";
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected response: $response");
|
||||
# print STDERR "Error: $response\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (Message-Id)])");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
# print STDERR "response $response\n";
|
||||
last;
|
||||
}
|
||||
elsif ( $XDXDXD ) {
|
||||
Log ("unexpected response: $response");
|
||||
Log ("Unable to get list of messages in this mailbox");
|
||||
push(@errors,"Error getting list of $user's msgs");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
# Get a list of the msgs in the mailbox
|
||||
#
|
||||
undef @msgs;
|
||||
undef $flags;
|
||||
for $i (0 .. $#response) {
|
||||
$seen=0;
|
||||
$_ = $response[$i];
|
||||
|
||||
last if /OK FETCH complete/;
|
||||
|
||||
if ( $response[$i] =~ /FETCH \(UID / ) {
|
||||
$response[$i] =~ /\* ([^FETCH \(UID]*)/;
|
||||
$msgnum = $1;
|
||||
}
|
||||
|
||||
if ($response[$i] =~ /FLAGS/) {
|
||||
# Get the list of flags
|
||||
$response[$i] =~ /FLAGS \(([^\)]*)/;
|
||||
$flags = $1;
|
||||
$flags =~ s/\\Recent//i;
|
||||
}
|
||||
if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) {
|
||||
### $response[$i] =~ /INTERNALDATE (.+) ([^BODY]*)/i;
|
||||
$response[$i] =~ /INTERNALDATE (.+) BODY/i;
|
||||
$date = $1;
|
||||
$date =~ s/"//g;
|
||||
}
|
||||
if ( $response[$i] =~ /^Message-Id:/i ) {
|
||||
($label,$msgid) = split(/: /, $response[$i]);
|
||||
push (@$msgs,$msgid);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# trim
|
||||
#
|
||||
# remove leading and trailing spaces from a string
|
||||
sub trim {
|
||||
|
||||
local (*string) = @_;
|
||||
|
||||
$string =~ s/^\s+//;
|
||||
$string =~ s/\s+$//;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub findMsg {
|
||||
|
||||
my $msgid = shift;
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
my $msgnum;
|
||||
my $noSuchMbx;
|
||||
|
||||
Log("Searching for $msgid in $mbx") if $debug;
|
||||
sendCommand ( $conn, "1 SELECT \"$mbx\"");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 NO/ ) {
|
||||
$noSuchMbx = 1;
|
||||
last;
|
||||
}
|
||||
last if $response =~ /^1 OK/;
|
||||
}
|
||||
return '' if $noSuchMbx;
|
||||
|
||||
Log("Search for $msgid") if $debug;
|
||||
sendCommand ( $conn, "1 SEARCH header Message-Id \"$msgid\"");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /\* SEARCH /i ) {
|
||||
($dmy, $msgnum) = split(/\* SEARCH /i, $response);
|
||||
($msgnum) = split(/ /, $msgnum);
|
||||
}
|
||||
|
||||
last if $response =~ /^1 OK/;
|
||||
last if $response =~ /complete/i;
|
||||
}
|
||||
|
||||
if ( $msgnum ) {
|
||||
Log("Message exists") if $debug;
|
||||
} else {
|
||||
Log("Message does not exist") if $debug;
|
||||
}
|
||||
|
||||
return $msgnum;
|
||||
}
|
||||
|
||||
sub deleteMsg {
|
||||
|
||||
my $msgid = shift;
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
my $rc;
|
||||
|
||||
Log("Deleting message $msgid") if $debug;
|
||||
$msgnum = findMsg( $msgid, $mbx, $conn );
|
||||
|
||||
sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
$rc = 1;
|
||||
Log(" Marked $msgid for delete");
|
||||
last;
|
||||
}
|
||||
|
||||
if ( $response =~ /^1 BAD|^1 NO/i ) {
|
||||
Log("Error setting \Deleted flag for msg $msgnum: $response");
|
||||
$rc = 0;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
return $rc;
|
||||
|
||||
}
|
||||
|
||||
sub expungeMbx {
|
||||
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
my $purged=0;
|
||||
|
||||
Log("Purging $mbx") if $debug;
|
||||
sendCommand ( $conn, "1 SELECT \"$mbx\"");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
last if $response =~ /^1 OK/;
|
||||
|
||||
if ( $response =~ /^1 NO|^1 BAD/i ) {
|
||||
Log("Error selecting mailbox $mbx: $response");
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
sendCommand ( $conn, "1 EXPUNGE");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
last if $response =~ /^1 OK/;
|
||||
$purged++ if $response =~ /EXPUNGE/i;
|
||||
|
||||
if ( $response =~ /^1 BAD|^1 NO/i ) {
|
||||
print STDOUT "Error expunging messages: $response\n";
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
return $purged;
|
||||
|
||||
}
|
||||
|
||||
2467
S/imap_tools.V1.333/migrateIMAP.pl
Normal file
2467
S/imap_tools.V1.333/migrateIMAP.pl
Normal file
File diff suppressed because it is too large
Load diff
1080
S/imap_tools.V1.333/pop3toimap.pl
Executable file
1080
S/imap_tools.V1.333/pop3toimap.pl
Executable file
File diff suppressed because it is too large
Load diff
797
S/imap_tools.V1.333/purgeMbx.pl
Executable file
797
S/imap_tools.V1.333/purgeMbx.pl
Executable file
|
|
@ -0,0 +1,797 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# $Header: /mhub4/sources/imap-tools/purgeMbx.pl,v 1.7 2015/06/05 11:32:25 rick Exp $
|
||||
|
||||
############################################################################
|
||||
# Program name purgeMbx.pl #
|
||||
# Written by Rick Sanders #
|
||||
# Date 5/24/2008 #
|
||||
# #
|
||||
# Description #
|
||||
# #
|
||||
# This script deletes all of the messages in a user's IMAP #
|
||||
# mailbox. #
|
||||
# #
|
||||
# purgeMbx.pl is called like this: #
|
||||
# ./purgeMbx.pl -s host/user/password -m <mailbox> #
|
||||
# #
|
||||
# Note that the mailbox name is case-sensitive. #
|
||||
# #
|
||||
# Optional arguments: #
|
||||
# -d debug #
|
||||
# -L <logfile> #
|
||||
############################################################################
|
||||
|
||||
############################################################################
|
||||
# Copyright (c) 2008 Rick Sanders <rfs9999@earthlink.net> #
|
||||
# #
|
||||
# Permission to use, copy, modify, and distribute this software for any #
|
||||
# purpose with or without fee is hereby granted, provided that the above #
|
||||
# copyright notice and this permission notice appear in all copies. #
|
||||
# #
|
||||
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES #
|
||||
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF #
|
||||
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR #
|
||||
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES #
|
||||
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN #
|
||||
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF #
|
||||
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. #
|
||||
############################################################################
|
||||
|
||||
use Socket;
|
||||
use FileHandle;
|
||||
use Fcntl;
|
||||
use Getopt::Std;
|
||||
use IO::Socket;
|
||||
use MIME::Base64 qw(encode_base64 decode_base64 );
|
||||
|
||||
#################################################################
|
||||
# Main program. #
|
||||
#################################################################
|
||||
|
||||
init();
|
||||
|
||||
sigprc();
|
||||
|
||||
# Get list of all messages on the source host by Message-Id
|
||||
#
|
||||
connectToHost($host, \$conn);
|
||||
login($user,$pwd, $conn) or exit;
|
||||
|
||||
if ( $mbx eq '*' ) {
|
||||
@mailboxes = listMailboxes( '*', $conn);
|
||||
} else {
|
||||
push( @mailboxes, $mbx );
|
||||
}
|
||||
|
||||
foreach $mbx ( @mailboxes ) {
|
||||
Log("Purging the \"$mbx\" mailbox");
|
||||
@sourceMsgs = ();
|
||||
getMsgList( $mbx, \@msgs, $conn );
|
||||
Log("$mbx mailbox is empty") unless @msgs;
|
||||
foreach $msgnum ( @msgs ) {
|
||||
$total++;
|
||||
deleteMsg( $msgnum, $conn );
|
||||
}
|
||||
expungeMbx( $mbx, $conn ) if @msgs;
|
||||
|
||||
Log("$total messages were deleted from \"$mbx\" mailbox");
|
||||
}
|
||||
|
||||
logout( $conn );
|
||||
|
||||
exit;
|
||||
|
||||
|
||||
sub init {
|
||||
|
||||
$version = 'V1.0.1';
|
||||
$os = $ENV{'OS'};
|
||||
|
||||
processArgs();
|
||||
|
||||
# Determine whether we have SSL support via openSSL and IO::Socket::SSL
|
||||
$ssl_installed = 1;
|
||||
eval 'use IO::Socket::SSL';
|
||||
if ( $@ ) {
|
||||
$ssl_installed = 0;
|
||||
}
|
||||
|
||||
$timeout = 60 unless $timeout;
|
||||
|
||||
# Open the logFile
|
||||
#
|
||||
if ( $logfile ) {
|
||||
if ( !open(LOG, ">> $logfile")) {
|
||||
print STDOUT "Can't open $logfile: $!\n";
|
||||
}
|
||||
select(LOG); $| = 1;
|
||||
}
|
||||
Log("\n$0 starting");
|
||||
$total=0;
|
||||
|
||||
}
|
||||
|
||||
#
|
||||
# sendCommand
|
||||
#
|
||||
# This subroutine formats and sends an IMAP protocol command to an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub sendCommand
|
||||
{
|
||||
local($fd) = shift @_;
|
||||
local($cmd) = shift @_;
|
||||
|
||||
print $fd "$cmd\r\n";
|
||||
|
||||
if ($showIMAP) { Log (">> $cmd",2); }
|
||||
}
|
||||
|
||||
#
|
||||
# readResponse
|
||||
#
|
||||
# This subroutine reads and formats an IMAP protocol response from an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub readResponse
|
||||
{
|
||||
local($fd) = shift @_;
|
||||
|
||||
$response = <$fd>;
|
||||
chop $response;
|
||||
$response =~ s/\r//g;
|
||||
push (@response,$response);
|
||||
if ($showIMAP) { Log ("<< $response",2); }
|
||||
}
|
||||
|
||||
#
|
||||
# Log
|
||||
#
|
||||
# This subroutine formats and writes a log message to STDERR.
|
||||
#
|
||||
|
||||
sub Log {
|
||||
|
||||
my $str = shift;
|
||||
|
||||
# If a logile has been specified then write the output to it
|
||||
# Otherwise write it to STDOUT
|
||||
|
||||
if ( $logfile ) {
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
|
||||
if ($year < 99) { $yr = 2000; }
|
||||
else { $yr = 1900; }
|
||||
$line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n",
|
||||
$mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str);
|
||||
print LOG "$line";
|
||||
}
|
||||
print STDOUT "$str\n";
|
||||
|
||||
}
|
||||
|
||||
# Make a connection to an IMAP host
|
||||
|
||||
sub connectToHost {
|
||||
|
||||
my $host = shift;
|
||||
my $conn = shift;
|
||||
|
||||
Log("Connecting to $host") if $debug;
|
||||
|
||||
($host,$port) = split(/:/, $host);
|
||||
$port = 143 unless $port;
|
||||
|
||||
# We know whether to use SSL for ports 143 and 993. For any
|
||||
# other ones we'll have to figure it out.
|
||||
$mode = sslmode( $host, $port );
|
||||
|
||||
if ( $mode eq 'SSL' ) {
|
||||
unless( $ssl_installed == 1 ) {
|
||||
warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
exit;
|
||||
}
|
||||
Log("Attempting an SSL connection") if $debug;
|
||||
$$conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
Domain => AF_INET,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
$error = IO::Socket::SSL::errstr();
|
||||
Log("Error connecting to $host: $error");
|
||||
warn("Error connecting to $host: $error");
|
||||
exit;
|
||||
}
|
||||
} else {
|
||||
# Non-SSL connection
|
||||
Log("Attempting a non-SSL connection") if $debug;
|
||||
$$conn = IO::Socket::INET->new(
|
||||
Proto => "tcp",
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
Log("Error connecting to $host:$port: $@");
|
||||
warn "Error connecting to $host:$port: $@";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
Log("Connected to $host on port $port");
|
||||
|
||||
}
|
||||
|
||||
sub sslmode {
|
||||
|
||||
my $host = shift;
|
||||
my $port = shift;
|
||||
my $mode;
|
||||
|
||||
# Determine whether to make an SSL connection
|
||||
# to the host. Return 'SSL' if so.
|
||||
|
||||
if ( $port == 143 ) {
|
||||
# Standard non-SSL port
|
||||
return '';
|
||||
} elsif ( $port == 993 ) {
|
||||
# Standard SSL port
|
||||
return 'SSL';
|
||||
}
|
||||
|
||||
unless ( $ssl_installed ) {
|
||||
# We don't have SSL installed on this machine
|
||||
return '';
|
||||
}
|
||||
|
||||
# For any other port we need to determine whether it supports SSL
|
||||
|
||||
my $conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
if ( $conn ) {
|
||||
close( $conn );
|
||||
$mode = 'SSL';
|
||||
} else {
|
||||
$mode = '';
|
||||
}
|
||||
|
||||
return $mode;
|
||||
}
|
||||
|
||||
|
||||
# trim
|
||||
#
|
||||
# remove leading and trailing spaces from a string
|
||||
sub trim {
|
||||
|
||||
local (*string) = @_;
|
||||
|
||||
$string =~ s/^\s+//;
|
||||
$string =~ s/\s+$//;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
# login
|
||||
#
|
||||
# login in at the source host with the user's name and password
|
||||
#
|
||||
sub login {
|
||||
|
||||
my $user = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
if ( $admin_user ) {
|
||||
($admin_user,$admin_pwd) = split(/:/, $admin_user);
|
||||
login_plain( $user, $admin_user, $admin_pwd, $conn ) or exit;
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ( $pwd =~ /^oauth2:(.+)/i ) {
|
||||
$token = $1;
|
||||
Log("password is an OAUTH2 token");
|
||||
login_xoauth2( $user, $token, $conn );
|
||||
return 1;
|
||||
}
|
||||
|
||||
sendCommand ($conn, "1 LOGIN $user $pwd");
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
if ($response =~ /1 OK/i) {
|
||||
last;
|
||||
}
|
||||
if ($response =~ /^(.+) NO|^(.+) BAD/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
Log("Logged in as $user") if $debug;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# login_plain
|
||||
#
|
||||
# login in at the source host with the user's name and password. If provided
|
||||
# with administrator credential, use them as this eliminates the need for the
|
||||
# user's password.
|
||||
#
|
||||
sub login_plain {
|
||||
|
||||
my $user = shift;
|
||||
my $admin = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it.
|
||||
|
||||
if ( !$admin ) {
|
||||
# Log in as the user
|
||||
$admin = $user
|
||||
}
|
||||
|
||||
$login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd);
|
||||
$login_str = encode_base64("$login_str", "");
|
||||
$len = length( $login_str );
|
||||
|
||||
# sendCommand ($conn, "1 AUTHENTICATE \"PLAIN\" {$len}" );
|
||||
sendCommand ($conn, "1 AUTHENTICATE PLAIN" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
last if $response =~ /\+/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
sendCommand ($conn, "$login_str" );
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
|
||||
if ( $response =~ /Microsoft Exchange/i and $conn eq $dst ) {
|
||||
# The destination is an Exchange server
|
||||
$exchange = 1;
|
||||
Log("The destination is an Exchange server");
|
||||
}
|
||||
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
exit;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
# login_xoauth2
|
||||
#
|
||||
# login in at the source host with the user's name and an XOAUTH2 token.
|
||||
#
|
||||
sub login_xoauth2 {
|
||||
|
||||
my $user = shift;
|
||||
my $token = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = XOAUTH2 login
|
||||
|
||||
$login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", '');
|
||||
sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^\+ (.+)/ ) {
|
||||
$error = decode_base64( $1 );
|
||||
Log("XOAUTH authentication as $user failed: $error");
|
||||
return 0;
|
||||
}
|
||||
last if $response =~ /^1 OK/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
Log("login complete") if $debug;
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
|
||||
# logout
|
||||
#
|
||||
# log out from the host
|
||||
#
|
||||
sub logout {
|
||||
|
||||
my $conn = shift;
|
||||
|
||||
++$lsn;
|
||||
undef @response;
|
||||
sendCommand ($conn, "$lsn LOGOUT");
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^$lsn OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected LOGOUT response: $response");
|
||||
last;
|
||||
}
|
||||
}
|
||||
close $conn;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
# getMsgList
|
||||
#
|
||||
# Get a list of messages in a mailbox
|
||||
#
|
||||
sub getMsgList {
|
||||
|
||||
my $mailbox = shift;
|
||||
my $msgs = shift;
|
||||
my $conn = shift;
|
||||
my $seen;
|
||||
my $empty;
|
||||
my $msgnum;
|
||||
my $from;
|
||||
my $flags;
|
||||
|
||||
trim( *mailbox );
|
||||
sendCommand ($conn, "1 SELECT \"$mailbox\"");
|
||||
undef @response;
|
||||
$empty=0;
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ / 0 EXISTS/i ) { $empty=1; }
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
# print STDERR "response $response\n";
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected response: $response");
|
||||
# print STDERR "Error: $response\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (From Date)])");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
# print STDERR "response $response\n";
|
||||
last;
|
||||
}
|
||||
last if $response =~ /^1 NO|^1 BAD/;
|
||||
}
|
||||
|
||||
@msgs = ();
|
||||
$flags = '';
|
||||
for $i (0 .. $#response) {
|
||||
last if $response[$i] =~ /^1 OK FETCH complete/i;
|
||||
|
||||
if ($response[$i] =~ /FLAGS/) {
|
||||
# Get the list of flags
|
||||
$response[$i] =~ /FLAGS \(([^\)]*)/;
|
||||
$flags = $1;
|
||||
$flags =~ s/\\Recent//;
|
||||
}
|
||||
|
||||
if ( $response[$i] =~ /INTERNALDATE/) {
|
||||
$response[$i] =~ /INTERNALDATE (.+) BODY/;
|
||||
# $response[$i] =~ /INTERNALDATE "(.+)" BODY/;
|
||||
$date = $1;
|
||||
|
||||
$date =~ /"(.+)"/;
|
||||
$date = $1;
|
||||
$date =~ s/"//g;
|
||||
}
|
||||
|
||||
# if ( $response[$i] =~ /\* (.+) [^FETCH]/ ) {
|
||||
if ( $response[$i] =~ /\* (.+) FETCH/ ) {
|
||||
($msgnum) = split(/\s+/, $1);
|
||||
}
|
||||
|
||||
if ( $msgnum && $date ) {
|
||||
push (@$msgs, $msgnum);
|
||||
$msgnum = $date = '';
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
sub fetchMsg {
|
||||
|
||||
my $msgnum = shift;
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
my $message;
|
||||
|
||||
Log(" Fetching msg $msgnum...") if $debug;
|
||||
sendCommand ($conn, "1 SELECT \"$mbx\"");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
last if ( $response =~ /1 OK/i );
|
||||
}
|
||||
|
||||
sendCommand( $conn, "1 FETCH $msgnum (rfc822)");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /1 OK/i ) {
|
||||
$size = length($message);
|
||||
last;
|
||||
}
|
||||
elsif ($response =~ /message number out of range/i) {
|
||||
Log ("Error fetching uid $uid: out of range",2);
|
||||
$stat=0;
|
||||
last;
|
||||
}
|
||||
elsif ($response =~ /Bogus sequence in FETCH/i) {
|
||||
Log ("Error fetching uid $uid: Bogus sequence in FETCH",2);
|
||||
$stat=0;
|
||||
last;
|
||||
}
|
||||
elsif ( $response =~ /message could not be processed/i ) {
|
||||
Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)");
|
||||
push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)");
|
||||
$stat=0;
|
||||
last;
|
||||
}
|
||||
elsif
|
||||
($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) {
|
||||
($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i);
|
||||
$cc = 0;
|
||||
$message = "";
|
||||
while ( $cc < $len ) {
|
||||
$n = 0;
|
||||
$n = read ($conn, $segment, $len - $cc);
|
||||
if ( $n == 0 ) {
|
||||
Log ("unable to read $len bytes");
|
||||
return 0;
|
||||
}
|
||||
$message .= $segment;
|
||||
$cc += $n;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $message;
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub usage {
|
||||
|
||||
print STDOUT "usage:\n";
|
||||
print STDOUT " purgeMbx.pl -S host/user/pwd -m <mbx>\n";
|
||||
print STDOUT " Optional arguments:\n";
|
||||
print STDOUT " -d debug\n";
|
||||
print STDOUT " -L <logfile>\n";
|
||||
print STDOUT " -A <admin_user:admin_password>\n";
|
||||
exit;
|
||||
|
||||
}
|
||||
|
||||
sub processArgs {
|
||||
|
||||
if ( !getopts( "dIs:L:m:hA:" ) ) {
|
||||
usage();
|
||||
}
|
||||
|
||||
($host,$user,$pwd) = split(/\//, $opt_s);
|
||||
|
||||
$mbx = $opt_m;
|
||||
$admin_user = $opt_A;
|
||||
$logfile = $opt_L;
|
||||
$debug = $showIMAP = 1 if $opt_d;
|
||||
$showIMAP = 1 if $opt_I;
|
||||
usage() if $opt_h;
|
||||
|
||||
}
|
||||
|
||||
sub deleteMsg {
|
||||
|
||||
my $msgnum = shift;
|
||||
my $conn = shift;
|
||||
my $rc;
|
||||
|
||||
sendCommand ( $conn, "1 STORE $msgnum +FLAGS (\\Deleted)");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
$rc = 1;
|
||||
Log(" Marked msg number $msgnum for delete") if $debug;
|
||||
last;
|
||||
}
|
||||
|
||||
if ( $response =~ /^1 BAD|^1 NO/i ) {
|
||||
Log("Error setting \Deleted flag for msg $msgnum: $response");
|
||||
$rc = 0;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
return $rc;
|
||||
|
||||
}
|
||||
|
||||
sub expungeMbx {
|
||||
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
|
||||
print STDOUT "Purging mailbox $mbx..." if $debug;
|
||||
|
||||
sendCommand ($conn, "1 SELECT \"$mbx\"");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
last if ( $response =~ /1 OK/i );
|
||||
}
|
||||
|
||||
sendCommand ( $conn, "1 EXPUNGE");
|
||||
$expunged=0;
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
$expunged++ if $response =~ /\* (.+) Expunge/i;
|
||||
last if $response =~ /^1 OK/;
|
||||
|
||||
if ( $response =~ /^1 BAD|^1 NO/i ) {
|
||||
print STDOUT "Error purging messages: $response\n";
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
$totalExpunged += $expunged;
|
||||
|
||||
# print STDOUT "$expunged messages purged\n" if $debug;
|
||||
|
||||
}
|
||||
|
||||
sub dieright {
|
||||
local($sig) = @_;
|
||||
print STDOUT "caught signal $sig\n";
|
||||
logout( $conn );
|
||||
exit(-1);
|
||||
}
|
||||
|
||||
sub sigprc {
|
||||
|
||||
$SIG{'HUP'} = 'dieright';
|
||||
$SIG{'INT'} = 'dieright';
|
||||
$SIG{'QUIT'} = 'dieright';
|
||||
$SIG{'ILL'} = 'dieright';
|
||||
$SIG{'TRAP'} = 'dieright';
|
||||
$SIG{'IOT'} = 'dieright';
|
||||
$SIG{'EMT'} = 'dieright';
|
||||
$SIG{'FPE'} = 'dieright';
|
||||
$SIG{'BUS'} = 'dieright';
|
||||
$SIG{'SEGV'} = 'dieright';
|
||||
$SIG{'SYS'} = 'dieright';
|
||||
$SIG{'PIPE'} = 'dieright';
|
||||
$SIG{'ALRM'} = 'dieright';
|
||||
$SIG{'TERM'} = 'dieright';
|
||||
$SIG{'URG'} = 'dieright';
|
||||
}
|
||||
|
||||
# getMailboxList
|
||||
#
|
||||
# get a list of the user's mailboxes
|
||||
#
|
||||
sub getMailboxList {
|
||||
|
||||
my $conn = shift;
|
||||
my @mbxs;
|
||||
my $mbx;
|
||||
|
||||
# Get a list of the user's mailboxes
|
||||
#
|
||||
Log("Get list of user's mailboxes") if $debug;
|
||||
|
||||
sendCommand ($conn, "1 LIST \"\" *");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
undef @mbxs;
|
||||
for $i (0 .. $#response) {
|
||||
$response[$i] =~ s/\s+/ /;
|
||||
($dmy,$mbx) = split(/"\/"/,$response[$i]);
|
||||
$mbx =~ s/^\s+//; $mbx =~ s/\s+$//;
|
||||
$mbx =~ s/"//g;
|
||||
|
||||
if ($response[$i] =~ /NOSELECT/i) {
|
||||
if ($debugMode) { Log("$mbx is set NOSELECT,skip it",2); }
|
||||
next;
|
||||
}
|
||||
if ($mbx =~ /^\./) {
|
||||
# Skip mailboxes starting with a dot
|
||||
next;
|
||||
}
|
||||
push ( @mbxs, $mbx ) if $mbx ne '';
|
||||
}
|
||||
|
||||
return @mbxs;
|
||||
}
|
||||
|
||||
# listMailboxes
|
||||
#
|
||||
# Get a list of the user's mailboxes
|
||||
#
|
||||
sub listMailboxes {
|
||||
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
my @mbxs;
|
||||
|
||||
sendCommand ($conn, "1 LIST \"\" \"$mbx\"");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
&readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
&Log ("unexpected response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
@mbxs = ();
|
||||
for $i (0 .. $#response) {
|
||||
$response[$i] =~ s/\s+/ /;
|
||||
if ( $response[$i] =~ /"$/ ) {
|
||||
$response[$i] =~ /\* LIST \((.*)\) "(.+)" "(.+)"/i;
|
||||
$mbx = $3;
|
||||
} elsif ( $response[$i] =~ /\* LIST \((.*)\) NIL (.+)/i ) {
|
||||
$mbx = $2;
|
||||
} else {
|
||||
$response[$i] =~ /\* LIST \((.*)\) "(.+)" (.+)/i;
|
||||
$mbx = $3;
|
||||
}
|
||||
$mbx =~ s/^\s+//; $mbx =~ s/\s+$//;
|
||||
|
||||
if ($response[$i] =~ /NOSELECT/i) {
|
||||
$nosel_mbxs{"$mbx"} = 1;
|
||||
}
|
||||
push ( @mbxs, $mbx ) if $mbx ne '';
|
||||
}
|
||||
|
||||
return @mbxs;
|
||||
}
|
||||
|
||||
76
S/imap_tools.V1.333/release_notes_1.291.txt
Normal file
76
S/imap_tools.V1.333/release_notes_1.291.txt
Normal file
|
|
@ -0,0 +1,76 @@
|
|||
Release notes for IMAP-Tools version 1.291.
|
||||
Changes since 2014/06/12:
|
||||
|
||||
dumptoIMAP.pl 1.12 2014/06/21
|
||||
Fix handling of delimter and prefix when server does not supply NAMESPACE via -y argument.
|
||||
|
||||
dumptoIMAP.pl 1.11 2014/06/20
|
||||
Fix problem in get_mbx_list caused by the path not being as expected and causing the filespec to not have a leading '/'
|
||||
|
||||
imap_audit.pl 1.6 2014/07/24
|
||||
Added support for "before date" and "after date" audits. Also added building of "dummy" msgids for messages lacking them.
|
||||
|
||||
imapcopy.pl 1.138 2014/07/21
|
||||
Added -O argument to tell imapcopy that both servers are Dovecot using the brain-dead mbox format where mailboxes can have messages or submailboxes but not both.
|
||||
|
||||
imapcopy.pl 1.136 2014/07/21
|
||||
Added -o <destination mailbox> to permit all messages to be copied to a single "archive" mailbox on the destination (and not to the regular mailboxes.)
|
||||
Prompt the user for source/dest user password if the password = PROMPT
|
||||
|
||||
imapcopy.pl 1.129 2014/07/02
|
||||
When building dummy msgids use the Date in the header rather than the INTERNALDATE. It seems that a server may adjust the internaldate according to its timezone.
|
||||
|
||||
imapcopy.pl 1.128 2014/07/02
|
||||
Tweak detection of message size because gmail doesn't send it the way most servers do.
|
||||
|
||||
imapcopy.pl 1.127 2014/06/27
|
||||
Two changes: If a message does not have a Message-ID then build one for it from the Sender, Subject, and INTERNALDATE fields. So the same for the source and destination servers. If -l is set (dont_copy_source_dups) then duplicates on the source will not be copied.
|
||||
|
||||
imapcopy.pl 1.126 2014/06/16
|
||||
Add a 'special date' search function for a customer whose SEARCH command seems to be unreliable. This routine manually compares the INTERNALDATES with the value of -J 'SINCE|BEFORE <date>' argument.
|
||||
|
||||
imapcopy.pl 1.125 2014/06/13
|
||||
Notify msg to dest user with Subject of messages excluded because they exceed the maximum size argument
|
||||
|
||||
imapcopy.pl 1.123 2014/06/13
|
||||
Removed 'from the dest' from sub expunge() since the -r option can be used to purge messages on the source that have been copied.
|
||||
|
||||
imapsync.pl 1.62 2014/07/19
|
||||
Add support for backslash as delimiter for -S and -D host/user/pwd
|
||||
|
||||
imapsync.pl 1.60 2014/07/05
|
||||
Fix the getDatedMsg subroutine for built msgids.
|
||||
|
||||
imapsync.pl 1.58 2014/07/05
|
||||
Include the subject in the constructed msgid.
|
||||
|
||||
imapsync.pl 1.56 2014/07/05
|
||||
Build msgid from date,subject,sender if msgid is missing.
|
||||
|
||||
migrateIMAP.pl 1.54 2014/07/11
|
||||
Use from+header_date+subject for msgid if message lacks one.
|
||||
|
||||
pop3toimap.pl 1.8 2014/07/06
|
||||
Fix problem reading users file on Windows (last character was chopped off).
|
||||
|
||||
thunderbird_to_imap.pl 1.12 2014/07/09
|
||||
Added a range selector to deal with out-of-memory errors
|
||||
|
||||
thunderbird_to_imap.pl 1.11 2014/07/09
|
||||
Fix the way Tbird status codes are interpreted
|
||||
|
||||
thunderbird_to_imap.pl 1.10 2014/07/07
|
||||
Fixed problem with CRLF on some Windows boxes, added complete set of Thunderbird Mozilla status flags.
|
||||
|
||||
thunderbird_to_imap.pl 1.9 2014/07/01
|
||||
Don't print 'running in update mode' unless -U is set.
|
||||
|
||||
thunderbird_to_imap.pl 1.8 2014/07/01
|
||||
Tweak the end-of-message check because some Thunderbird folders have just "From " instead of "From xxxxxxxx"
|
||||
|
||||
thunderbird_to_imap.pl 1.6 2014/06/29
|
||||
Enhance the date-formatting code.
|
||||
|
||||
thunderbird_to_imap.pl 1.5 2014/06/28
|
||||
Fix opt_x which was used for two purposes; add opt_X (CRLF control) in its place.
|
||||
|
||||
30
S/imap_tools.V1.333/release_notes_1.298.txt
Normal file
30
S/imap_tools.V1.333/release_notes_1.298.txt
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
Release notes for IMAP-Tools version 1.298.
|
||||
Changes since 2014/07/25:
|
||||
|
||||
The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes
|
||||
|
||||
imap_audit.pl 1.15 2014/08/25
|
||||
Added -n argument to compare only the message counts on src and dest.
|
||||
Add more loop detection code
|
||||
Open mbxs in RO mode
|
||||
|
||||
imap_audit.pl 1.12 2014/07/27
|
||||
Strip off timezone offset when building dummy msgid
|
||||
|
||||
imap_audit.pl 1.11 2014/07/26
|
||||
Added -g argument to force use of dummy msgids for all messages
|
||||
|
||||
imap_audit.pl 1.10 2014/07/26
|
||||
If Message-ID line is wrapped get it from following line
|
||||
|
||||
imapcopy.cgi 1.9 2014/08/18
|
||||
Make the 'Cannot redirect to STDERR' error message more informative.
|
||||
|
||||
imapfilter.pl 1.46 2014/09/01
|
||||
Fixed 'test' mode counters.
|
||||
Add support for numeric date offsets instead of fixed dates in ISEARCH rules
|
||||
Fix issue with chunking of messages. Add -X <Trash> argument for emptying the Trash folder at the end of the run.
|
||||
|
||||
imapsync.pl 1.63 2014/08/26
|
||||
Added -t (dry run) feature.
|
||||
|
||||
95
S/imap_tools.V1.333/release_notes_1.300.txt
Normal file
95
S/imap_tools.V1.333/release_notes_1.300.txt
Normal file
|
|
@ -0,0 +1,95 @@
|
|||
Release notes for IMAP-Tools version 1.300.
|
||||
Changes since 2014/09/03:
|
||||
|
||||
The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes
|
||||
|
||||
IMAPtoMbox.pl 1.11 2014/10/15
|
||||
Added support for oauth2 logins
|
||||
|
||||
MboxtoIMAP.pl 1.21 2014/10/15
|
||||
Add 'use decode_base64' for OAUTH2 login error message
|
||||
|
||||
MboxtoIMAP.pl 1.20 2014/10/15
|
||||
Added support for OAUTH2 logins
|
||||
|
||||
delIMAPdups.pl 1.26 2014/10/15
|
||||
Added support for oauth2 logins
|
||||
|
||||
delete_imap_mailboxes.pl 1.7 2014/10/17
|
||||
Mark INBOX messages for delete with single 1:* command instead of individually
|
||||
|
||||
delete_imap_mailboxes.pl 1.6 2014/10/15
|
||||
Added support for oauth2 logins
|
||||
|
||||
delete_imap_mailboxes.pl 1.5 2014/10/15
|
||||
Drop -i argument for purging the INBOX and make it automatic.
|
||||
|
||||
delete_imap_mailboxes.pl 1.4 2014/10/14
|
||||
Added -i argument to purge the inbox.
|
||||
|
||||
dumptoIMAP.pl 1.13 2014/10/15
|
||||
Added support for oauth2 logins
|
||||
|
||||
imapCapability.pl 1.9 2014/10/15
|
||||
Added support for oauth2 logins
|
||||
|
||||
imap_audit.pl 1.16 2014/10/15
|
||||
Added support for oauth2 logins
|
||||
|
||||
imap_search.pl 1.3 2014/10/17
|
||||
Added support for oauth2 logins
|
||||
|
||||
imap_to_maildir.pl 1.5 2014/10/15
|
||||
Added support for oauth2 logins
|
||||
|
||||
imapcopy.pl 1.141 2014/10/14
|
||||
Added support for Gmail oauth2 tokens.
|
||||
|
||||
imapcopy.pl 1.140 2014/10/09
|
||||
Openwave the source mailbox in EXAMINE mode since a few servers otherwise mark the messages as SEEN.
|
||||
|
||||
imapdump.pl 1.29 2014/10/15
|
||||
Added support for oauth2 logins
|
||||
|
||||
imapdump.pl 1.28 2014/09/06
|
||||
Improve logging in debug mode
|
||||
|
||||
imapfilter.pl 1.47 2014/10/14
|
||||
Added support for oauth2 tokens
|
||||
|
||||
imapsync.pl 1.65 2014/10/15
|
||||
Added support for OAUTH2 logins
|
||||
|
||||
imapsync.pl 1.64 2014/09/05
|
||||
Added source_archive feature that moves messages from a source mailbox in an archive mailbox, also on the source.
|
||||
|
||||
list_account_sizes.pl 1.9 2014/10/15
|
||||
Added support for oauth2 logins
|
||||
|
||||
list_imap_folders.pl 1.15 2014/10/15
|
||||
Added support for oauth2 logins
|
||||
|
||||
maildir_to_imap.pl 1.7 2014/10/15
|
||||
Added support for oauth2 logins
|
||||
|
||||
mbxIMAPsync.pl 1.1 2014/10/16
|
||||
Added support for oauth2 logins
|
||||
|
||||
mbxIMAPsync.pl 1.2 2014/10/16
|
||||
Added support for oauth2 logins
|
||||
|
||||
migrateIMAP.pl 1.55 2014/10/16
|
||||
Added support for oauth2 logins
|
||||
|
||||
pop3toimap.pl 1.10 2014/10/16
|
||||
Added support for oauth2 logins
|
||||
|
||||
purgeMbx.pl 1.5 2014/10/16
|
||||
Added support for oauth2 logins
|
||||
|
||||
thunderbird_to_imap.pl 1.13 2014/10/16
|
||||
Added support for oauth2 logins
|
||||
|
||||
trash.pl 1.5 2014/10/16
|
||||
Added support for oauth2 logins
|
||||
|
||||
30
S/imap_tools.V1.333/release_notes_1.303.txt
Normal file
30
S/imap_tools.V1.333/release_notes_1.303.txt
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
Release notes for IMAP-Tools version 1.303.
|
||||
Changes since 20141017:
|
||||
|
||||
The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes
|
||||
|
||||
dumptoIMAP.pl 1.14 2014/11/10
|
||||
Correct -S host/user/pwd to -i host/user/pwd in the notes at the top of the script.
|
||||
|
||||
imapcopy.pl 1.143 2014/11/18
|
||||
Added -V argument to handle the response from Zimbra 6.0.16 which is not sending a closing ')' line in its response to the FETCH header items. Instead of ')' imapcopy considers ' FLAGS xxxxx' as the end of the FETCHED data.
|
||||
|
||||
imapcopy.pl 1.142 2014/11/06
|
||||
Removed 'server unvailable' error trap so that if that phrase appears in the text of a message it won't trigger a reconnect() action.
|
||||
|
||||
list_imap_folders.pl 1.18 2014/11/18
|
||||
Added ability to process list of users, added message subject to large message report.
|
||||
|
||||
list_imap_folders.pl 1.17 2014/11/18
|
||||
Added 'subject' field to large message report and fixed the -U argument.
|
||||
|
||||
list_imap_folders.pl 1.16 2014/11/15
|
||||
Add support for UWash-imap style mailboxes (MH)
|
||||
|
||||
maildir_to_imap.pl 1.9 2014/10/31
|
||||
Added -M <maildir_folder:imap_mbx> argument so the user can change the name of the IMAP mailbox to be different than the maildir folder name.
|
||||
|
||||
maildir_to_imap.pl 1.8 2014/10/30
|
||||
Require call to ctime() which is not needed.
|
||||
|
||||
|
||||
47
S/imap_tools.V1.333/release_notes_1.313.txt
Normal file
47
S/imap_tools.V1.333/release_notes_1.313.txt
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
Release notes for IMAP-Tools version 1.313.
|
||||
Changes since 2014/12/09:
|
||||
|
||||
The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes
|
||||
|
||||
IMAPtoMbox.pl 1.12 2015/02/02
|
||||
Fixed IMAP FETCH parsing
|
||||
|
||||
delIMAPdups.pl 1.28 2015/01/29
|
||||
Added -r <range> argument for message range to check, eg -r 1:1000
|
||||
|
||||
delIMAPdups.pl.files 1.2 2015/01/30
|
||||
-p argument was not being honored.
|
||||
|
||||
imap_audit.pl 1.18 2015/02/02
|
||||
Fixed problem with IMAP FETCH parsing
|
||||
|
||||
imap_audit.pl 1.17 2015/01/31
|
||||
Increase max loop counter
|
||||
|
||||
imap_search.pl 1.4 2015/02/02
|
||||
Fixed IMAP FETCH parsing
|
||||
|
||||
imapcopy.pl 1.146 2015/02/01
|
||||
Fixed FETCH parsing bug exposed by new Zimbra version.
|
||||
|
||||
imapcopy.pl 1.145 2015/01/22
|
||||
Add a "skip message-id" option using imapcopy.skip to hold msgs to be skipped
|
||||
|
||||
imapdump.pl 1.34 2015/02/02
|
||||
Fixed IMAP FETCH parsing
|
||||
|
||||
imapfilter.pl 1.48 2015/01/23
|
||||
Added -T <mailbox> feature which processes a mailbox and its subfolders only.
|
||||
|
||||
imapsync.pl 1.66 2015/02/02
|
||||
Fetch problem with IMAP FETCH parsing
|
||||
|
||||
migrateIMAP.pl 1.58 2015/02/01
|
||||
Fixed FETCH parser bug
|
||||
|
||||
migrateIMAP.pl 1.57 2015/01/27
|
||||
Skip the [Gmail]/All Mail folder
|
||||
|
||||
migrateIMAP.pl 1.56 2015/01/21
|
||||
Detect a * BYE response from the server when fetching messages headers and exit.
|
||||
|
||||
116
S/imap_tools.V1.333/release_notes_1.326.txt
Normal file
116
S/imap_tools.V1.333/release_notes_1.326.txt
Normal file
|
|
@ -0,0 +1,116 @@
|
|||
Release notes for IMAP-Tools version 1.326.
|
||||
Changes since 2015/02/03:
|
||||
|
||||
The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes
|
||||
|
||||
IMAPtoMbox.pl 1.13 2015/04/30
|
||||
The From address was missing from the first line in the message in the mbox file.
|
||||
|
||||
delIMAPdups.pl 1.30 2015/03/07
|
||||
sub getDelimiter was missing
|
||||
|
||||
delIMAPdups.pl 1.29 2015/03/07
|
||||
Fixed truncated line in code.
|
||||
|
||||
delIMAPdups.pl.files 1.3 2015/02/04
|
||||
Added -g (global) option
|
||||
|
||||
email_archive.pl 1.6 2015/02/21
|
||||
Clean up code for production release
|
||||
|
||||
email_attachment_cleaner.pl 1.6 2015/03/04
|
||||
Add option to save attachments but not strip them. Add option to specify list of attachments types.
|
||||
|
||||
email_attachment_cleaner.pl 1.5 2015/03/03
|
||||
Fix counter bug
|
||||
|
||||
email_attachment_cleaner.pl 1.4 2015/03/03
|
||||
Call validate_date() after get_date()
|
||||
|
||||
email_attachment_cleaner.pl 1.3 2015/03/03
|
||||
Fixes for test mode
|
||||
|
||||
email_attachment_cleaner.pl 1.2 2015/03/02
|
||||
Added some error checking
|
||||
|
||||
email_restore.cgi 1.1 2015/03/01
|
||||
Initial version =============================================================================
|
||||
|
||||
email_restore.cgi 1.4 2015/02/21
|
||||
Clean up code for production release
|
||||
|
||||
imap_audit.pl 1.20 2015/04/03
|
||||
Fix for multi-line Message-ID in message header
|
||||
|
||||
imap_audit.pl 1.19 2015/02/06
|
||||
Fixed a bug in the auth plain login routine
|
||||
|
||||
imap_cleaner.pl 1.5 2015/02/27
|
||||
Add -O <dir> option to save attachments in the specified directory
|
||||
|
||||
imap_cleaner.pl 1.4 2015/02/27
|
||||
Added -u and -p arguments for username and password. Removed list option.
|
||||
|
||||
imap_cleaner.pl 1.3 2015/02/27
|
||||
Added -U <user:password> argument
|
||||
|
||||
imap_cleaner.pl 1.2 2015/02/25
|
||||
Comment out date fixup code (not needed). Added test option
|
||||
|
||||
imapcopy.pl 1.157 2015/05/22
|
||||
Enhance reconnect() mode.
|
||||
|
||||
imapcopy.pl 1.156 2015/05/19
|
||||
Workaround to rename mailboxes with INBOX. prefix that shouldn't be there on the destination.
|
||||
|
||||
imapcopy.pl 1.155 2015/04/26
|
||||
Set the $exchange flag in AUTH PLAIN login mode if the destination is an Exchange server
|
||||
|
||||
imapcopy.pl 1.154 2015/04/24
|
||||
Tweak the mailbox mapping rules for the case where the source delimiter is an '_' character.
|
||||
|
||||
imapcopy.pl 1.153 2015/04/22
|
||||
Nested folders on destination not created correctly when source delimiter is a backslash character
|
||||
|
||||
imapcopy.pl 1.152 2015/04/18
|
||||
Added some additional error handling for Exchange-related errors
|
||||
|
||||
imapcopy.pl 1.151 2015/04/11
|
||||
Don't skip mailboxes starting with a dot.
|
||||
|
||||
imapcopy.pl 1.150 2015/04/03
|
||||
Added fix for multi-line Message-IDs to dated message search routine.
|
||||
|
||||
imapcopy.pl 1.149 2015/04/03
|
||||
Fix for multi-line Message-ID line in the header in update mode.
|
||||
|
||||
imapcopy.pl 1.148 2015/04/01
|
||||
Don't let a child process try to launch another child process in Parallel mode.
|
||||
|
||||
imapcopy.pl 1.147 2015/03/21
|
||||
Make -R argument apply to exclude-mailboxes as well as include-mailboxes
|
||||
|
||||
imapdump.pl 1.36 2015/03/05
|
||||
Added option to include all flags (not just S = seen) in the dumped filename. Also option to include custom flags, not just standard IMAP flags. And option to update the flags when they change on the server.
|
||||
|
||||
imapdump.pl 1.35 2015/03/04
|
||||
Build dummy msgid if the message lacks one.
|
||||
|
||||
imapsync.pl 1.67 2015/04/03
|
||||
Fix for multi-line msgids in message header
|
||||
|
||||
list_imap_folders.pl 1.25 2015/02/16
|
||||
Put a space between "fields" and "(Subject)" in body.peek command. The Rocklife MailSite IMAP server wants it that way.
|
||||
|
||||
migrateIMAP.pl 1.60 2015/05/20
|
||||
Handle the way that Domino responds to LIST command for nested mailboxes
|
||||
|
||||
migrateIMAP.pl 1.59 2015/04/05
|
||||
Fix for multi-line message-id
|
||||
|
||||
reload_archived_msgs.pl 1.1 2015/02/21
|
||||
Initial release =============================================================================
|
||||
|
||||
thunderbird_to_imap.pl 1.14 2015/03/15
|
||||
Use eval to protect against substr errors
|
||||
|
||||
14
S/imap_tools.V1.333/release_notes_V1.309.txt
Normal file
14
S/imap_tools.V1.333/release_notes_V1.309.txt
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
Release notes for IMAP-Tools version V1.309.
|
||||
Changes since 2014/11/19:
|
||||
|
||||
The release notes for earlier versions can be found at http://www.athensfbc.com/release_notes
|
||||
|
||||
delIMAPdups.pl 1.27 2014/11/22
|
||||
Accept either a space or colon as separator in users file.
|
||||
|
||||
imapdump.pl 1.31 2014/12/07
|
||||
Added parallel mode, multi-user mode, and extract-attachments-as-separate files option.
|
||||
|
||||
list_imap_folders.pl 1.24 2014/11/22
|
||||
When writing large message report don't call UTF-7 mailboxname conversion if the server doesn't have Perl support for it.
|
||||
|
||||
1138
S/imap_tools.V1.333/thunderbird_to_imap.pl
Executable file
1138
S/imap_tools.V1.333/thunderbird_to_imap.pl
Executable file
File diff suppressed because it is too large
Load diff
993
S/imap_tools.V1.333/trash.pl
Executable file
993
S/imap_tools.V1.333/trash.pl
Executable file
|
|
@ -0,0 +1,993 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# $Header: /mhub4/sources/imap-tools/trash.pl,v 1.5 2014/10/16 01:18:31 rick Exp $
|
||||
|
||||
#######################################################################
|
||||
# Description #
|
||||
# #
|
||||
# This script checks a user's IMAP mailboxes for deleted messages #
|
||||
# which it moves to the trash mailbox. Optionally the trash #
|
||||
# mailbox is emptied. #
|
||||
# #
|
||||
# trash.pl is called like this: #
|
||||
# ./trash.pl -S host/user/password #
|
||||
# #
|
||||
# Optional arguments: #
|
||||
# -i <user file> format: user password, omit pwd if -a #
|
||||
# -d debug #
|
||||
# -t <trash mailbox name> (defaults to 'Trash') #
|
||||
# -e empty the trash mailbox (default is not to empty it) #
|
||||
# -a <admin user:admin password> #
|
||||
# -L <logfile> #
|
||||
# -m mailbox list (check just certain mailboxes,see usage notes)#
|
||||
#######################################################################
|
||||
|
||||
use Socket;
|
||||
use FileHandle;
|
||||
use Fcntl;
|
||||
use Getopt::Std;
|
||||
use MIME::Base64 qw(encode_base64 decode_base64);
|
||||
use IO::Socket::INET;
|
||||
use IO::Socket::SSL;
|
||||
|
||||
#################################################################
|
||||
# Main program. #
|
||||
#################################################################
|
||||
|
||||
init();
|
||||
sigprc();
|
||||
|
||||
$n = scalar @users;
|
||||
Log("There are $n users");
|
||||
|
||||
foreach $_ ( @users ) {
|
||||
s/^\s+|\s$//g;
|
||||
($sourceUser,$sourcePwd) = split(/\s+/, $_);
|
||||
Log("$sourceUser");
|
||||
|
||||
# Get list of all messages on the source host by Message-Id
|
||||
#
|
||||
next unless connectToHost($sourceHost, \$src );
|
||||
|
||||
if ( $admin_user ) {
|
||||
# Do an admin login using AUTHENTICATION = PLAIN
|
||||
Log( "Login admin:" .$sourceUser."---". $admin_user ."---". $admin_pwd ) if $verbose;
|
||||
login_plain( $sourceUser, $admin_user, $admin_pwd, $src );
|
||||
} else {
|
||||
Log("Normal:".$sourceUser ."---".$sourcePwd) if $verbose;
|
||||
next unless login($sourceUser,$sourcePwd, $src);
|
||||
}
|
||||
|
||||
createMbx( $trash, $src ) unless mbxExists( $trash, $src);
|
||||
|
||||
@mbxs = getMailboxList($sourceUser, $src);
|
||||
|
||||
Log("Checking mailboxes for deleted messages") if $debug;
|
||||
$total=0;
|
||||
foreach $mbx ( @mbxs ) {
|
||||
next if $mbx eq $trash;
|
||||
next if $nosel_mbxs{"$mbx"};
|
||||
Log(" Checking mailbox $mbx") if $verbose;
|
||||
%msgList = ();
|
||||
@sourceMsgs = ();
|
||||
find_deleted_msgs( $mbx, \$msglist, $src );
|
||||
moveToTrash( $mbx, $trash, \$msglist, $src );
|
||||
expungeMbx( $mbx, $src );
|
||||
}
|
||||
|
||||
Log("$total messages were moved to $trash");
|
||||
|
||||
if ( $emptyTrash and ($total > 0) ) {
|
||||
expungeMbx( $trash, $src );
|
||||
Log("The $trash mailbox has been emptied");
|
||||
}
|
||||
|
||||
logout( $src );
|
||||
|
||||
$total_users++;
|
||||
$total_moved += $total;
|
||||
}
|
||||
|
||||
Log("Done.");
|
||||
Log("Summary:");
|
||||
Log(" Users processed $total_users");
|
||||
Log(" Messages moved $total_moved");
|
||||
exit;
|
||||
|
||||
|
||||
sub init {
|
||||
|
||||
$version = 'V1.0';
|
||||
$os = $ENV{'OS'};
|
||||
|
||||
&processArgs;
|
||||
|
||||
if ($timeout eq '') { $timeout = 60; }
|
||||
|
||||
# Open the logFile
|
||||
#
|
||||
if ( $logfile ) {
|
||||
if ( !open(LOG, ">> $logfile")) {
|
||||
print STDOUT "Can't open $logfile: $!\n";
|
||||
}
|
||||
select(LOG); $| = 1;
|
||||
}
|
||||
Log("\n$0 starting");
|
||||
$total=0;
|
||||
|
||||
# Determine whether we have SSL support via openSSL and IO::Socket::SSL
|
||||
$ssl_installed = 1;
|
||||
eval 'use IO::Socket::SSL';
|
||||
if ( $@ ) {
|
||||
$ssl_installed = 0;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# sendCommand
|
||||
#
|
||||
# This subroutine formats and sends an IMAP protocol command to an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub sendCommand
|
||||
{
|
||||
local($fd) = shift @_;
|
||||
local($cmd) = shift @_;
|
||||
|
||||
print $fd "$cmd\r\n";
|
||||
|
||||
if ($showIMAP) { Log (">> $cmd",2); }
|
||||
}
|
||||
|
||||
#
|
||||
# readResponse
|
||||
#
|
||||
# This subroutine reads and formats an IMAP protocol response from an
|
||||
# IMAP server on a specified connection.
|
||||
#
|
||||
|
||||
sub readResponse
|
||||
{
|
||||
local($fd) = shift @_;
|
||||
|
||||
$response = <$fd>;
|
||||
chop $response;
|
||||
$response =~ s/\r//g;
|
||||
push (@response,$response);
|
||||
if ($showIMAP) { Log ("<< $response",2); }
|
||||
}
|
||||
|
||||
#
|
||||
# Log
|
||||
#
|
||||
# This subroutine formats and writes a log message to STDERR.
|
||||
#
|
||||
|
||||
sub Log {
|
||||
|
||||
my $str = shift;
|
||||
|
||||
# If a logile has been specified then write the output to it
|
||||
# Otherwise write it to STDOUT
|
||||
|
||||
if ( $logfile ) {
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
|
||||
if ($year < 99) { $yr = 2000; }
|
||||
else { $yr = 1900; }
|
||||
$line = sprintf ("%.2d-%.2d-%d.%.2d:%.2d:%.2d %s %s\n",
|
||||
$mon + 1, $mday, $year + $yr, $hour, $min, $sec,$$,$str);
|
||||
print LOG "$line";
|
||||
}
|
||||
print STDOUT "$str\n";
|
||||
|
||||
}
|
||||
|
||||
# Make a connection to a IMAP host
|
||||
|
||||
sub connectToHost {
|
||||
|
||||
my $host = shift;
|
||||
my $conn = shift;
|
||||
|
||||
Log("Connecting to $host") if $debug;
|
||||
|
||||
($host,$port) = split(/:/, $host);
|
||||
$port = 143 unless $port;
|
||||
|
||||
# We know whether to use SSL for ports 143 and 993. For any
|
||||
# other ones we'll have to figure it out.
|
||||
$mode = sslmode( $host, $port );
|
||||
|
||||
if ( $mode eq 'SSL' ) {
|
||||
unless( $ssl_installed == 1 ) {
|
||||
warn("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
Log("You must have openSSL and IO::Socket::SSL installed to use an SSL connection");
|
||||
exit;
|
||||
}
|
||||
Log("Attempting an SSL connection") if $debug;
|
||||
$$conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
Domain => AF_INET,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
$error = IO::Socket::SSL::errstr();
|
||||
Log("Error connecting to $host: $error");
|
||||
return 0;
|
||||
}
|
||||
} else {
|
||||
# Non-SSL connection
|
||||
Log("Attempting a non-SSL connection") if $debug;
|
||||
$$conn = IO::Socket::INET->new(
|
||||
Proto => "tcp",
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
unless ( $$conn ) {
|
||||
Log("Error connecting to $host:$port: $@");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
Log("Connected to $host on port $port") if $debug;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
# trim
|
||||
#
|
||||
# remove leading and trailing spaces from a string
|
||||
sub trim {
|
||||
|
||||
local (*string) = @_;
|
||||
|
||||
$string =~ s/^\s+//;
|
||||
$string =~ s/\s+$//;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
# login
|
||||
#
|
||||
# login in at the source host with the user's name and password
|
||||
#
|
||||
sub login {
|
||||
|
||||
my $user = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
if ( $pwd =~ /^oauth2:(.+)/i ) {
|
||||
$token = $1;
|
||||
Log("password is an OAUTH2 token");
|
||||
$status = login_xoauth2( $user, $token, $conn );
|
||||
return $status;
|
||||
}
|
||||
|
||||
sendCommand ($conn, "1 LOGIN $user $pwd");
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
if ($response =~ /^1 OK/i) {
|
||||
last;
|
||||
}
|
||||
elsif ($response =~ /1 NO/) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
Log("Logged in as $user") if $debug;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# login_xoauth2
|
||||
#
|
||||
# login in at the source host with the user's name and an XOAUTH2 token.
|
||||
#
|
||||
sub login_xoauth2 {
|
||||
|
||||
my $user = shift;
|
||||
my $token = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = XOAUTH2 login
|
||||
|
||||
$login_str = encode_base64("user=". $user ."\x01auth=Bearer ". $token ."\x01\x01", '');
|
||||
sendCommand ($conn, "1 AUTHENTICATE XOAUTH2 $login_str" );
|
||||
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^\+ (.+)/ ) {
|
||||
$error = decode_base64( $1 );
|
||||
Log("XOAUTH authentication as $user failed: $error");
|
||||
return 0;
|
||||
}
|
||||
last if $response =~ /^1 OK/;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE|failed/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
Log("login complete") if $debug;
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
|
||||
# logout
|
||||
#
|
||||
# log out from the host
|
||||
#
|
||||
sub logout {
|
||||
|
||||
my $conn = shift;
|
||||
|
||||
undef @response;
|
||||
sendCommand ($conn, "1 LOGOUT");
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected LOGOUT response: $response");
|
||||
last;
|
||||
}
|
||||
}
|
||||
close $conn;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
# getMailboxList
|
||||
#
|
||||
# get a list of the user's mailboxes from the source host
|
||||
#
|
||||
sub getMailboxList {
|
||||
|
||||
my $user = shift;
|
||||
my $conn = shift;
|
||||
my @mbxs;
|
||||
|
||||
# Get a list of the user's mailboxes
|
||||
#
|
||||
if ( $mbxList ) {
|
||||
# The user has supplied a list of mailboxes so only processes
|
||||
# the ones in that list
|
||||
@mbxs = split(/,/, $mbxList);
|
||||
for $i (0..$#mbxs ) {
|
||||
$mbxs[$i] =~ s/^\s+//;
|
||||
$mbxs[$i] =~ s/s+$//;
|
||||
}
|
||||
return @mbxs;
|
||||
}
|
||||
|
||||
if ($debugMode) { Log("Get list of user's mailboxes",2); }
|
||||
|
||||
sendCommand ($conn, "1 LIST \"\" *");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
last;
|
||||
}
|
||||
elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected response: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
%nosel_mbxs = ();
|
||||
undef @mbxs;
|
||||
for $i (0 .. $#response) {
|
||||
# print STDERR "$response[$i]\n";
|
||||
$response[$i] =~ s/\s+/ /;
|
||||
($dmy,$mbx) = split(/"\/"/,$response[$i]);
|
||||
$mbx =~ s/^\s+//; $mbx =~ s/\s+$//;
|
||||
$mbx =~ s/"//g;
|
||||
|
||||
if ($response[$i] =~ /NOSELECT/i) {
|
||||
$nosel_mbxs{"$mbx"} = 1;
|
||||
}
|
||||
if (($mbx =~ /^\#/) && ($user ne 'anonymous')) {
|
||||
# Skip public mbxs unless we are migrating them
|
||||
next;
|
||||
}
|
||||
if ($mbx =~ /^\./) {
|
||||
# Skip mailboxes starting with a dot
|
||||
next;
|
||||
}
|
||||
push ( @mbxs, $mbx ) if $mbx ne '';
|
||||
}
|
||||
|
||||
if ( $mbxList ) {
|
||||
# The user has supplied a list of mailboxes so only processes
|
||||
# those
|
||||
@mbxs = split(/,/, $mbxList);
|
||||
}
|
||||
|
||||
return @mbxs;
|
||||
}
|
||||
|
||||
# getDeletedMsgs
|
||||
#
|
||||
# Get a list of deleted messages in the indicated mailbox on
|
||||
# the source host
|
||||
#
|
||||
sub getDeletedMsgs {
|
||||
|
||||
my $mailbox = shift;
|
||||
my $msgs = shift;
|
||||
my $conn = shift;
|
||||
my $seen;
|
||||
my $empty;
|
||||
my $msgnum;
|
||||
|
||||
@$msgs = ();
|
||||
trim( *mailbox );
|
||||
sendCommand ($conn, "1 SELECT \"$mailbox\"");
|
||||
undef @response;
|
||||
$empty=0;
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
# print STDERR "response $response\n";
|
||||
last;
|
||||
} elsif ( $response =~ / 0 EXISTS/i ) {
|
||||
$empty = 1;
|
||||
} elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected response: $response");
|
||||
print STDERR "Error: $response\n";
|
||||
return 0;
|
||||
}
|
||||
return 0 if $response =~ /^1 NO/;
|
||||
}
|
||||
|
||||
return if $empty;
|
||||
|
||||
sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (Message-ID Subject)])");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
# print STDERR "response $response\n";
|
||||
last;
|
||||
}
|
||||
elsif ( $response =~ /Broken pipe|Connection reset by peer/i ) {
|
||||
Log("Fetch from $mailbox: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
# Get a list of the msgs in the mailbox
|
||||
#
|
||||
undef @msgs;
|
||||
undef $flags;
|
||||
for $i (0 .. $#response) {
|
||||
$seen=0;
|
||||
$_ = $response[$i];
|
||||
|
||||
last if /OK FETCH complete/;
|
||||
|
||||
if ( $response[$i] =~ /FETCH \(UID / ) {
|
||||
$response[$i] =~ /\* ([^FETCH \(UID]*)/;
|
||||
$msgnum = $1;
|
||||
}
|
||||
|
||||
if ($response[$i] =~ /FLAGS/) {
|
||||
# Get the list of flags
|
||||
$deleted = 0;
|
||||
$response[$i] =~ /FLAGS \(([^\)]*)/;
|
||||
$flags = $1;
|
||||
$deleted = 1 if $flags =~ /Deleted/i;
|
||||
}
|
||||
if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) {
|
||||
$response[$i] =~ /INTERNALDATE ([^BODY]*)/i;
|
||||
$date = $1;
|
||||
$date =~ s/"//g;
|
||||
}
|
||||
if ( $response[$i] =~ /^Subject:/ ) {
|
||||
$response[$i] =~ /Subject: (.+)/;
|
||||
$subject = $1;
|
||||
}
|
||||
if ( $response[$i] =~ /^Message-Id:/ ) {
|
||||
($label,$msgid) = split(/: /, $response[$i]);
|
||||
trim(*msgid);
|
||||
$msgid =~ s/^\<//;
|
||||
$msgid =~ s/\>$//;
|
||||
push( @$msgs, $msgnum ) if $deleted;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# getDeletedMsgs
|
||||
#
|
||||
# Get a list of deleted messages in the indicated mailbox on
|
||||
# the source host
|
||||
#
|
||||
sub OLD_getDeletedMsgs {
|
||||
|
||||
my $mailbox = shift;
|
||||
my $msgs = shift;
|
||||
my $conn = shift;
|
||||
my $seen;
|
||||
my $empty;
|
||||
my $msgnum;
|
||||
|
||||
trim( *mailbox );
|
||||
sendCommand ($conn, "1 SELECT \"$mailbox\"");
|
||||
undef @response;
|
||||
$empty=0;
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
# print STDERR "response $response\n";
|
||||
last;
|
||||
} elsif ( $response =~ / 0 EXISTS/i ) {
|
||||
$empty = 1;
|
||||
} elsif ( $response !~ /^\*/ ) {
|
||||
Log ("unexpected response: $response");
|
||||
print STDERR "Error: $response\n";
|
||||
return 0;
|
||||
}
|
||||
return 0 if $response =~ /^1 NO/;
|
||||
}
|
||||
|
||||
return if $empty;
|
||||
|
||||
sendCommand ( $conn, "1 FETCH 1:* (uid flags internaldate body[header.fields (Message-ID Subject)])");
|
||||
undef @response;
|
||||
while ( 1 ) {
|
||||
readResponse ( $conn );
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
# print STDERR "response $response\n";
|
||||
last;
|
||||
}
|
||||
elsif ( $response =~ /Broken pipe|Connection reset by peer/i ) {
|
||||
Log("Fetch from $mailbox: $response");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
# Get a list of the msgs in the mailbox
|
||||
#
|
||||
undef @msgs;
|
||||
undef $flags;
|
||||
for $i (0 .. $#response) {
|
||||
$seen=0;
|
||||
$_ = $response[$i];
|
||||
|
||||
last if /OK FETCH complete/;
|
||||
|
||||
if ( $response[$i] =~ /FETCH \(UID / ) {
|
||||
$response[$i] =~ /\* ([^FETCH \(UID]*)/;
|
||||
$msgnum = $1;
|
||||
}
|
||||
|
||||
if ($response[$i] =~ /FLAGS/) {
|
||||
# Get the list of flags
|
||||
$deleted = 0;
|
||||
$response[$i] =~ /FLAGS \(([^\)]*)/;
|
||||
$flags = $1;
|
||||
$deleted = 1 if $flags =~ /Deleted/i;
|
||||
}
|
||||
if ( $response[$i] =~ /INTERNALDATE ([^\)]*)/ ) {
|
||||
$response[$i] =~ /INTERNALDATE ([^BODY]*)/i;
|
||||
$date = $1;
|
||||
$date =~ s/"//g;
|
||||
}
|
||||
if ( $response[$i] =~ /^Subject:/ ) {
|
||||
$response[$i] =~ /Subject: (.+)/;
|
||||
$subject = $1;
|
||||
}
|
||||
if ( $response[$i] =~ /^Message-Id:/ ) {
|
||||
($label,$msgid) = split(/: /, $response[$i]);
|
||||
trim(*msgid);
|
||||
$msgid =~ s/^\<//;
|
||||
$msgid =~ s/\>$//;
|
||||
push( @$msgs, $msgnum ) if $deleted;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub fetchMsg {
|
||||
|
||||
my $msgnum = shift;
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
my $message;
|
||||
|
||||
Log(" Fetching msg $msgnum...") if $debug;
|
||||
sendCommand ($conn, "1 SELECT \"$mbx\"");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
last if ( $response =~ /^1 OK/i );
|
||||
return 0 if $response =~ /^1 NO/;
|
||||
}
|
||||
|
||||
sendCommand( $conn, "1 FETCH $msgnum (rfc822)");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /^1 OK/i ) {
|
||||
$size = length($message);
|
||||
last;
|
||||
}
|
||||
elsif ($response =~ /message number out of range/i) {
|
||||
Log ("Error fetching uid $uid: out of range",2);
|
||||
$stat=0;
|
||||
last;
|
||||
}
|
||||
elsif ($response =~ /Bogus sequence in FETCH/i) {
|
||||
Log ("Error fetching uid $uid: Bogus sequence in FETCH",2);
|
||||
$stat=0;
|
||||
last;
|
||||
}
|
||||
elsif ( $response =~ /message could not be processed/i ) {
|
||||
Log("Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)");
|
||||
push(@errors,"Message could not be processed, skipping it ($user,msgnum $msgnum,$destMbx)");
|
||||
$stat=0;
|
||||
last;
|
||||
}
|
||||
elsif
|
||||
($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{[0-9]+\}/i) {
|
||||
($len) = ($response =~ /^\*\s+$msgnum\s+FETCH\s+\(.*RFC822\s+\{([0-9]+)\}/i);
|
||||
$cc = 0;
|
||||
$message = "";
|
||||
while ( $cc < $len ) {
|
||||
$n = 0;
|
||||
$n = read ($conn, $segment, $len - $cc);
|
||||
if ( $n == 0 ) {
|
||||
Log ("unable to read $len bytes");
|
||||
return 0;
|
||||
}
|
||||
$message .= $segment;
|
||||
$cc += $n;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $message;
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub usage {
|
||||
|
||||
print STDOUT "usage:\n";
|
||||
print STDOUT " trash.pl -S sourceHost/sourceUser/sourcePassword\n";
|
||||
print STDOUT " Optional arguments:\n";
|
||||
print STDOUT " -d debug\n";
|
||||
print STDOUT " -v verbose\n";
|
||||
print STDOUT " -I log IMAP commands and responses\n";
|
||||
print STDOUT " -t <trash mailbox name>\n";
|
||||
print STDOUT " -e empty trash mailbox\n";
|
||||
print STDOUT " -L <logfile>\n";
|
||||
print STDOUT " -m <mailbox list> (eg \"Inbox, Drafts, Notes\". Default is all mailboxes)\n";
|
||||
print STDOUT " -a <admin_user:admin_password>\n";
|
||||
exit;
|
||||
|
||||
}
|
||||
|
||||
sub processArgs {
|
||||
|
||||
if ( !getopts( "dvS:L:m:ht:ei:a:I" ) ) {
|
||||
usage();
|
||||
}
|
||||
|
||||
($sourceHost,$sourceUser,$sourcePwd) = split(/\//, $opt_S);
|
||||
$userList = $opt_i;
|
||||
$mbxList = $opt_m;
|
||||
$logfile = $opt_L;
|
||||
$trash = $opt_t;
|
||||
$admin_user = $opt_a;
|
||||
Log("Admin user:" . $admin_user ) if $verbose;
|
||||
$emptyTrash = 1 if $opt_e;
|
||||
$debug = 1 if $opt_d;
|
||||
$verbose = 1 if $opt_v;
|
||||
$showIMAP = 1 if $opt_I;
|
||||
|
||||
usage() if $opt_h;
|
||||
$trash = 'Trash' if !$trash;
|
||||
|
||||
if ( $userList ) {
|
||||
if ( !open(F, "<$userList") ) {
|
||||
Log("Error opening userlist $userList: $!");
|
||||
exit;
|
||||
}
|
||||
while( <F> ) {
|
||||
chomp;
|
||||
s/^\s+//;
|
||||
next if /^#/;
|
||||
push( @users, $_ );
|
||||
}
|
||||
close F;
|
||||
} else {
|
||||
push( @users, "$sourceUser $sourcePwd" );
|
||||
}
|
||||
|
||||
if ( $admin_user ) {
|
||||
$admin_user =~ /(.+):(.+)/;
|
||||
$admin_user = $1;
|
||||
$admin_pwd = $2;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub expungeMbx {
|
||||
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
|
||||
Log(" Purging mailbox $mbx") if $debug;
|
||||
|
||||
sendCommand ($conn, "1 SELECT \"$mbx\"");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
last if ( $response =~ /^1 OK/i );
|
||||
return 0 if $response =~ /^1 NO/;
|
||||
}
|
||||
|
||||
sendCommand ( $conn, "1 EXPUNGE");
|
||||
$expunged=0;
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
$expunged++ if $response =~ /\* (.+) Expunge/i;
|
||||
last if $response =~ /^1 OK/;
|
||||
|
||||
if ( $response =~ /^1 BAD|^1 NO/i ) {
|
||||
print "Error purging messages: $response\n";
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
$totalExpunged += $expunged;
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub dieright {
|
||||
local($sig) = @_;
|
||||
print STDOUT "caught signal $sig\n";
|
||||
logout( $src );
|
||||
exit(-1);
|
||||
}
|
||||
|
||||
sub sigprc {
|
||||
|
||||
$SIG{'HUP'} = 'dieright';
|
||||
$SIG{'INT'} = 'dieright';
|
||||
$SIG{'QUIT'} = 'dieright';
|
||||
$SIG{'ILL'} = 'dieright';
|
||||
$SIG{'TRAP'} = 'dieright';
|
||||
$SIG{'IOT'} = 'dieright';
|
||||
$SIG{'EMT'} = 'dieright';
|
||||
$SIG{'FPE'} = 'dieright';
|
||||
$SIG{'BUS'} = 'dieright';
|
||||
$SIG{'SEGV'} = 'dieright';
|
||||
$SIG{'SYS'} = 'dieright';
|
||||
$SIG{'PIPE'} = 'dieright';
|
||||
$SIG{'ALRM'} = 'dieright';
|
||||
$SIG{'TERM'} = 'dieright';
|
||||
$SIG{'URG'} = 'dieright';
|
||||
}
|
||||
|
||||
sub moveToTrash {
|
||||
|
||||
my $mbx = shift;
|
||||
my $trash = shift;
|
||||
my $msglist = shift;
|
||||
my $conn = shift;
|
||||
my $moved;
|
||||
|
||||
return if $mbx eq $trash;
|
||||
return if $$msglist eq '';
|
||||
|
||||
my @moved = split(/,/, $$msglist);
|
||||
$moved = scalar @moved;
|
||||
|
||||
sendCommand ($conn, "1 COPY $$msglist $trash");
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ($response =~ /NO/) {
|
||||
Log("unexpected COPY response: $response");
|
||||
Log("Please verify that mailbox $trash exists");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
Log(" Moved $moved messages from $mbx to $trash");
|
||||
$total += $moved;
|
||||
|
||||
}
|
||||
|
||||
|
||||
# login_plain
|
||||
#
|
||||
# login in at the source host with the user's name and password. If provided
|
||||
# with administrator credential, use them as this eliminates the need for the
|
||||
# user's password.
|
||||
#
|
||||
sub login_plain {
|
||||
|
||||
my $user = shift;
|
||||
my $admin = shift;
|
||||
my $pwd = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Do an AUTHENTICATE = PLAIN. If an admin user has been provided then use it.
|
||||
|
||||
if ( !$admin ) {
|
||||
# Log in as the user
|
||||
$admin = $user
|
||||
}
|
||||
|
||||
$login_str = sprintf("%s\x00%s\x00%s", $user,$admin,$pwd);
|
||||
$login_str = encode_base64("$login_str", "");
|
||||
$len = length( $login_str );
|
||||
|
||||
#sendCommand ($conn, "1 AUTHENTICATE PLAIN {$len}" );
|
||||
sendCommand ($conn, "1 AUTHENTICATE PLAIN $login_str" );
|
||||
|
||||
#my $loops;
|
||||
#while (1) {
|
||||
#readResponse ( $conn );
|
||||
#last if $response =~ /\+/;
|
||||
#if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
#Log ("unexpected LOGIN response: $response");
|
||||
#exit;
|
||||
#}
|
||||
#$last if $loops++ > 5;
|
||||
#}
|
||||
|
||||
#sendCommand ($conn, "$login_str" );
|
||||
my $loops;
|
||||
while (1) {
|
||||
readResponse ( $conn );
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ($response =~ /^1 NO|^1 BAD|^\* BYE/i) {
|
||||
Log ("unexpected LOGIN response: $response");
|
||||
return 0;
|
||||
}
|
||||
$last if $loops++ > 5;
|
||||
}
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
sub sslmode {
|
||||
|
||||
my $host = shift;
|
||||
my $port = shift;
|
||||
my $mode;
|
||||
|
||||
Log("CONNEXION SSL") if $verbose;
|
||||
# Determine whether to make an SSL connection
|
||||
# to the host. Return 'SSL' if so.
|
||||
|
||||
if ( $port == 143 ) {
|
||||
# Standard non-SSL port
|
||||
return '';
|
||||
} elsif ( $port == 993 ) {
|
||||
# Standard SSL port
|
||||
return 'SSL';
|
||||
}
|
||||
|
||||
unless ( $ssl_installed ) {
|
||||
# We don't have SSL installed on this machine
|
||||
return '';
|
||||
}
|
||||
|
||||
# For any other port we need to determine whether it supports SSL
|
||||
|
||||
my $conn = IO::Socket::SSL->new(
|
||||
Proto => "tcp",
|
||||
SSL_verify_mode => 0x00,
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
);
|
||||
|
||||
if ( $conn ) {
|
||||
close( $conn );
|
||||
$mode = 'SSL';
|
||||
} else {
|
||||
$mode = '';
|
||||
}
|
||||
|
||||
return $mode;
|
||||
}
|
||||
|
||||
sub find_deleted_msgs {
|
||||
|
||||
my $mbx = shift;
|
||||
my $msglist = shift;
|
||||
my $conn = shift;
|
||||
my $msgnum;
|
||||
|
||||
# Issue a SEARCH DELETED command to get a list of messages
|
||||
# marked for deletion.
|
||||
|
||||
$$msglist = '';
|
||||
Log("SELECT $mbx") if $debug;
|
||||
sendCommand ( $conn, "1 SELECT \"$mbx\"");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
last if $response =~ /^1 OK/;
|
||||
return 0 if $response =~ /^1 NO/;
|
||||
}
|
||||
|
||||
Log("Search for $msgid") if $debug;
|
||||
sendCommand ( $conn, "1 SEARCH DELETED");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
if ( $response =~ /\* SEARCH /i ) {
|
||||
($dmy, $$msglist) = split(/\* SEARCH /i, $response, 2);
|
||||
$$msglist =~ s/\s+/,/g;
|
||||
Log("msglist $$msglist") if $debug;
|
||||
}
|
||||
|
||||
last if $response =~ /^1 OK/;
|
||||
last if $response =~ /complete/i;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub createMbx {
|
||||
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
|
||||
# Create the mailbox if necessary
|
||||
|
||||
sendCommand ($conn, "1 CREATE \"$mbx\"");
|
||||
while ( 1 ) {
|
||||
readResponse ($conn);
|
||||
last if $response =~ /^1 OK/i;
|
||||
last if $response =~ /already exists/i;
|
||||
if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) {
|
||||
Log ("Error creating $mbx: $response");
|
||||
last;
|
||||
}
|
||||
if ( $response eq '' or $response =~ /^1 NO/ ) {
|
||||
Log ("unexpected CREATE response: >$response<");
|
||||
Log("response is NULL");
|
||||
resume();
|
||||
last;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub mbxExists {
|
||||
|
||||
my $mbx = shift;
|
||||
my $conn = shift;
|
||||
my $status = 1;
|
||||
|
||||
# Determine whether a mailbox exists
|
||||
sendCommand ($conn, "1 EXAMINE \"$mbx\"");
|
||||
while (1) {
|
||||
readResponse ($conn);
|
||||
last if $response =~ /^1 OK/i;
|
||||
if ( $response =~ /^1 NO|^1 BAD|^\* BYE/ ) {
|
||||
$status = 0;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
return $status;
|
||||
}
|
||||
|
||||
|
|
@ -4,7 +4,7 @@
|
|||
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en" id="TOP">
|
||||
|
||||
<head>
|
||||
<title>Imapsync list of imap server softwares supported (and the failures one)</title>
|
||||
<title>Imapsync list of 73 imap server software supported (and the few failures)</title>
|
||||
<meta name="generator" content="Bluefish 2.2.2" />
|
||||
<meta name="author" content="Gilles LAMIRAL" />
|
||||
<meta name="date" content="2016-04-10T00:24:15+0200" />
|
||||
|
|
@ -18,7 +18,10 @@
|
|||
<link rel="icon" type="image/png" href="../S/images/logo_imapsync_s.png" />
|
||||
<link href="../S/style.css" rel="stylesheet" type="text/css"/>
|
||||
|
||||
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1" />
|
||||
<!--
|
||||
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" />
|
||||
-->
|
||||
</head>
|
||||
|
||||
<body>
|
||||
|
|
@ -27,17 +30,22 @@
|
|||
<h1>Imapsync list of imap server softwares supported (and the failures one) <a id="imap_server_success" href="../#TOP"><small>(back to menu)</small></a>
|
||||
</h1>
|
||||
|
||||
<p>To know weither your IMAP server is a widespread choice,
|
||||
take a look at <a href="http://openemailsurvey.org/">http://openemailsurvey.org/</a>.
|
||||
</p>
|
||||
|
||||
<p>Let's start with the long reported <b>success stories</b> list: <b>
|
||||
67 different imap server softwares supported!</b><br/>
|
||||
72 different imap software servers supported!</b><br/>
|
||||
[host1] means "source server" and [host2] means "destination server":
|
||||
</p>
|
||||
|
||||
<p>Please report to the author (gilles.lamiral@laposte.net) any success or bad story with
|
||||
<p>Please report to the author (gilles.lamiral@laposte.net)
|
||||
any success or bad story with
|
||||
imapsync and, if you know them, mention the IMAP server
|
||||
software names and version on both sides. This will help
|
||||
future users. You can grab these values, software name and release number,
|
||||
by looking at two lines at the beginning of the output. Example:
|
||||
by looking at two lines at the beginning of the output.
|
||||
Example:
|
||||
</p>
|
||||
|
||||
<pre>
|
||||
|
|
@ -47,21 +55,24 @@ by looking at two lines at the beginning of the output. Example:
|
|||
</pre>
|
||||
|
||||
<p>You can use option --justconnect to get those lines.
|
||||
Examples (really working)):</p>
|
||||
Examples:</p>
|
||||
<pre>
|
||||
imapsync --host1 test1.lamiral.info --host2 test2.lamiral.info --justconnect
|
||||
|
||||
imapsync --host1 imap.gmail.com --ssl1 --host2 imap-mail.outlook.com --ssl2 --justconnect
|
||||
imapsync --host1 test1.lamiral.info \
|
||||
--host2 test2.lamiral.info \
|
||||
--justconnect
|
||||
</pre>
|
||||
|
||||
<p>And now the success imap server software list:</p>
|
||||
|
||||
<p>And now the imap servers software imapsync success list:</p>
|
||||
|
||||
<ol>
|
||||
<li>1und1 H mimap1 84498 [host1], H mibap4 95231 [host1](<a href="http://www.1und1.de/">http://www.1und1.de/</a>)</li>
|
||||
<li>a1.net imap.a1.net IMAP4 Ready [host1] </li>
|
||||
<li>Amazon AWS WorkMail IMAP server [host2]</li>
|
||||
<li><b>Apple Server</b> 10.6 Snow Leopard [host1] </li>
|
||||
<li>Archiveopteryx 2.03, 2.04, 2.09, 2.10 [host2], 3.0.0 [host2]
|
||||
(OSL 3.0) (<a href="http://www.archiveopteryx.org/">http://www.archiveopteryx.org/</a>)</li>
|
||||
<li>ArGoSoft IMAP Module Version 1.8 (1.8.8.2) <a href="http://www.argosoft.com/">http://www.argosoft.com/</a></li>
|
||||
<li>Atmail 6.x [host1] <a href="https://www.atmail.com/">https://www.atmail.com/</a></li>
|
||||
<li>Axigen Mail Server Version 8.0.0 (<a href="https://www.axigen.com/">https://www.axigen.com/</a>)</li>
|
||||
<li>BincImap 1.2.3 (GPL) (<a href="http://www.bincimap.org/">http://www.bincimap.org/</a>)</li>
|
||||
|
|
@ -99,6 +110,7 @@ Examples (really working)):</p>
|
|||
(<a href="http://www.microsoft.com/exchange/">http://www.microsoft.com/exchange/</a>)
|
||||
</li>
|
||||
<li>FirtClass 12 [host1] hard so read the FAQ! (<a href="http://www.firstclass.com/">http://www.firstclass.com/</a>)</li>
|
||||
<li>FortiMail 100C in server mode [host1] (<a href="https://www.fortinet.com/products/application-security/fortimail.html">https://www.fortinet.com/.../fortimail.html</a>)</li>
|
||||
<li>FTGate [host1][host2] (<a href="http://www.ftgate.com/">http://www.ftgate.com/</a>)</li>
|
||||
<li>Fusemail imap.fusemail.net:143 (<a href="https://www.fusemail.com/">https://www.fusemail.com/</a>).</li>
|
||||
<li><b>Gimap</b> (<b>Gmail</b> imap) [host1] [host2] (<a href="http://mail.google.com/">http://mail.google.com/</a>) </li>
|
||||
|
|
@ -111,9 +123,10 @@ Examples (really working)):</p>
|
|||
<li><b>Hotmail</b> hotmail.com is outlook.com and live.com now.</li>
|
||||
<li>IceWarp 10.4.5 [host1] 11.2.1.1 [host2] 11.4.1.0 [host2] (<a href="https://www.icewarp.com/">https://www.icewarp.com/</a>)</li>
|
||||
<li>IdeaImapServer v0.80.1 [host1] </li>
|
||||
<li>IMail 7.15 (Ipswitch/Win2003), 8.12, 11.03 [host1] (<a href="http://www.imailserver.com/">http://www.imailserver.com/</a>) </li>
|
||||
<li>iPlanet Messaging server 4.15, 5.1, 5.2
|
||||
(<a href="http://en.wikipedia.org/wiki/Oracle_Communications_Messaging_Server">http://en.wikipedia.org/wiki/Oracle_Communications_Messaging_Server</a>) </li>
|
||||
<li>IMail 7.15 (Ipswitch/Win2003), 8.12, 11.03 [host1] (<a href="http://www.imailserver.com/">http://www.imailserver.com/</a>) </li>
|
||||
<li>iRedMail, iRedMail imap server software is Dovecot. <a href="http://www.iredmail.org/">http://www.iredmail.org/</a></li>
|
||||
<li>Kerio 7.2.0P1 [host1] (<a href="http://www.kerio.com/">http://www.kerio.com/</a>) </li>
|
||||
<li>Mail2World IMAP4 Server 2.5 [host1] (<a href="http://www.mail2world.com/">http://www.mail2world.com/</a>)</li>
|
||||
<li><b>MailEnable</b> 4.23 [host1][host2], 4.26 [host1][host2], 5 [host1]
|
||||
|
|
@ -137,7 +150,7 @@ Examples (really working)):</p>
|
|||
|
||||
<li>Qualcomm Worldmail (NT) (<a href="http://www.eudora.com/worldmail/">http://www.eudora.com/worldmail/</a>) </li>
|
||||
<li>Rockliffe Mailsite 5.3.11, 4.5.6 (<a href="http://www.mailsite.com/">http://www.mailsite.com/</a>) </li>
|
||||
<li>RackSpace hoster secure.emailsrvr.com:993 <a href="http://www.rackspace.com/">http://www.rackspace.com/</a>)</li>
|
||||
<li>RackSpace hoster secure.emailsrvr.com:993 [host1] <a href="http://www.rackspace.com/">http://www.rackspace.com/</a>)</li>
|
||||
<li>QQMail IMAP4Server [host1] [host2] (See FAQ) <a href="https://en.mail.qq.com/">https://en.mail.qq.com/</a> </li>
|
||||
<li>Samsung Contact IMAP server 8.5.0 </li>
|
||||
<li>Scalix v10.1, 10.0.1.3, 11.0.0.431, 11.4.5, 11.4.6 (<a href="http://www.scalix.com/">http://www.scalix.com/</a>) </li>
|
||||
|
|
@ -208,7 +221,7 @@ alt="Viewable With Any Browser" />
|
|||
<!--#config timefmt="%D" -->
|
||||
<!--#config timefmt="%A %B %d, %Y" -->
|
||||
<b>This document last modified on <!--#echo var="LAST_MODIFIED" --></b>
|
||||
($Id: imapservers.shtml,v 1.15 2016/06/13 22:52:46 gilles Exp gilles $)<br/>
|
||||
($Id: imapservers.shtml,v 1.32 2017/09/11 03:04:46 gilles Exp gilles $)<br/>
|
||||
<a href="#TOP">Top of the page</a>
|
||||
</p>
|
||||
|
||||
|
|
|
|||
|
|
@ -1,86 +1,92 @@
|
|||
1225 Etats-Unis______________ 24.84 % 25 % 1
|
||||
918 Allemagne_______________ 18.62 % 43 % 2
|
||||
454 Royaume-Uni_____________ 9.21 % 53 % 3
|
||||
253 Italie__________________ 5.13 % 58 % 4
|
||||
243 France__________________ 4.93 % 63 % 5
|
||||
219 Canada__________________ 4.44 % 67 % 6
|
||||
199 Suisse__________________ 4.04 % 71 % 7
|
||||
183 Pays-Bas________________ 3.71 % 75 % 8
|
||||
172 Australie_______________ 3.49 % 78 % 9
|
||||
98 Autriche________________ 1.99 % 80 % 10
|
||||
91 Espagne_________________ 1.85 % 82 % 11
|
||||
88 Belgique________________ 1.78 % 84 % 12
|
||||
71 Suede___________________ 1.44 % 85 % 13
|
||||
58 Danemark________________ 1.18 % 87 % 14
|
||||
51 Bresil__________________ 1.03 % 88 % 15
|
||||
43 Norvege_________________ 0.87 % 89 % 16
|
||||
36 Pologne_________________ 0.73 % 89 % 17
|
||||
33 Finlande________________ 0.67 % 90 % 18
|
||||
28 Republique_tcheque______ 0.57 % 91 % 19
|
||||
26 Russie__________________ 0.53 % 91 % 20
|
||||
26 Japon___________________ 0.53 % 92 % 21
|
||||
25 ________________________ 0.51 % 92 % 22
|
||||
23 Nouvelle-Zelande________ 0.47 % 93 % 23
|
||||
23 Irlande_________________ 0.47 % 93 % 24
|
||||
23 Hongrie_________________ 0.47 % 93 % 25
|
||||
19 Portugal________________ 0.39 % 94 % 26
|
||||
18 Hong-Kong_______________ 0.37 % 94 % 27
|
||||
18 Grece___________________ 0.37 % 95 % 28
|
||||
18 Afrique_du_Sud__________ 0.37 % 95 % 29
|
||||
14 Slovaquie_______________ 0.28 % 95 % 30
|
||||
14 Malaisie________________ 0.28 % 96 % 31
|
||||
13 Luxembourg______________ 0.26 % 96 % 32
|
||||
13 Inde____________________ 0.26 % 96 % 33
|
||||
12 Singapour_______________ 0.24 % 96 % 34
|
||||
12 Mexique_________________ 0.24 % 97 % 35
|
||||
12 Argentine_______________ 0.24 % 97 % 36
|
||||
11 Israel__________________ 0.22 % 97 % 37
|
||||
11 Chine___________________ 0.22 % 97 % 38
|
||||
11 Chili___________________ 0.22 % 97 % 39
|
||||
10 Roumanie________________ 0.20 % 98 % 40
|
||||
9 Slovenie________________ 0.18 % 98 % 41
|
||||
9 Lettonie________________ 0.18 % 98 % 42
|
||||
9 Emirats_Arabes_Unis_____ 0.18 % 98 % 43
|
||||
7 Croatie_________________ 0.14 % 98 % 44
|
||||
6 Thailande_______________ 0.12 % 98 % 45
|
||||
5 Malte___________________ 0.10 % 99 % 46
|
||||
5 Islande_________________ 0.10 % 99 % 47
|
||||
4 Turquie_________________ 0.08 % 99 % 48
|
||||
4 Indonesie_______________ 0.08 % 99 % 49
|
||||
4 Estonie_________________ 0.08 % 99 % 50
|
||||
4 Egypte__________________ 0.08 % 99 % 51
|
||||
4 Bulgarie________________ 0.08 % 99 % 52
|
||||
3 Venezuela_______________ 0.06 % 99 % 53
|
||||
3 Serbie__________________ 0.06 % 99 % 54
|
||||
3 Philippines_____________ 0.06 % 99 % 55
|
||||
2 Vietnam_________________ 0.04 % 99 % 56
|
||||
2 Uruguay_________________ 0.04 % 99 % 57
|
||||
2 Perou___________________ 0.04 % 99 % 58
|
||||
2 Lituanie________________ 0.04 % 99 % 59
|
||||
2 Costa_Rica______________ 0.04 % 99 % 60
|
||||
2 Chypre__________________ 0.04 % 99 % 61
|
||||
2 Antilles_neerlandaises__ 0.04 % 100 % 62
|
||||
1 Ukraine_________________ 0.02 % 100 % 63
|
||||
1 Trinite-et-Tobago_______ 0.02 % 100 % 64
|
||||
1 Tanzanie________________ 0.02 % 100 % 65
|
||||
1 Taiwan__________________ 0.02 % 100 % 66
|
||||
1 Senegal_________________ 0.02 % 100 % 67
|
||||
1 Saint_Christophe-Nevis-Anguilla__ 0.02 % 100 % 68
|
||||
1 Qatar___________________ 0.02 % 100 % 69
|
||||
1 Panama__________________ 0.02 % 100 % 70
|
||||
1 Nouvelle-Caledonie______ 0.02 % 100 % 71
|
||||
1 Nigeria_________________ 0.02 % 100 % 72
|
||||
1 Namibie_________________ 0.02 % 100 % 73
|
||||
1 Mongolie________________ 0.02 % 100 % 74
|
||||
1 Moldavie________________ 0.02 % 100 % 75
|
||||
1 Maldives________________ 0.02 % 100 % 76
|
||||
1 Koweit__________________ 0.02 % 100 % 77
|
||||
1 Jordanie________________ 0.02 % 100 % 78
|
||||
1 Iles_Vierges_britanniques__ 0.02 % 100 % 79
|
||||
1 Grenade_________________ 0.02 % 100 % 80
|
||||
1 Coree_du_Sud____________ 0.02 % 100 % 81
|
||||
1 Colombie________________ 0.02 % 100 % 82
|
||||
1 Cameroun________________ 0.02 % 100 % 83
|
||||
1 Burkina_Faso____________ 0.02 % 100 % 84
|
||||
1 Bahrein_________________ 0.02 % 100 % 85
|
||||
TOTAL = 4931 sales 219147 EUR over 85 countries on Fri Aug 19 12:49:52 CEST 2016
|
||||
1373 Etats-Unis______________ 23.64 % 24 % 1
|
||||
1111 Allemagne_______________ 19.13 % 43 % 2
|
||||
521 Royaume-Uni_____________ 8.97 % 52 % 3
|
||||
343 Italie__________________ 5.90 % 58 % 4
|
||||
282 France__________________ 4.85 % 62 % 5
|
||||
244 Canada__________________ 4.20 % 67 % 6
|
||||
233 Pays-Bas________________ 4.01 % 71 % 7
|
||||
231 Suisse__________________ 3.98 % 75 % 8
|
||||
196 Australie_______________ 3.37 % 78 % 9
|
||||
128 Autriche________________ 2.20 % 80 % 10
|
||||
120 Espagne_________________ 2.07 % 82 % 11
|
||||
97 Belgique________________ 1.67 % 84 % 12
|
||||
87 Suede___________________ 1.50 % 85 % 13
|
||||
78 Danemark________________ 1.34 % 87 % 14
|
||||
55 Bresil__________________ 0.95 % 88 % 15
|
||||
47 Pologne_________________ 0.81 % 89 % 16
|
||||
45 Norvege_________________ 0.77 % 89 % 17
|
||||
37 Republique_tcheque______ 0.64 % 90 % 18
|
||||
37 Finlande________________ 0.64 % 91 % 19
|
||||
31 Russie__________________ 0.53 % 91 % 20
|
||||
29 Hongrie_________________ 0.50 % 92 % 21
|
||||
28 Nouvelle-Zelande________ 0.48 % 92 % 22
|
||||
27 Japon___________________ 0.46 % 93 % 23
|
||||
25 ________________________ 0.43 % 93 % 24
|
||||
23 Irlande_________________ 0.40 % 93 % 25
|
||||
22 Grece___________________ 0.38 % 94 % 26
|
||||
21 Portugal________________ 0.36 % 94 % 27
|
||||
20 Afrique_du_Sud__________ 0.34 % 95 % 28
|
||||
19 Hong-Kong_______________ 0.33 % 95 % 29
|
||||
17 Slovaquie_______________ 0.29 % 95 % 30
|
||||
17 Inde____________________ 0.29 % 95 % 31
|
||||
17 Argentine_______________ 0.29 % 96 % 32
|
||||
16 Mexique_________________ 0.28 % 96 % 33
|
||||
15 Malaisie________________ 0.26 % 96 % 34
|
||||
15 Chili___________________ 0.26 % 97 % 35
|
||||
14 Singapour_______________ 0.24 % 97 % 36
|
||||
14 Luxembourg______________ 0.24 % 97 % 37
|
||||
14 Chine___________________ 0.24 % 97 % 38
|
||||
13 Roumanie________________ 0.22 % 97 % 39
|
||||
12 Slovenie________________ 0.21 % 98 % 40
|
||||
11 Israel__________________ 0.19 % 98 % 41
|
||||
10 Emirats_Arabes_Unis_____ 0.17 % 98 % 42
|
||||
9 Lettonie________________ 0.15 % 98 % 43
|
||||
7 Croatie_________________ 0.12 % 98 % 44
|
||||
6 Thailande_______________ 0.10 % 98 % 45
|
||||
6 Islande_________________ 0.10 % 99 % 46
|
||||
5 Malte___________________ 0.09 % 99 % 47
|
||||
5 Estonie_________________ 0.09 % 99 % 48
|
||||
5 Egypte__________________ 0.09 % 99 % 49
|
||||
4 Turquie_________________ 0.07 % 99 % 50
|
||||
4 Indonesie_______________ 0.07 % 99 % 51
|
||||
4 Chypre__________________ 0.07 % 99 % 52
|
||||
4 Bulgarie________________ 0.07 % 99 % 53
|
||||
3 Venezuela_______________ 0.05 % 99 % 54
|
||||
3 Serbie__________________ 0.05 % 99 % 55
|
||||
3 Philippines_____________ 0.05 % 99 % 56
|
||||
3 Lituanie________________ 0.05 % 99 % 57
|
||||
3 Ireland_________________ 0.05 % 99 % 58
|
||||
2 Vietnam_________________ 0.03 % 99 % 59
|
||||
2 Uruguay_________________ 0.03 % 99 % 60
|
||||
2 Ukraine_________________ 0.03 % 99 % 61
|
||||
2 Perou___________________ 0.03 % 99 % 62
|
||||
2 Nouvelle-Caledonie______ 0.03 % 99 % 63
|
||||
2 Costa_Rica______________ 0.03 % 100 % 64
|
||||
2 Antilles_neerlandaises__ 0.03 % 100 % 65
|
||||
1 Trinite-et-Tobago_______ 0.02 % 100 % 66
|
||||
1 Tanzanie________________ 0.02 % 100 % 67
|
||||
1 Taiwan__________________ 0.02 % 100 % 68
|
||||
1 Senegal_________________ 0.02 % 100 % 69
|
||||
1 Saint_Christophe-Nevis-Anguilla__ 0.02 % 100 % 70
|
||||
1 Qatar___________________ 0.02 % 100 % 71
|
||||
1 Panama__________________ 0.02 % 100 % 72
|
||||
1 Nigeria_________________ 0.02 % 100 % 73
|
||||
1 Namibie_________________ 0.02 % 100 % 74
|
||||
1 Mongolie________________ 0.02 % 100 % 75
|
||||
1 Monaco__________________ 0.02 % 100 % 76
|
||||
1 Moldavie________________ 0.02 % 100 % 77
|
||||
1 Maldives________________ 0.02 % 100 % 78
|
||||
1 Koweit__________________ 0.02 % 100 % 79
|
||||
1 Jordanie________________ 0.02 % 100 % 80
|
||||
1 Jamaique________________ 0.02 % 100 % 81
|
||||
1 Iles_Vierges_britanniques__ 0.02 % 100 % 82
|
||||
1 Grenade_________________ 0.02 % 100 % 83
|
||||
1 Coree_du_Sud____________ 0.02 % 100 % 84
|
||||
1 Colombie________________ 0.02 % 100 % 85
|
||||
1 Cameroun________________ 0.02 % 100 % 86
|
||||
1 Burkina_Faso____________ 0.02 % 100 % 87
|
||||
1 Bosnie-Herzegovine______ 0.02 % 100 % 88
|
||||
1 Bahrein_________________ 0.02 % 100 % 89
|
||||
1 Arabie_Saoudite_________ 0.02 % 100 % 90
|
||||
1 Albanie_________________ 0.02 % 100 % 91
|
||||
TOTAL = 5809 sales 268740 EUR over 91 countries on Thu Sep 7 01:46:18 CEST 2017
|
||||
|
|
|
|||
|
|
@ -10,6 +10,11 @@
|
|||
|
||||
<link rel="icon" type="image/png" href="../S/images/logo_imapsync_s.png" >
|
||||
<link href="../S/style.css" rel="stylesheet" type="text/css">
|
||||
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1" />
|
||||
<!--
|
||||
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" />
|
||||
-->
|
||||
|
||||
<!--
|
||||
The link to the HTML5Shiv must be placed in the <head> element, after any stylesheets
|
||||
|
|
@ -17,8 +22,7 @@ http://www.w3schools.com/html/html5_browsers.asp
|
|||
-->
|
||||
<!--[if lt IE 9]>
|
||||
<script src="https://cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv.js"></script>
|
||||
<![endif]-->
|
||||
|
||||
<![endif]-->
|
||||
</head>
|
||||
|
||||
<body>
|
||||
|
|
@ -103,7 +107,7 @@ alt="Viewable With Any Browser"
|
|||
<!--#config timefmt="%D" -->
|
||||
<!--#config timefmt="%A %B %d, %Y" -->
|
||||
<b>This document was last modified on <!--#echo var="LAST_MODIFIED" --></b>
|
||||
($Id: mailing_list.shtml,v 1.2 2016/08/05 14:24:46 gilles Exp gilles $)<br>
|
||||
($Id: mailing_list.shtml,v 1.3 2016/12/20 10:06:54 gilles Exp gilles $)<br>
|
||||
<a href="#TOP">Top of the page</a>
|
||||
</p>
|
||||
</footer>
|
||||
|
|
|
|||
112
S/news.shtml
112
S/news.shtml
|
|
@ -1,5 +1,6 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"><html lang="en" id="TOP" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
|
||||
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
|
||||
<html lang="en" id="TOP" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
|
||||
<head>
|
||||
<meta http-equiv="content-type" content="application/xhtml+xml; charset=UTF-8" />
|
||||
<title>Imapsync News</title>
|
||||
|
|
@ -12,16 +13,21 @@
|
|||
|
||||
|
||||
<meta content="text/css" http-equiv="content-style-type" />
|
||||
<meta content="0" http-equiv="expires" />
|
||||
<meta content="0" http-equiv="expires" />
|
||||
<link href="../S/images/logo_imapsync_s.png" type="image/png" rel="icon" />
|
||||
<link type="text/css" rel="stylesheet" href="../S/style.css" />
|
||||
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1" />
|
||||
<!--
|
||||
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" />
|
||||
-->
|
||||
</head>
|
||||
|
||||
<body>
|
||||
|
||||
|
||||
<h1>News about next imapsync, currently distributed <!--#exec cmd="cat ../VERSION" -->, next and previous releases <a href="../#TOP" id="latest"><small>(back to menu)</small></a>
|
||||
<h1>News about next imapsync, currently distributed <!--#exec cmd="cat ../VERSION"-->,
|
||||
next and previous releases <a href="../#TOP" id="latest"><small>(back to menu)</small></a>
|
||||
</h1>
|
||||
|
||||
<p>imapsync <!--#exec cmd="cat ../VERSION" --> was written on <!--#flastmod file="VERSION" -->
|
||||
|
|
@ -33,7 +39,8 @@
|
|||
|
||||
<!--
|
||||
<ul>
|
||||
<li><b>1.694</b></li>
|
||||
<li><b>1.824</b></li>
|
||||
<li><b>Enhancement</b>: </li>
|
||||
<li><b>Enhancement</b>: </li>
|
||||
<li><b>Enhancement</b>: </li>
|
||||
<li><b>Enhancement</b>: </li>
|
||||
|
|
@ -41,21 +48,114 @@
|
|||
<li><b>Usability</b>: </li>
|
||||
<li><b>Usability</b>: </li>
|
||||
<li><b>Usability</b>: </li>
|
||||
<li><b>Usability</b>: </li>
|
||||
|
||||
<li><b>Bug fix</b>: </li>
|
||||
<li><b>Bug fix</b>: </li>
|
||||
<li><b>Bug fix</b>: </li>
|
||||
|
||||
<li><b>Refactoring</b>: Removed most of the perlcrit (Severity: 3) Regular expression without "/x" flag.</li>
|
||||
<li><b>Refactoring</b>: </li>
|
||||
<li><b>Refactoring</b>: </li>
|
||||
<li><b>Refactoring</b>: </li>
|
||||
|
||||
<li><b>Security</b>: </li>
|
||||
<li><b>Dependency</b>: </li>
|
||||
<li><b>Dependency added</b>: </li>
|
||||
|
||||
</ul>
|
||||
-->
|
||||
|
||||
|
||||
<ul>
|
||||
<li><b>1.836</b> More secure by default, ssl or tls activation!</li>
|
||||
|
||||
<li><b>Enhancement</b>: An <a href="https://hub.docker.com/r/gilleslamiral/imapsync/"><b>Imapsync Docker image</b></a> available!</li>
|
||||
|
||||
<li><b>Usability</b>: Now goes to SSL by default if port 993 is open. Use <tt>--nosslcheck</tt> to avoid that.</li>
|
||||
|
||||
<li><b>Usability</b>: Now goes to TLS by default if possible, ie, only if STARTTLS is in CAPABILITY. If you want only TLS and nothing else, use <tt>--tls1 --nossl1</tt></li>
|
||||
|
||||
<li><b>Usability</b>: Now if you want a basic imap connection on port 143 with no default encryption behavior, ie, no ssl nor tls,
|
||||
then use <tt>--nossl1 --notls1</tt> for host1 and <tt>--nossl2 --notls2</tt> for host2.</li>
|
||||
|
||||
<li><b>Enhancement</b>: Added <tt>--gmail1</tt> and <tt>--gmail2</tt> to simplify Gmail options setting.
|
||||
It sets parameters suggested in the <a href="../FAQ.d/FAQ.Gmail.txt">Gmail FAQ</a> <tt>--ssl</tt>, <tt>--host</tt>, etc.</li>
|
||||
|
||||
<li><b>Enhancement</b>: Added <tt>--office1</tt> and <tt>--office2</tt> to simplify Office 365 options setting.
|
||||
It sets parameters suggested in the <a href="../FAQ.d/FAQ.Exchange.txt">Exchange/Office365 FAQ</a>.</li>
|
||||
|
||||
<li><b>Enhancement</b>: Added <tt>--domino1</tt> and <tt>--domino2</tt> to simplify Domino options setting.
|
||||
It sets parameters suggested in the <a href="../FAQ.d/FAQ.Domino.txt">Domino FAQ</a>.</li>
|
||||
|
||||
<li><b>Enhancement</b>: Added <tt>--maxsleep</tt> in order to avoid timeouts with <tt>--maxbytespersecond</tt> and <tt>--maxmessagespersecond</tt> options.
|
||||
By default imapsync will sleep 2 seconds maximum, like if the command line contained <tt>--maxsleep 2</tt></li>
|
||||
|
||||
|
||||
<li><b>Enhancement</b>: Added <tt>--maxbytesafter</tt> in order to start <tt>--maxbytespersecond</tt> limitation only after
|
||||
<tt>--maxbytesafter</tt> amount of data transferred. Usefull for Gmail limits, for example,
|
||||
in order to active a 50K/s limit rate only after 500 MB of data transfer, use
|
||||
<tt>--maxbytesafter 500_000_000 --maxbytespersecond 50_000</tt></li>
|
||||
|
||||
<li><b>Enhancement</b>: Added <tt>--testsunit</tt> in order to run any unit test individualy from the command line.
|
||||
Several --testsunit are allowed. Example:
|
||||
<tt>imapsync --testsunit tests_true --testsunit tests_always_fail</tt></li>
|
||||
|
||||
|
||||
<li><b>Enhancement</b>: Added password setting via environment variables <tt>IMAPSYNC_PASSWORD1</tt> and <tt>IMAPSYNC_PASSWORD2</tt></li>
|
||||
|
||||
|
||||
<li><b>Usability</b>: No more useless and false warning <tt>"says it has NO CAPABILITY for AUTHENTICATE LOGIN"</tt></li>
|
||||
|
||||
|
||||
<li><b>Usability</b>: Options <tt>--delete1</tt> and <tt>--delete</tt> are now aliases.
|
||||
Option <tt>--delete1</tt> is preferable over <tt>--delete</tt> (<tt>--delete</tt> is still supported). </li>
|
||||
|
||||
<li><b>Usability</b>: Now prints always permanentflags info.
|
||||
It helps to understand most flag issues at first run, without <tt>--debugflags</tt></li>
|
||||
|
||||
<li><b>Usability</b>: Now prints "could not append ( Subject:[$subject], Date:[$h1_date], Size:[$h1_size] )"
|
||||
when append fails.</li>
|
||||
<li><b>Usability</b>: Option <tt>--showpasswords</tt> now shows also passwords with <tt>--debugimap</tt>. Useful to debug quoting issues.</li>
|
||||
|
||||
|
||||
<li><b>Usability</b>: <tt>--ipv4</tt> is now synonym of <tt>--inet4</tt> and <tt>--ipv6</tt> is now synonim of <tt>--inet6</tt></li>
|
||||
|
||||
<li><b>Usability</b>: Added <tt>--testslive6</tt> to check pure ipv6 connectivity.</li>
|
||||
|
||||
|
||||
<li><b>Enhancement</b>: Added <tt>--noabletosearch1</tt> and <tt>--noabletosearch2</tt>;
|
||||
Still support <tt>--noabletosearch</tt>, which turn on both <tt>--noabletosearch1</tt> and <tt>--noabletosearch2</tt>
|
||||
</li>
|
||||
<li><b>Enhancement</b>: Added <tt>--abort</tt> option to terminate a previous call still running.
|
||||
In command line context <tt>--abort</tt> uses the pidfile to know what to abort.
|
||||
In cgi context, ie online, exact same credentials are needed in order to really abort the other sync.</li>
|
||||
|
||||
<li><b>Enhancement</b>: Added milliseconds in the default logfile name since several runs is possible within one second in cgi context or on a powerful machine.</li>
|
||||
|
||||
<li><b>Docker context</b>: Added docker context in order to be run under the nobody user without permission issues.</li>
|
||||
<li><b>Docker context</b>: Can run imapsync <tt>--tests</tt> under nobody user on Unix (or at least Linux).</li>
|
||||
|
||||
<li><b>Bugfix</b>: Fixed issue "SSL routines:ssl3_check_cert_and_algorithm:dh key too small" with
|
||||
<a href="http://stackoverflow.com/questions/36417224/openssl-dh-key-too-small-error">openssl-dh-key-too-small-error</a>
|
||||
<tt>SSL_cipher_list => 'DEFAULT:!DH'</tt></li>
|
||||
|
||||
<li><b>CGI context</b>: Allow parameters passed by POST.</li>
|
||||
<li><b>CGI context</b>: Abort, before doing anything, if the server load is already too heavy,
|
||||
and invite to come later depending on the current load (1, 5, or 15 minutes later).</li>
|
||||
|
||||
<li><b>Bug fix</b>: Guessed prefix is the empty string even when there is no folders (which is a bad sign anyway, since INBOX should be listed).</li>
|
||||
<li><b>Bug fix</b>: Option <tt>--skipmess</tt> could not work most of the time. I guess it was a mistake arrived by badly converting an "unless" to an "if". Perl critics with no tests added => caveat emptor!</li>
|
||||
|
||||
|
||||
<li><b>Refactoring</b>: Removed Mail::IMAPClient overload definitions</li>
|
||||
|
||||
<li><b>Dependency added</b>: IO::Socket::SSL</li>
|
||||
<li><b>Dependency added</b>: Sys::MemInfo</li>
|
||||
<li><b>Dependency added</b>: Pod::Usage</li>
|
||||
|
||||
</ul>
|
||||
|
||||
|
||||
<ul>
|
||||
<li><b>1.727</b> https website and CGI on the way!</li>
|
||||
|
||||
|
|
@ -455,7 +555,7 @@ by ignoring PERMANENTFLAGS (Exchange tests)</li>
|
|||
<!--#config timefmt="%D" -->
|
||||
<!--#config timefmt="%A %B %d, %Y" -->
|
||||
<b>This document last modified on <!--#echo var="LAST_MODIFIED" --></b>
|
||||
($Id: news.shtml,v 1.28 2016/08/19 14:16:58 gilles Exp gilles $)<br />
|
||||
($Id: news.shtml,v 1.50 2017/09/11 03:04:46 gilles Exp gilles $)<br />
|
||||
<a href="#TOP">Top of the page</a>
|
||||
</p>
|
||||
</body></html>
|
||||
|
|
|
|||
|
|
@ -29,6 +29,11 @@ img{
|
|||
border:0px;
|
||||
}
|
||||
</style>
|
||||
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1" />
|
||||
<!--
|
||||
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" />
|
||||
-->
|
||||
</head>
|
||||
|
||||
|
||||
|
|
@ -48,22 +53,26 @@ border:0px;
|
|||
|
||||
<p>Thanks in advance!</p>
|
||||
|
||||
<hr/>
|
||||
<hr />
|
||||
<p>
|
||||
<a href="http://validator.w3.org/check?uri=referer"><img
|
||||
src="http://www.w3.org/Icons/valid-xhtml10"
|
||||
alt="Valid XHTML 1.0 Strict" height="31" width="88" /></a>
|
||||
|
||||
<a href="http://jigsaw.w3.org/css-validator/check/referer">
|
||||
<img style="border:0;width:88px;height:31px"
|
||||
src="http://jigsaw.w3.org/css-validator/images/vcss-blue"
|
||||
alt="CSS Valide !" />
|
||||
<a href="http://validator.w3.org/check?uri=referer">
|
||||
<img width="88" height="31" alt="Valid XHTML 1.0 Strict" src="../S/images/valid-xhtml10" />
|
||||
</a>
|
||||
|
||||
<a href="http://jigsaw.w3.org/css-validator/check/referer">
|
||||
<img alt="CSS Valide !" src="../S/images/vcss-blue" style="border:0;width:88px;height:31px" />
|
||||
</a>
|
||||
|
||||
<a href="http://www.anybrowser.org/campaign/">
|
||||
<img alt="Viewable With Any Browser" src="../S/images/ab_jlh.png" style="border:0;width:88px;height:31px" />
|
||||
</a>
|
||||
|
||||
|
||||
<!--#config timefmt="%D" -->
|
||||
<!--#config timefmt="%A %B %d, %Y" -->
|
||||
<b>This document last modified on <!--#echo var="LAST_MODIFIED" --></b>
|
||||
($Id: paypal.shtml,v 1.9 2016/03/03 15:57:41 gilles Exp gilles $)
|
||||
($Id: paypal.shtml,v 1.12 2016/12/20 10:06:54 gilles Exp gilles $)
|
||||
</p>
|
||||
|
||||
</body>
|
||||
|
|
|
|||
|
|
@ -29,6 +29,12 @@ img{
|
|||
border:0px;
|
||||
}
|
||||
</style>
|
||||
|
||||
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1" />
|
||||
<!--
|
||||
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" />
|
||||
-->
|
||||
</head>
|
||||
|
||||
<body>
|
||||
|
|
@ -114,10 +120,8 @@ style="border:0;width:88px;height:31px"
|
|||
<!--#config timefmt="%D" -->
|
||||
<!--#config timefmt="%A %B %d, %Y" -->
|
||||
<b>This document last modified on <!--#echo var="LAST_MODIFIED" --></b>
|
||||
($Id: paypal_return.shtml,v 1.27 2016/08/18 09:53:42 gilles Exp gilles $)
|
||||
($Id: paypal_return.shtml,v 1.32 2016/12/20 10:06:54 gilles Exp gilles $)
|
||||
</p>
|
||||
|
||||
|
||||
<!-- Google Code for Achat imapsync Conversion Page -->
|
||||
<script type="text/javascript">
|
||||
/* <![CDATA[ */
|
||||
|
|
@ -126,8 +130,8 @@ var google_conversion_language = "en";
|
|||
var google_conversion_format = "2";
|
||||
var google_conversion_color = "ffffff";
|
||||
var google_conversion_label = "hVVWCKzApQIQvOe62QM";
|
||||
var google_conversion_value = 1.00;
|
||||
var google_conversion_currency = "EUR";
|
||||
var google_conversion_value = "USD 1.00";
|
||||
var google_conversion_currency = "USD";
|
||||
var google_remarketing_only = false;
|
||||
/* ]]> */
|
||||
</script>
|
||||
|
|
@ -135,11 +139,12 @@ var google_remarketing_only = false;
|
|||
</script>
|
||||
<noscript>
|
||||
<div style="display:inline;">
|
||||
<img height="1" width="1" style="border-style:none;" alt="" src="//www.googleadservices.com/pagead/conversion/992916412/?value=1.00&currency_code=EUR&label=hVVWCKzApQIQvOe62QM&guid=ON&script=0"/>
|
||||
<img height="1" width="1" style="border-style:none;" alt="" src="//www.googleadservices.com/pagead/conversion/992916412/?value=1.00&currency_code=USD&label=hVVWCKzApQIQvOe62QM&guid=ON&script=0"/>
|
||||
</div>
|
||||
</noscript>
|
||||
|
||||
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,10 @@
|
|||
<link rel="icon" type="image/png" href="../S/images/logo_imapsync_s.png" />
|
||||
<link href="../S/style.css" rel="stylesheet" type="text/css"/>
|
||||
|
||||
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1" />
|
||||
<!--
|
||||
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" />
|
||||
-->
|
||||
</head>
|
||||
|
||||
<body>
|
||||
|
|
@ -89,7 +92,7 @@ alt="Viewable With Any Browser" />
|
|||
<!--#config timefmt="%D" -->
|
||||
<!--#config timefmt="%A %B %d, %Y" -->
|
||||
<b>This document last modified on <!--#echo var="LAST_MODIFIED" --></b>
|
||||
($Id: poll.shtml,v 1.2 2016/07/21 22:55:54 gilles Exp gilles $)<br/>
|
||||
($Id: poll.shtml,v 1.3 2016/12/20 10:06:54 gilles Exp gilles $)<br/>
|
||||
<a href="#TOP">Top of the page</a>
|
||||
</p>
|
||||
|
||||
|
|
|
|||
3
S/robots.txt
Normal file
3
S/robots.txt
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
User-agent: *
|
||||
Disallow:
|
||||
|
||||
67
S/style.css
67
S/style.css
|
|
@ -1,31 +1,56 @@
|
|||
|
||||
/* $Id: style.css,v 1.8 2016/01/21 00:58:22 gilles Exp gilles $ */
|
||||
/* $Id: style.css,v 1.12 2016/12/20 10:00:46 gilles Exp gilles $ */
|
||||
|
||||
/* http://www.w3schools.com/html/html5_browsers.asp */
|
||||
|
||||
/*
|
||||
header, section, footer, aside, nav, main, article, figure {
|
||||
display: block;
|
||||
display: inline-block;
|
||||
}
|
||||
*/
|
||||
|
||||
body {
|
||||
color: black;
|
||||
background-color: #eeffff
|
||||
background-color: #eeffff;
|
||||
}
|
||||
|
||||
@media screen and ( min-width: 960px ) {
|
||||
#left-menu {
|
||||
float: left;
|
||||
width: 50%;
|
||||
}
|
||||
|
||||
#centered-logo {
|
||||
float: left;
|
||||
width: 50%;
|
||||
}
|
||||
|
||||
#right-tronche {
|
||||
float: right;
|
||||
width: 60%;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
@media screen and ( min-width: 1280px ) {
|
||||
#left-menu {
|
||||
float: left;
|
||||
width: 40%;
|
||||
}
|
||||
|
||||
#centered-logo {
|
||||
float: left;
|
||||
width: 60%;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#left-menu {
|
||||
float: left;
|
||||
width: 35%;
|
||||
}
|
||||
|
||||
|
||||
#centered-logo {
|
||||
float: left;
|
||||
width: 65%;
|
||||
}
|
||||
|
||||
@media screen and ( min-width: 960px ) {
|
||||
div.list {
|
||||
display: inline-block;
|
||||
vertical-align: top;
|
||||
display: inline-block;
|
||||
vertical-align: top;
|
||||
}
|
||||
}
|
||||
|
||||
div.poll {
|
||||
|
|
@ -34,15 +59,6 @@ div.poll {
|
|||
}
|
||||
|
||||
|
||||
#full-page {
|
||||
float: left;
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
#right-tronche {
|
||||
float: right;
|
||||
width: 60%;
|
||||
}
|
||||
|
||||
div.center {
|
||||
text-align: center;
|
||||
|
|
@ -54,7 +70,8 @@ img {
|
|||
|
||||
.none
|
||||
{
|
||||
list-style-type: none;
|
||||
/* list-style-type: none;
|
||||
*/
|
||||
}
|
||||
|
||||
.bold
|
||||
|
|
|
|||
|
|
@ -10,6 +10,13 @@
|
|||
|
||||
<link rel="icon" type="image/png" href="../S/images/logo_imapsync_s.png" >
|
||||
<link href="../S/style.css" rel="stylesheet" type="text/css">
|
||||
|
||||
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1" />
|
||||
<!--
|
||||
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" />
|
||||
-->
|
||||
|
||||
|
||||
<!--
|
||||
The link to the HTML5Shiv must be placed in the <head> element, after any stylesheets
|
||||
|
|
@ -67,7 +74,7 @@ alt="Viewable With Any Browser" >
|
|||
<!--#config timefmt="%D" -->
|
||||
<!--#config timefmt="%A %B %d, %Y" -->
|
||||
<b>This document was last modified on <!--#echo var="LAST_MODIFIED" --></b>
|
||||
($Id: template_html5.shtml,v 1.1 2016/08/05 14:27:39 gilles Exp gilles $)<br>
|
||||
($Id: template_html5.shtml,v 1.12 2017/09/11 03:04:46 gilles Exp gilles $)<br>
|
||||
<a href="#TOP">Top of the page</a>
|
||||
</p>
|
||||
</footer>
|
||||
|
|
|
|||
|
|
@ -19,6 +19,11 @@
|
|||
<link href="../S/style.css" rel="stylesheet" type="text/css"/>
|
||||
|
||||
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1" />
|
||||
<!--
|
||||
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" />
|
||||
-->
|
||||
|
||||
</head>
|
||||
|
||||
<body>
|
||||
|
|
@ -59,7 +64,7 @@ alt="Viewable With Any Browser" />
|
|||
<!--#config timefmt="%D" -->
|
||||
<!--#config timefmt="%A %B %d, %Y" -->
|
||||
<b>This document last modified on <!--#echo var="LAST_MODIFIED" --></b>
|
||||
($Id: template_xhtml1.shtml,v 1.5 2016/08/03 18:18:40 gilles Exp gilles $)<br/>
|
||||
($Id: template_xhtml1.shtml,v 1.16 2017/09/11 03:04:46 gilles Exp gilles $)<br/>
|
||||
<a href="#TOP">Top of the page</a>
|
||||
</p>
|
||||
|
||||
|
|
|
|||
0
S/tw-hash.html
Executable file → Normal file
0
S/tw-hash.html
Executable file → Normal file
0
S/tw-mention.html
Executable file → Normal file
0
S/tw-mention.html
Executable file → Normal file
Loading…
Add table
Add a link
Reference in a new issue