Mirrors/imapsync
1
0
Fork 0
mirror of https://github.com/imapsync/imapsync.git synced 2024-11-16 15:52:47 +01:00
Code Issues Releases Activity

1.920

Browse Source
This commit is contained in:
Nick Bebout 2019-07-02 18:20:46 -05:00
parent 62531f58cd
commit 852d9695d6
76 changed files with 55631 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
FAQ Symbolic link
View File

@ -0,0 +1 @@
FAQ.d/FAQ.General.txt

81
FAQ.d/FAQ.APPEND_errors.txt Normal file
View File

@ -0,0 +1,81 @@
#!/bin/cat
$Id: FAQ.APPEND_errors.txt,v 1.6 2019/02/16 22:38:49 gilles Exp gilles $
This document is also available online at
https://imapsync.lamiral.info/FAQ.d/
https://imapsync.lamiral.info/FAQ.d/FAQ.APPEND_errors.txt
=======================================================================
Dealing with Imapsync APPEND errors.
=======================================================================
Questions answered in this FAQ are:
Q. For some messages, the imapsync log says
"could not append", sometimes followed by an explicit message
describing what went wrong, or sometimes followed by a not very
useful message "socket closed while reading data from server"
What can I do?
R0. Well, the problem is that the "socket closed ..." error message happens
in several different issues. So I list here several potential issues
and their solutions if they exist.
R1. On Windows, add --regexmess "s,(.{9900}),$1\r\n,g"
Some messages have too long lines; for example,
Exchange supports only 9900 characters line length.
Use this option to add "new line" characters (also called CRLF)
to wrap lines longer than 9900 characters.
The regex means "add one CRLF every 9900".
imapsync.exe ... --regexmess "s,(.{9900}),$1\r\n,g"
R2. On Unix, add --pipemess "reformime -r7". The command reformime
usually belongs to the package called "maildrop".
imapsync ... --pipemess "reformime -r7"
I reproduce here the "reformime" manual part explaining what does
the option "-r7"
$ man reformime |more
REFORMIME(1) Double Precision, Inc. REFORMIME(1)
NAME
reformime - MIME E-mail reformatting tool
SYNOPSIS
reformime [options...]
DESCRIPTION
reformime is a utility for reformatting MIME messages.
Generally, reformime expects to see an RFC 2045[1] compliant message on
standard input
...
OPTIONS
...
-r
Rewrite message, adding or standardizing RFC 2045[1] MIME headers.
-r7
Like -r but also convert 8bit-encoded MIME sections to
quoted-printable.
...
Adding RFC 2045 MIME headers
The -r option performs the following actions:
If there is no Mime-Version:, Content-Type:, or
Content-Transfer-Encoding: header, reformime adds one.
If the Content-Transfer-Encoding: header contains 8bit or raw, but only
seven-bit data is found, reformime changes the
Content-Transfer-Encoding header to 7bit.
-r7 does the same thing, but also converts 8bit-encoded content that
contains eight-bit characters to quoted-printable encoding.
R2.

33
FAQ.d/FAQ.Big_Mailbox.txt Normal file
View File

@ -0,0 +1,33 @@
#!/bin/cat
$Id: FAQ.Big_Mailbox.txt,v 1.2 2018/07/25 10:37:30 gilles Exp gilles $
This document is also available online at
https://imapsync.lamiral.info/FAQ.d/
https://imapsync.lamiral.info/FAQ.d/FAQ.Big_Mailbox.txt
=====================================================================
Imapsync tips to deal with huge mailboxes
=====================================================================
Questions answered in this FAQ are:
Q. How to deal with huge mailboxes, whose size is over dozens of GB?
Now the questions again with their answers.
=====================================================================
Q. How to deal with huge mailboxes, whose size is over dozens of GB?
R. It should be ok with imapsync. In case imapsync seems to stall
when sizing the folders or before syncing a huge folder and
you wander if it is doing something or just frozen, you can
add option --debugimap. Option --debugimap will show what is
currently done, it's quite a big output but it helps waiting,
saying to ourself
"ok it's long but it's working, let's wait a little more".
The real purpose of --debugimap is to show genuine IMAP
commands used and their responses.

286
FAQ.d/FAQ.Various_Software_Servers.txt Normal file
View File

@ -0,0 +1,286 @@
#!/bin/cat
$Id: FAQ.Various_Software_Servers.txt,v 1.10 2018/10/24 11:03:57 gilles Exp gilles $
This document is also available online at
https://imapsync.lamiral.info/FAQ.d/
https://imapsync.lamiral.info/FAQ.d/FAQ.Various_Server_Softwares.txt
=======================================================================
Imapsync tips for various imap server softwares.
=======================================================================
=======================================================================
Q. From Zimbra to XXX
imapsync ... \
--exclude "Conversation Action Settings" \
--exclude "Quick Step Settings" \
--exclude "News Feed"
=======================================================================
Q. From or to HMailServer version 4.4.1.
R. You have to add prefix and separator manually because 4.4.1 doesn't
honor the NAMESPACE imap command.
Example for host1:
imapsync ... \
--prefix1 "" --sep1 .
No specific option for HMailServer 5.3.3 since NAMESPACE is supported.
Maybe --subscribe_all will help you to see all migrated folders.
=======================================================================
Q. Synchronizing from Kerio Connect to XXX
R. No special options required.
See also:
http://www.linux-france.org/prj/imapsync_list/msg01756.html
http://www.safetynet-it.com/it-support/mac-kerio-server-to-microsoft-exchange-2010-migration-1/
http://www.safetynet-it.com/it-support/mac-kerio-server-to-microsoft-exchange-2010-migration-2/
=======================================================================
Q. from Microsoft's Exchange 2007 to Google Apps for your Domain
(GAFYD)
R. Take a look at:
http://mark.ossdl.de/2009/02/migrating-from-exchange-2007-to-google-apps-mail/
=======================================================================
Q. Migrating from or to Parallels Plex Server
R. It depends on the OS
Parallells Plesk Panel for Windows requires --sep2 / --prefix2 ""
Parallells Plesk Panel for Linux works with default parameters.
=======================================================================
Q. I'm migrating from WU to Cyrus, and the mail folders are under
/home/user/mail but the tool copies everything in /home/user, how
can i avoid that?
Two solutions:
R. Use
imapsync ... --include '^mail'
R. or (better)
imapsync ... --subscribed --subscribe
=======================================================================
Q. I'm migrating from WU to Cyrus, and the mail folders are under
/home/user/mail directory. When imapsync creates the folders in
the new cyrus imap server, it makes a folder "mail" and below that
folder puts all the mail folders the user have in /home/user/mail,
i would like to have all those folders directly under INBOX.
R. Use
imapsync ... --regextrans2 's/^mail/INBOX/' --dry
look at the simulation and if all transformations seem
good then remove the --dry option.
=======================================================================
Q. Migrating from Groupwise to Cyrus
R. By Jamie Neil:
I eventually managed to get the mail to migrate without errors using the
following options:
--sep1 /
- doesn't report separator so has to be set explicitly.
--nosyncacls
- doesn't support ACLs.
--skipheader '^Content-Type'
- MIME separator IDs seem to change every time a mail is accessed so
this is required to stop duplicates.
--maxage 3650
- some messages just don't seem to want to transfer and produce the
perl errors I mentioned before. This prevents the errors, but the
bad messages don't transfer.
Even though the mail migrated OK, there are a couple of gotchas with
Groupwise IMAP:
1) Some of the GW folders are not real folders and are not available
to IMAP, the main problem one being "Sent Items". I could find no way
of coping the contents of these folders. The nearest I got was to
create a "real" folder and copy/move the sent items into it, but
imapsync still didn't see the messages (I think because there is
something funny about the reported dates/sizes).
It think this problem has been rectified in GW6.5.
2) The "skipheader '^Content-Type'" directive is required to stop
duplicate messages being created. GW seems to generate this field on
the fly for messages that have MIME separators and so it's different
every time.
3) Version 6.0.1 of the Groupwise Internet Connector sucks. I was
getting server aborts when I pushed it a bit hard! I eventually had to
upgrade to 6.0.4 which seems to be a lot more stable.
=======================================================================
Q. Migrating from iPlanet Messaging Server
5.2 Patch 2 (built Jul 14 2004)) to Groupwise 7.0
I encounter many errors like this:
"Error trying to append string: 17847 BAD APPEND"
R. GroupWise 7 seems buggy. Apply GroupWise 7 support pack 1
=======================================================================
Q. Migrating from David Tobit V10 (DvISE Mail Access Server MA-...)
R. Use the following options:
imapsync ... --prefix1 "" --sep1 / --idatefromheader ^
--nofoldersizes --useuid --nocheckmessageexists
=======================================================================
Q. Migrating from David Tobit V8
("* OK IMAP4rev1 DvISE Mail Access Server MA-8.10a (0126)")
First try above V10 solution since improvments have been made
to support Tobit.
R. Use the following options :
imapsync ... --prefix1 INBOX. --sep1 / --subscribe --subscribed
=======================================================================
Q. Migrating from Tobit David Server 6
("DvISE Mail Access Server MA-6.60a (0118)")
First try above V10 solution since improvments have been made
to support Tobit.
R. Look at the discussion:
http://www.linux-france.org/prj/imapsync_list/msg00582.html
http://www.linux-france.org/prj/imapsync_list/threads.html#00582
patch saved in ./patches/imapsync-1.337_tobit_V6.patch
=======================================================================
Q. I need to migrate 1250 mailboxes, passwords are in a MySQL Database.
Can you tell me if your script suits my needs?
R. Mailboxes must exist before running imapsync.
You have to extract users logins and passwords in a csv file.
See the "HUGE MIGRATION" section in the README file.
======================================================================
Q: From MailEnable 1.75
R: --sep1 "/" --prefix1 ""
Q: From MailEnable 2.2
R: --sep1 "." --prefix1 ""
Q: To MailEnable
R: --sep2 / --prefix2 "" --addheader --messageidnodomain --syncflagsaftercopy
======================================================================
Q. From GMX IMAP4 StreamProxy
R. Use:
--prefix1 INBOX and --sep1 .
======================================================================
Q. From Courier to Archiveopteryx
R. You can read http://www.archiveopteryx.org/migration/imapsync
Default values might be fine now with latest imapsync.
======================================================================
Q. To Sun Java(tm) System Messaging Server 6.2-7.05
Q. To Communigate Pro - Solaris version
R. See and run patches/imapsync_1.267_jari
======================================================================
Q. From Softalk Workgroup Mail 7.6.4
R. Old Softalk releases don't support the IMAP SEARCH command.
Here are the options to get it working.
imapsync ... --sep1 '.' --prefix1 '' \
--noabletosearch1 --nocheckmessageexists --addheader
(Thanks to Andrew Tucker)
======================================================================
Q. From or to QQMail IMAP4Server
R. imapsync ... --noabletosearch1
======================================================================
Q. From FirstClass to XXX
http://www.firstclass.com/
R. Migrating from FirstClass is not easy because FirstClass, strangely,
does not show all messages via IMAP. To make it show all messages,
a trick, painful to follow by hand, is moving emails
out and back in, for each folder. May be it can be done by a script.
FirstClass releases prior to release 12 do not shows the "Sent"
folder in IMAP but FirstClass release 12 shows it.
I advice you to upgrade to FirstClass release 12 before leaving it
with imapsync or another imap tool.
Here is a command line used to migrate from FirtClass release 12:
imapsync ... \
--tmpdir /var/tmp --usecache \
--useheader Message-ID \
--idatefromheader \
--addheader \
--regextrans2 "s,(/|^) +,\$1,g" --regextrans2 "s, +(/|$),\$1,g" \
--regextrans2 "s/[\^]/_/g" \
--regextrans2 "s/['\"\\\\]/_/g" \
--regextrans2 "s,&AC8-,-,g" \
--regextrans2 "s,&APg-,oe,g"
On Windows:
imapsync.exe ... ^
--automap ^
--usecache ^
--useheader Message-ID ^
--idatefromheader ^
--addheader ^
--regextrans2 "s,(/|^) +,$1,g" ^
--regextrans2 "s, +(/|$),$1,g" ^
--regextrans2 "s/[\^]/_/g" ^
--regextrans2 "s/['\\]/_/g" ^
--regextrans2 "s,^&AC8-,-,g" ^
--regextrans2 "s,^&APg-,oe,g"
Special thanks to Kristian Wind and Joey Alexander for helping me
writing this FAQ item.
See also this worth reading discussion in a Zimbra forum:
http://www.zimbra.com/forums/migration/20349-help-needed-migrating-firstclass.html
======================================================================
Q. From XXX to FTGate
R. Do NOT use --usecache since new UIDs are not given by FTGate and also
badly guessed by imapsync. UIDEXPUNGE does not work so use also
--expunge2 when using --delete2
imapsync ... \
--sep2 / --prefix2 "" \
--useheader Message-Id \
=======================================================================
=======================================================================

32
FAQ.d/FAQ.Zimbra.txt Normal file
View File

@ -0,0 +1,32 @@
#!/bin/cat
$Id: FAQ.Zimbra.txt,v 1.4 2019/01/28 22:39:28 gilles Exp gilles $
This documentation is also available online at
https://imapsync.lamiral.info/FAQ.d/
https://imapsync.lamiral.info/FAQ.d/FAQ.Zimbra.txt
=======================================================================
Imapsync tips for Zimbra. Specific issues and solutions.
=======================================================================
Please, don't follow
https://wiki.zimbra.com/wiki/Guide_to_imapsync
It's obsolete and it will give you, and me, more difficulties than
doing a standard sync without additional options.
=======================================================================
Q. How to migrate from Zimbra with an admin account?
R. Use:
imapsync ... --user1 "normal_user" --authuser1 "admin_user" --password1 "admin_user_password"
To setup or use a Zimbra admin user see:
https://zimbra.github.io/adminguide/8.8.9/index.html#_administrator_accounts
Thanks to Richard Street from thinkround for this tip.
=======================================================================
=======================================================================

4
INSTALL.d/.dockerignore Normal file
View File

@ -0,0 +1,4 @@
#
memo
RCS

70
INSTALL.d/Dockerfile Normal file
View File

@ -0,0 +1,70 @@
## Dockerfile for building a docker imapsync image
# $Id: Dockerfile,v 1.14 2018/09/16 10:42:11 gilles Exp gilles $
# I use the following command to build the image:
#
# docker build -t gilleslamiral/imapsync .
#
# where this Dockerfile is in the current directory
#
# I like thanks
# I like stars
# I also like (and need) money
# I thank you very much in advance
FROM debian:stretch
LABEL maintainer "gilles@lamiral.info"
# Put a copy of the Dockerfile in the image itself
# It can help future maintenance, isn't it?
COPY Dockerfile /
RUN apt-get update \
&& apt-get install -y \
libjson-webtoken-perl \
libauthen-ntlm-perl \
libcgi-pm-perl \
libcrypt-openssl-rsa-perl \
libdata-uniqid-perl \
libfile-copy-recursive-perl \
libio-socket-ssl-perl \
libio-socket-inet6-perl \
libio-tee-perl \
libhtml-parser-perl \
libjson-webtoken-perl \
libmail-imapclient-perl \
libparse-recdescent-perl \
libmodule-scandeps-perl \
libpar-packer-perl \
libreadonly-perl \
libregexp-common-perl \
libsys-meminfo-perl \
libterm-readkey-perl \
libtest-mockobject-perl \
libtest-pod-perl \
libunicode-string-perl \
liburi-perl \
libwww-perl \
procps \
wget \
make \
cpanminus \
&& rm -rf /var/lib/apt/lists/*
RUN wget -N https://imapsync.lamiral.info/imapsync \
https://imapsync.lamiral.info/prerequisites_imapsync \
&& cp imapsync /usr/bin/imapsync \
&& chmod +x /usr/bin/imapsync # just_a_comment_to_force_update 2018_09_13_14_44_03
USER nobody
ENV HOME /var/tmp/
CMD ["/usr/bin/imapsync"]
#
# End of imapsync Dockerfile

92
INSTALL.d/INSTALL.ArchLinux.txt Normal file
View File

@ -0,0 +1,92 @@
#!/bin/cat
# $Id: INSTALL.ArchLinux.txt,v 1.3 2018/09/03 02:00:22 gilles Exp gilles $
This documentation is also located online at
https://imapsync.lamiral.info/INSTALL.d/
https://imapsync.lamiral.info/INSTALL.d/INSTALL.ArchLinux.txt
==========================================
=== Installing imapsync on ArchLinux ===
==========================================
Thanks to Aldo Villagra!
---------------------------------
With yaourt and AUR repositories
---------------------------------
pacman -S --needed base-devel git
git clone https://aur.archlinux.org/package-query.git
cd package-query
makepkg -si
cd ..
git clone https://aur.archlinux.org/yaourt.git
cd yaourt
makepkg -si
cd ..
After you have installed Yaourt, you can install imapsync:
yaourt -S --needed imapsync
That's all folks!
-----------------------------------------------
With the "pacman" and the standard repositories
community/
extra/
-----------------------------------------------
Commands to run:
pacman -S --needed make lsb-release cpanminus wget
pacman -S --needed community/perl-cgi \
extra/perl-crypt-openssl-rsa \
extra/perl-data-uniqid \
extra/perl-digest-hmac \
community/perl-dist-checkconflicts \
extra/perl-file-copy-recursive \
extra/perl-io-socket-inet6 \
extra/perl-io-socket-ssl \
community/perl-io-tee \
community/perl-json \
extra/perl-html-parser \
extra/perl-libwww \
community/perl-module-implementation \
community/perl-module-runtime \
community/perl-module-scandeps \
extra/perl-net-ssleay \
community/perl-package-stash \
community/perl-package-stash-xs \
community/perl-parse-recdescent \
community/perl-readonly \
community/perl-regexp-common \
extra/perl-term-readkey \
community/perl-test-fatal \
community/perl-test-mockobject \
extra/perl-test-pod \
community/perl-test-requires \
community/perl-test-nowarnings \
community/perl-test-deep \
extra/perl-try-tiny \
extra/perl-uri
Mandatory Perl modules via cpanm:
cpanm Mail::IMAPClient \
Unicode::String \
Sys::MemInfo \
Other Perl modules, needed sometimes:
cpanm Authen::NTLM \
JSON::WebToken \
JSON::WebToken::Crypt::RSA \
Test::Mock::Guard \
Test::Warn \
PAR::Packer

66
INSTALL.d/memo_docker Normal file
View File

@ -0,0 +1,66 @@
#!/bin/sh
echo imapsync_docker_timestamp_dockerfile
imapsync_docker_timestamp_dockerfile() {
DATE_CURRENT=`date +%Y_%m_%d_%H_%M_%S`
echo $DATE_CURRENT
sed -i -e "/just_a_comment_to_force_update/s/comment_to_force_update.*/comment_to_force_update $DATE_CURRENT/" Dockerfile
ci -l -f -m"Changing timestamp to $DATE_CURRENT with imapsync_docker_timestamp_dockerfile" Dockerfile
}
echo imapsync_docker_build
imapsync_docker_build() {
docker build -t gilleslamiral/imapsync .
docker images
echo
#docker run gilleslamiral/imapsync imapsync --testslive
#docker run gilleslamiral/imapsync imapsync --testslive6
# docker run gilleslamiral/imapsync imapsync --testslive6 --nossl2
}
echo imapsync_docker_testslive
imapsync_docker_testslive() {
docker run gilleslamiral/imapsync imapsync --testslive
}
echo imapsync_docker_testslive6
imapsync_docker_testslive6() {
docker run gilleslamiral/imapsync imapsync --testslive6 --ssl1 --ssl2
}
echo imapsync_docker_tests
imapsync_docker_tests() {
docker run gilleslamiral/imapsync imapsync --tests
}
echo docker_delete_all_images
docker_delete_all_images() {
docker rm `docker ps -a -q`
docker rmi `docker images -q`
}
echo docker_delete_dandling_images
docker_delete_dandling_images() {
docker images
dandling_images=`docker images -f dangling=true -q`
exited_containers=`docker ps -a -f status=exited -q`
test -n "$exited_containers" && docker rm $exited_containers
test -n "$dandling_images" && docker rmi $dandling_images
docker images
}
echo imapsync_docker_rebuild_from_scratch
imapsync_docker_rebuild_from_scratch() {
delete_all_images
docker images
imapsync_docker_build
}
echo imapsync_docker_upload
imapsync_docker_upload() {
docker login --username=gilleslamiral --password=`cat $HOME/var/pass/secret.docker` \
&& docker push gilleslamiral/imapsync
}

BIN
S/images/Imapsync_donation_QR_code.png Executable file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.2 KiB

BIN
S/images/btn_donateCC_LG.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.9 KiB

BIN
S/images/pixel.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 43 B

2327
W/Mail-IMAPClient-3.40/Changes Normal file
View File

File diff suppressed because it is too large Load Diff

42
W/Mail-IMAPClient-3.40/MANIFEST Normal file
View File

@ -0,0 +1,42 @@
Changes
MANIFEST
Makefile.PL
README
examples/build_dist.pl
examples/build_ldif.pl
examples/cleanTest.pl
examples/copy_folder.pl
examples/cyrus_expire.pl
examples/cyrus_expunge.pl
examples/find_dup_msgs.pl
examples/idle.pl
examples/imap_to_mbox.pl
examples/imtestExample.pl
examples/migrate_mail2.pl
examples/migrate_mbox.pl
examples/populate_mailbox.pl
examples/sharedFolder.pl
lib/Mail/IMAPClient.pm
lib/Mail/IMAPClient.pod
lib/Mail/IMAPClient/BodyStructure.pm
lib/Mail/IMAPClient/BodyStructure/Parse.grammar
lib/Mail/IMAPClient/BodyStructure/Parse.pm
lib/Mail/IMAPClient/BodyStructure/Parse.pod
lib/Mail/IMAPClient/MessageSet.pm
lib/Mail/IMAPClient/Thread.grammar
lib/Mail/IMAPClient/Thread.pm
lib/Mail/IMAPClient/Thread.pod
prepare_dist
t/basic.t
t/body_string.t
t/bodystructure.t
t/fetch_hash.t
t/lib/MyTest.pm
t/messageset.t
t/pod.t
t/quota.t
t/simple.t
t/thread.t
test_template.txt
META.yml Module meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)

57
W/Mail-IMAPClient-3.40/META.json Normal file
View File

@ -0,0 +1,57 @@
{
"abstract" : "IMAP4 client library",
"author" : [
"Phil Pearl (Lobbes) <plobbes+mail-imapclient@gmail.com>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Mail-IMAPClient",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Carp" : "0",
"Errno" : "0",
"Fcntl" : "0",
"File::Temp" : "0",
"IO::File" : "0",
"IO::Select" : "0",
"IO::Socket" : "0",
"IO::Socket::INET" : "1.26",
"List::Util" : "0",
"MIME::Base64" : "0",
"Parse::RecDescent" : "1.94",
"Test::More" : "0",
"perl" : "5.008"
}
}
},
"release_status" : "stable",
"resources" : {
"homepage" : "http://sourceforge.net/projects/mail-imapclient/"
},
"version" : "3.40",
"x_serialization_backend" : "JSON::PP version 2.97001"
}

37
W/Mail-IMAPClient-3.40/META.yml Normal file
View File

@ -0,0 +1,37 @@
---
abstract: 'IMAP4 client library'
author:
- 'Phil Pearl (Lobbes) <plobbes+mail-imapclient@gmail.com>'
build_requires:
ExtUtils::MakeMaker: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Mail-IMAPClient
no_index:
directory:
- t
- inc
requires:
Carp: '0'
Errno: '0'
Fcntl: '0'
File::Temp: '0'
IO::File: '0'
IO::Select: '0'
IO::Socket: '0'
IO::Socket::INET: '1.26'
List::Util: '0'
MIME::Base64: '0'
Parse::RecDescent: '1.94'
Test::More: '0'
perl: '5.008'
resources:
homepage: http://sourceforge.net/projects/mail-imapclient/
version: '3.40'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

139
W/Mail-IMAPClient-3.40/Makefile.PL Normal file
View File

@ -0,0 +1,139 @@
use ExtUtils::MakeMaker;
use warnings;
use strict;
use 5.008_001;
my @missing;
my %optional = (
"Authen::NTLM" => { for => "Authmechanism 'NTLM'" },
"Authen::SASL" => { for => "Authmechanism 'DIGEST-MD5'" },
"Compress::Zlib" => { for => "COMPRESS DEFLATE support" },
"Digest::HMAC_MD5" => { for => "Authmechanism 'CRAM-MD5'" },
"Digest::MD5" => { for => "Authmechanism 'DIGEST-MD5'" },
"IO::Socket::IP" => { for => "IPv6 support" },
"IO::Socket::SSL" => { for => "SSL enabled connections (Ssl => 1)" },
"Test::Pod" => { for => "Pod tests", ver => "1.00" },
);
foreach my $mod ( sort keys %optional ) {
my $for = $optional{$mod}->{"for"} || "";
my $ver = $optional{$mod}->{"ver"} || "";
eval "use $mod $ver ();";
push @missing, $mod . ( $for ? " for $for" : "" ) if $@;
}
# similar message to one used in DBI:
if (@missing) {
print( "The following optional modules were not found:",
map( "\n\t" . $_, @missing ), "\n" );
print <<'MSG';
Optional modules are available from any CPAN mirror, reference:
http://search.cpan.org/
http://www.perl.com/CPAN/modules/by-module
http://www.perl.org/CPAN/modules/by-module
MSG
sleep 3;
}
# HACK: die on broken Parse::RecDescent 1.966002 through 1.967009
# - rt.cpan.org#74593: Recent changes break Module::ExtractUse and ...
# - rt.cpan.org#74733: Fails with Parse::RecDescent >= 1.966_002
do {
eval { require version; require Parse::RecDescent; };
unless ($@) {
my $found = version->parse( Parse::RecDescent->VERSION() );
my $broke = version->parse("1.966002");
my $fixed = version->parse("1.967009");
if ( $found < $fixed and $found >= $broke ) {
die(
"Found broken Parse::RecDescent $found in your environment.\n",
"Please upgrade to version $fixed or greater.\n"
);
}
}
};
WriteMakefile(
NAME => 'Mail::IMAPClient',
AUTHOR => 'Phil Pearl (Lobbes) <plobbes+mail-imapclient@gmail.com>',
ABSTRACT => 'IMAP4 client library',
VERSION_FROM => 'lib/Mail/IMAPClient.pm',
LICENSE => 'perl',
META_MERGE => {
resources => {
bugtracker => {
web =>
'http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient',
mailto => 'bug-Mail-IMAPClient@rt.cpan.org',
},
homepage => 'http://sourceforge.net/projects/mail-imapclient/',
repository => {
url => 'git://git.code.sf.net/p/mail-imapclient/git',
web => 'http://sourceforge.net/p/mail-imapclient/git/',
type => 'git',
},
},
},
MIN_PERL_VERSION => '5.008',
PREREQ_PM => {
'Carp' => 0,
'Errno' => 0,
'Fcntl' => 0,
'IO::File' => 0,
'IO::Select' => 0,
'IO::Socket' => 0,
'IO::Socket::INET' => 1.26,
'List::Util' => 0,
'MIME::Base64' => 0,
'Parse::RecDescent' => 1.94,
'Test::More' => 0,
'File::Temp' => 0,
},
clean => { FILES => 'test.txt' },
);
set_test_data();
exit 0;
###
### HELPERS
###
sub set_test_data {
unless ( -f "lib/Mail/IMAPClient.pm" ) {
warn("ERROR: not in installation directory\n");
return;
}
if ( -s "./test.txt" ) {
print("The file test.txt will be used for extended tests.\n");
return;
}
print <<EOF;
(OPTIONAL) For extended tests during 'make test', create a file
'test.txt' in the top level directory of this distribution (the same
directory as the Makefile.PL, etc.). This file must contain an IMAP
server name or IP (server=...), a user account (user=...), and a
password (passed=...). A port (port=....) and an authentication
mechanism to be used (authmechanism=...) can also be specified.
Example:
--- BEGIN: test.txt ---
server=localhost
user=mytestuser
passed=mypassword
port=143
--- END: test.txt ---
NOTE: When testing is completed, be sure to remove test.txt (either by
hand or by 'make clean').
EOF
}

97
W/Mail-IMAPClient-3.40/README Normal file
View File

@ -0,0 +1,97 @@
Mail::IMAPClient
================
Mail::IMAPClient is a Perl module that provides an interface for
communicating with an IMAP server as an IMAP client.
DEPENDENCIES
============
The following are the minimum requirements for using Mail::IMAPClient:
- Perl 5.8
http://www.perl.org/
- Perl modules from CPAN:
http://search.cpan.org/
Required:
List::Util
MIME::Base64
Parse::RecDescent
Optional:
Authen::NTLM
Authen::SASL
Compress::Zlib
Digest::HMAC_MD5
Digest::MD5
IO::Socket::SSL
- RFC 3501 (IMAP4REV1) compatible IMAP server
http://www.faqs.org/rfcs/rfc3501.html
- Mail::IMAPClient (this package)
INSTALLATION
============
1. Download Mail::IMAPClient module
http://search.cpan.org/dist/Mail-IMAPClient/
2. Read this README
3. This module has a number of dependencies on other Perl modules
available from CPAN. If any modules are missing, appropriate
warnings will be generated in the following step.
4. Prepare to build this module and install any prerequisite modules:
perl Makefile.PL
5. (OPTIONAL) For extended tests during 'make test', create a file
'test.txt' in the top level directory of this distribution (the
same directory as the Makefile.PL, etc.). This file must contain
an IMAP server name or IP (server=...), a user account (user=...),
and password a (passed=...). A port (port=....) and an
authentication mechanism to be used (authmechanism=...) can also be
specified.
Example:
--- BEGIN: test.txt ---
server=localhost
user=mytestuser
passed=mypassword
port=143
--- END: test.txt ---
NOTE: When testing is completed, be sure to remove test.txt (either
by hand or by 'make clean').
6. Build, test and install this module:
make
make test
(sudo) make install
7. Read the documentation to become familiar with this module.
Project Links
=============
- Bugs/tickets:
http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient
- Source code repository (git):
http://sourceforge.net/p/mail-imapclient/git/
- CPAN releases:
http://search.cpan.org/dist/Mail-IMAPClient/
- Project website
http://sourceforge.net/projects/mail-imapclient/
COPYRIGHT AND LICENSE
=====================
Copyright (C) 1999-2003 The Kernen Group, Inc.
Copyright (C) 2007-2009 Mark Overmeer
Copyright (C) 2010-2017 Phil Pearl (Lobbes)
All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.0 or,
at your option, any later version of Perl 5 you may have available.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the
GNU General Public License or the Artistic License for more details.

172
W/Mail-IMAPClient-3.40/examples/build_dist.pl Executable file
View File

@ -0,0 +1,172 @@
#!/usr/local/bin/perl
#$Id$
use Mail::IMAPClient;
=head1 DESCRIPTION
B<build_dist.pl> accepts the name of a target folder as an argument. It
then opens that folder and rummages through all the mail files in it, looking
for "Reply-to:" headers (or "From:" headers, where there is no "Reply-to:").
It then appends a message into the folder containing all of the addresses in
thus found as a list of recipients. This message can be used to conveniently
drag and drop names into an address book, distribution list, or e-mail message,
using the GUI client of choice.
The email appended to the folder specified in the I<-f> option will have the
subject "buid_dist.pl I<folder> Output".
=head1 SYNTAX
b<build_dist.pl> I<-h>
b<build_dist.pl> I<-s servername -u username -p password -f folder [ -d ]>
=over 4
=item -f The folder name to process.
=item -s The servername of the IMAP server
=item -u The user to log in as
=item -p The password for the user specified in the I<-u> option
=item -d Tells the IMAP client to turn on debugging info
=item -h Prints out this document
=back
B<NOTE:> You can supply defaults for the above options by updating the script.
=cut
use Getopt::Std;
getopts('s:u:p:f:d');
# Update the following to supply defaults:
$opt_f ||= "default folder";
$opt_s ||= "default server";
$opt_u ||= "default user";
$opt_p ||= "default password"; # security risk: use with caution!
# Let the compiler know we're serious about these two variables:
$opt_h = $opt_h or $opt_d = $opt_d ;
exec "perldoc $0" if $opt_h;
my $imap = Mail::IMAPClient->new(
Server => $opt_s ,
User => $opt_u ,
Password=> $opt_p ,
Debug => $opt_d||0 ,
) or die "can't connect to server\n";
$imap->select($opt_f);
my @msgs = $imap->search("NOT SUBJECT",qq("buid_dist.pl $opt_f Output"));
my %list;
foreach my $m (@msgs) {
my $ref = $imap->parse_headers($m,"Reply-to","From");
warn "Couldn't get recipient address from msg#$m\n"
unless scalar(@{$ref->{'Reply-to'}}) ||
scalar(@{$ref->{'From'}}) ;
my $from = scalar(@{$ref->{'Reply-to'}}) ?
$ref->{'Reply-to'}[0] :
$ref->{'From'}[0] ;
my $addr = $from;
$addr =~ s/.*<//;
$addr =~ s/[\<\>]//g;
$list{$addr} = $from unless exists $list{$addr};
}
$append = <<"EOMSG";
To: ${\(join(",",values %list))}
From: $opt_u\@$opt_s
Date: ${\($imap->Rfc822_date(time))}
Subject: build_dist.pl $opt_f Output
The above note was never actually sent to the following people:
${\(join("\n",keys %list))}
Interesting, eh?
Love,
$opt_u
EOMSG
$imap->append($opt_f,$append) or warn "Couldn't append the message.";
$imap->logout;
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
# $Id$
# $Log: build_dist.pl,v $
# Revision 19991216.7 2003/06/12 21:38:29 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 19991216.6 2000/12/11 21:58:50 dkernen
#
# Modified Files:
# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl
# imap_to_mbox.pl populate_mailbox.pl
# to add CVS data
#
# Revision 19991216.5 1999/12/16 17:19:09 dkernen
# Bring up to same level
#
# Revision 19991124.3 1999/12/16 17:14:22 dkernen
# Incorporate changes for exists method performance enhancement
#
# Revision 19991124.02 1999/11/24 17:46:16 dkernen
# More fixes to t/basic.t
#
# Revision 19991124.01 1999/11/24 16:51:46 dkernen
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
#
# Revision 1.8 1999/11/23 17:51:05 dkernen
# Committing version 1.06 distribution copy
#

235
W/Mail-IMAPClient-3.40/examples/build_ldif.pl Executable file
View File

@ -0,0 +1,235 @@
#!/usr/local/bin/perl
#$Id$
use Mail::IMAPClient;
use MIME::Lite;
use Data::Dumper;
=head1 DESCRIPTION
B<build_ldif.pl> accepts the name of a target folder as an argument. It
then opens that folder and rummages through all the mail files in it, looking
for "Reply-to:" headers (or "From:" headers, where there is no "Reply-to:").
It then prints to STDOUT a file in ldif format containing entries for all of
the addresses that it finds. It also appends a message into the specified folder containing
all of the addresses in both the B<To:> field of the message header and in an
LDIF-format attachment.
B<build_ldif.pl> requires B<MIME::Lite>.
=head1 SYNTAX
B<build_ldif.pl> I<-h>
B<build_ldif.pl> I<-s servername -u username -p password -f folder [ -d ]>
=over 4
=item -f The folder name to process.
=item -s The servername of the IMAP server
=item -t Include "To" and "Cc" fields as well as "From"
=item -u The user to log in as
=item -p The password for the user specified in the I<-u> option
=item -d Tells the IMAP client to turn on debugging info
=item -n Suppress delivering message to folder
=item -h Prints out this document
=back
B<NOTE:> You can supply defaults for the above options by updating the script.
=cut
use Getopt::Std;
getopts('hs:u:p:f:dtn');
# Update the following to supply defaults:
$opt_f ||= "default folder";
$opt_s ||= "default server";
$opt_u ||= "default user";
$opt_p ||= "default password"; # security risk: use with caution!
# Let the compiler know we're serious about these variables:
$opt_0 = ( $opt_h or $opt_d or $opt_t or $opt_n or $opt_0);
exec "perldoc $0" if $opt_h;
my $imap = Mail::IMAPClient->new(
Server => $opt_s ,
User => $opt_u ,
Password=> $opt_p ,
Debug => $opt_d||0 ,
) or die "can't connect to server\n";
$imap->select($opt_f); $imap->expunge;
my @msgs = $imap->search("NOT SUBJECT",qq("buid_ldif.pl $opt_f Output"));
my %list;
foreach my $m (@msgs) {
my $ref = $imap->parse_headers($m,"Reply-to","From");
warn "Couldn't get recipient address from msg#$m\n"
unless scalar(@{$ref->{'Reply-to'}}) ||
scalar(@{$ref->{'From'}}) ;
my $from = scalar(@{$ref->{'Reply-to'}}) ?
$ref->{'Reply-to'}[0] :
$ref->{'From'}[0] ;
my $name = $from ;
$name =~ s/<.*// ;
if ($name =~ /\@/) {
$name = $from ;
$name =~ s/\@.*//; ;
}
$name =~ s/\"//g ;
$name =~ s/^\s+|\s+$//g ;
my $addr = $from ;
$addr =~ s/.*<// ;
$addr =~ s/[\<\>]//g ;
$list{lc($addr)} = [ $addr, $name ]
unless exists $list{lc($addr)} ;
if ($opt_t) { # Do "To" and "Cc", too
my $ref = $imap->parse_headers($m,"To","Cc") ;
my @array = ( @{$ref->{To}} , @{$ref->{Cc}} ) ;
my @members = () ;
foreach my $text (@array) {
while ( $text =~ / "([^"\\]*(\\.[^"\\]*)*"[^,]*),? |
([^",]+),? |
,
/gx
) {
push @members, defined($1)?$1:$3 ;
}
}
foreach my $to (@members) {
my $name = $to ;
$name =~ s/<.*// ;
if ($name =~ /\@/) {
$name = $to ;
$name =~ s/\@.*//; ;
}
$name =~ s/\"//g ;
$name =~ s/^\s+|\s+$//g ;
my $addr = $to ;
$addr =~ s/.*<// ;
$addr =~ s/[\<\>]//g ;
$list{lc($addr)} = [ $addr, $name ]
unless exists $list{lc($addr)} ;
}
}
}
my $text = join "",map {
qq{dn: cn="} . $list{$_}[1] .
qq{", mail=$list{$_}[0]\n} .
qq{cn: } . $list{$_}[1] . qq{\n} .
qq{mail: $list{$_}[0]\n} .
qq{objectclass: top\nobjectclass: person\n\n};
} keys %list ;
# Create a new multipart message:
my $msg = MIME::Lite->new(
From => $opt_u,
map({ ("To" => $list{$_}[0]) } keys %list),
Subject => "LDIF file from $opt_f",
Type =>'TEXT',
Data =>"Attached is the LDIF file of addresses from folder $opt_f."
);
$msg->attach( Type =>'text/ldif',
Filename => "$opt_f.ldif",
Data => $text ,
);
print $text;
$imap->append($opt_f, $msg->as_string) unless $opt_n;
print Dumper($imap) if $opt_d;
$imap->logout;
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 1999,2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
# $Id$
# $Log: build_ldif.pl,v $
# Revision 19991216.11 2003/06/12 21:38:30 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 19991216.10 2002/05/24 15:47:18 dkernen
# Misc fixes
#
# Revision 19991216.9 2000/12/11 21:58:51 dkernen
#
# Modified Files:
# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl
# imap_to_mbox.pl populate_mailbox.pl
# to add CVS data
#
# Revision 19991216.8 2000/03/02 19:57:13 dkernen
#
# Modified Files: build_ldif.pl -- to support new option to all "To:" and "Cc:" to be included in ldif file
#
# Revision 19991216.7 2000/02/21 16:16:10 dkernen
#
# Modified Files: build_ldif.pl -- to allow for "To:" and "Cc:" header handling and
# to handle quoted names in headers
#
# Revision 19991216.6 1999/12/28 13:56:59 dkernen
# Fixed -h option (help).
#
# Revision 19991216.5 1999/12/16 17:19:10 dkernen
# Bring up to same level
#
# Revision 19991124.3 1999/12/16 17:14:24 dkernen
# Incorporate changes for exists method performance enhancement
#
# Revision 19991124.02 1999/11/24 17:46:18 dkernen
# More fixes to t/basic.t
#
# Revision 19991124.01 1999/11/24 16:51:48 dkernen
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
#
# Revision 1.8 1999/11/23 17:51:05 dkernen
# Committing version 1.06 distribution copy
#

64
W/Mail-IMAPClient-3.40/examples/cleanTest.pl Executable file
View File

@ -0,0 +1,64 @@
#!/usr/local/bin/perl
use Mail::IMAPClient;
use IO::File;
#
# Example that will also clean out your test account if interrupted 'make test'
# runs have left junk folders there. Run from installation dir, installation/examples
# subdir, or supply full path to the test.txt file (created during 'perl Makefile.PL'
# and left in the installation dir until 'make clean').
# If you 've already run 'make clean' or said no to extended tests,
# then you don't have the file anyway; re-run 'perl Makefile.PL', reply 'y' to the
# extended tests prompt, then supply the test account's credentials as prompted.
# Then try this again.
#
if ( -f "./test.txt" ) {
$configFile = "./test.txt"
} elsif ( -f "../test.txt" ) {
$configFile = "../test.txt"
} elsif ( $ARGV[0] and -f "$ARGV[0]" ) {
$configFile = $ARGV[0];
} else {
print STDERR "Can't find test.txt. Please run this from the installation directory ",
"or supply the full path to test.txt as an argument on the command line.\n";
}
my $fh = IO::File->new("./test.txt") or die "./test.txt: $!\n";
while (my $input = <$fh>) {
chomp $input;
my($k,$v) = split(/=/,$input,2);
$conf{$k}=$v;
}
my $imap = Mail::IMAPClient->new(Server=>$conf{server},User=>$conf{user},
Password=>$conf{passed}) or die "Connecting to $conf{server}: $! $@\n";
for my $f ( grep(/^IMAPClient_/,$imap->folders) ) {
print "Deleting $f\n";
$imap->select($f);
$imap->delete_messages(@{$imap->messages}) ;
$imap->close($f);
$imap->delete($f);
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut

147
W/Mail-IMAPClient-3.40/examples/copy_folder.pl Executable file
View File

@ -0,0 +1,147 @@
#!/usr/local/bin/perl
#$Id$
++$|;
use Getopt::Std;
use Mail::IMAPClient;
use vars qw/$opt_r $opt_h $opt_t $opt_f/;
getopts("t:f:F:N:rh");
if ( $opt_h ) {
print &usage;
exit;
}
my($to_id,$to_pass,$thost) = $opt_t =~ m{
([^/]+) # everything up to / is the id
/ # then a slash
([^@]+) # then everything up to @ is pswd
@ # then an @-sign
(.*) # then everything else is the host
}x ;
my($from_id,$from_pass,$fhost) =
$opt_f =~ m{
([^/]+) # everything up to / is the id
/ # then a slash
([^@]+) # then everything up to @ is pswd
@ # then an @-sign
(.*) # then everything else is the host
}x ;
$to_id and $from_id and $to_pass and $from_pass and $thost and $fhost
or die "Error: Must specify -t and -f (to and from)\n" . &usage;
$opt_F or
die "Error: Must specify '-F folder' or how will I know what folder to copy?\n" .
&usage ;
$opt_N ||= $opt_F;
print "Copying folder $opt_F from $from_id\@$fhost to ${to_id}'s $opt_N folder on $thost.\n";
my ($from) = Mail::IMAPClient->new( Server => $fhost,
User => $from_id,
Password=> $from_pass,
Fast_IO => 1,
Uid => 1,
Debug => 0,
);
my ($to) = Mail::IMAPClient->new( Server => $thost,
User => $to_id,
Password=> $to_pass,
Fast_IO => 1,
Uid => 1,
Debug => 0,
);
my @folders = $opt_r ? @{$from->folders($opt_F)} : ( $opt_F ) ;
foreach my $fold (@folders) {
print "Processing folder $fold\n";
$from->select($fold);
if ($opt_F ne $opt_N) {
$fold =~s/^$opt_F/$opt_N/o;
}
unless ($to->exists($fold)) {
$to->create($fold) or warn "Couldn't create $fold\n" and next;
}
$to->select($fold);
my @msgs = $from->search("ALL");
# my %flaghash = $from->flags(\@msgs);
foreach $msg (@msgs) {
print "Processing message $msg in folder $fold.\n";
my $string = $from->message_string($msg);
# print "String = $string\n";
my $new_id = $to->append($fold,$string)
or warn "Couldn't append msg #$msg to target folder $fold.\n";
$to->store($new_id,"+FLAGS (" . join(" ",@{$from->flags($msg)}) . ")");
}
}
sub usage {
return "Syntax:\n\t$0 -t to_id/to_pass\@to.host -f from_id/from_pass\@from.host \\\n" .
"\t\t-F folder [-N New_Folder] [-r]\n".
"\tor\n\t$0 -h\n\n".
"\twhere:\n\t\t".
"to_id\t\tis the id to recieve the folder\n\t\t".
"to_pass\t\tis the password for to_id\n\t\t".
"from\t\tis the uid who currently has the folder\n\t\t".
"from_pass\tis the password for from_id\n\t\t".
"to.host\t\tis the optional host where the 'to' uid has a mailbox\n\t\t".
"from.host\tis the optional host where the 'from' uid has a mailbox\n\t\t".
"folder\t\tis the folder to copy from\n\t\t".
"New_Folder\tis the folder to copy to (defaults to 'folder')\n\t\t".
"-h\t\tprints this help message\n\t\t".
"-r\t\tspecifies a recursive copy (only works on systems that support the idea " .
"\n\t\t\t\tof recursive folders)\n\t\t".
"\n"
;
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 1999,2000,2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
# History:
# $Log: copy_folder.pl,v $
# Revision 19991216.3 2003/06/12 21:38:30 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 19991216.2 2000/12/11 21:58:51 dkernen
#
# Modified Files:
# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl
# imap_to_mbox.pl populate_mailbox.pl
# to add CVS data
#

111
W/Mail-IMAPClient-3.40/examples/cyrus_expire.pl Executable file
View File

@ -0,0 +1,111 @@
#!/usr/local/bin/perl
#$Id
use Mail::IMAPClient; # available from http://search.cpan.org/search?mode=module&query=IMAPClient
use IO::File;
use Getopt::Std;
use vars qw/ $opt_d $opt_s $opt_p $opt_u $opt_P $opt_h /;
&getopts('d:s:u:p:P:h'); # -d days_to_keep -u cyrys_user -p cyrus_pswd -s cyrus_server -P port
my $days_to_keep = $opt_d||365; # Delete msgs older than -d arg or 365 days
my $cutoff = time - ( $days_to_keep * 24 * 60 * 60 ) ; # time - arg * 24 * 60 * 60 = cutoff date in seconds
# Change the following line (or replace it with something better):
$opt_h and die help()."\n";
my $h = $opt_s || "localhost" ;
my $u = $opt_u || "cyrys" ;
my $p = $opt_p or die "Unable to continue. No password provided.\n" . help();
my $imap = Mail::IMAPClient->new(
Server => "$h",
User => "$u", # $u,
Password=> "$p", # $p,
Uid => 1, # True value
Port => $opt_P||143, # imapd
Debug => 0, # Make true to debug
Buffer => 4096*10, # True value; decrease on machines w/little memory
Fast_io => 1, # True value
Timeout => 30, # True value
# Debug_fh=> IO::File->new(">out.db"), # fhandle
)
or die "$@";
my $mcnt = my $fcnt = 0;
print "Deleting messages older than ",$imap->Rfc2060_date($cutoff),"\n";
for my $f ( $imap->folders ) {
print "Expiring $f\n";
unless ($imap->select($f) ) {
$imap->setacl($f,$u,"lrswipcda") or warn "Cannot setacl for $f: $@\n" and next;
$imap->select($f) or warn "Cannot select $f: $@" and next;
}
my @expired = $imap->search("SENTBEFORE",$imap->Rfc2060_date($cutoff));
next unless @expired;
$mcnt += scalar(@expired); $fcnt ++;
print "Deleting ",scalar(@expired)," messages from $f\n";
$imap->delete_message(@expired);
$imap->expunge;
$imap->close;
}
$imap->logout;
print "Deleted a total of $mcnt messages in $fcnt folders.\n";
exit;
sub help {
return <<"EOHELP";
Usage:
$0 [ -d days_to_keep ] [ -s mail_server ] [ -u cyrus_admin_id ] -p cyrus_password
$0 -h
-h -- prints this here help message
-d days_to_keep -- $0 will delete messages older than "days_to_keep". (Default is 365)
-s mail_server -- hostname or IP Address of IMAP mail server (defaults to "localhost")
-u cyrus_admin_id -- user name of Unix account that owns Cyrus server (defaults to "cyrus")
-p cyrus_password -- password for the "cyrus_admin_id" user account (no default)
-P cyrus_port -- port where the cyrus imapd daemon is listening (defaults to value from
/etc/services or '143')
EOHELP
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
#$Log: cyrus_expire.pl,v $
#Revision 19991216.2 2003/06/12 21:38:31 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#

85
W/Mail-IMAPClient-3.40/examples/cyrus_expunge.pl Executable file
View File

@ -0,0 +1,85 @@
#!/usr/local/bin/perl
#$Id$
use Mail::IMAPClient;
use IO::File;
# Change the following line (or replace it with something better):
my($h,$u,$p) = ('cyrus_host','cyrus_admin_id','cyrus_admin_pswd');
my $imap = Mail::IMAPClient->new( Server => "$h", # imap host
User => "$u", # $u,
Password=> "$p", # $p,
Uid => 1, # True value
Port => 143, # Cyrus
Debug => 0, # True value
Buffer => 4096*10, # True value
Fast_io => 1, # True value
Timeout => 30, # True value
# Debug_fh=> IO::File->new(">out.db"), # fhandle
)
or die "$@";
for my $f ( $imap->folders ) {
print "Expunging $f\n";
unless ($imap->select($f) ) {
$imap->setacl($f,$u,"lrswipcda") or warn "Cannot setacl for $f: $@\n" and next;
$imap->select($f) or warn "Cannot select $f: $@" and next;
}
$imap->expunge;
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
#
#$Log: cyrus_expunge.pl,v $
#Revision 19991216.3 2003/06/12 21:38:31 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
#Revision 1.1 2003/06/12 21:38:14 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
#

217
W/Mail-IMAPClient-3.40/examples/find_dup_msgs.pl Executable file
View File

@ -0,0 +1,217 @@
#!/usr/local/bin/perl
# $Id$
use Mail::IMAPClient;
use Mozilla::LDAP::Conn;
use Getopt::Std;
use vars qw/$rootdn $opt_a/;
use Data::Dumper;
# It then connects to a user's mailhost and rummages around,
# looking for duplicate messages.
# It will optionally delete messages that are duplicates (based on
# msg-id header and number of bytes).
# For help, enter:
# find_dup_msgs.pl -h
#
getopts('ahdtvf:F:u:s:p:P:');
if ( $opt_h ) {
print STDERR &usage;
exit;
}
my $uid = $opt_u or die &usage;
$opt_s||='localhost';
$opt_p or die &usage;
$opt_P||=143;
$opt_t and
$opt_d and
die "ERROR: Don't specify -d and -t together.\n" . &usage;
my($pu,$pp) = get_admin();
print "Connecting to $host:$opt_P\n" if $opt_v;
my $imap = Imap->new( Server => $opt_s,
User => $opt_u,
Password=> $opt_p,
Port => $opt_P,
Fast_io => 1,
) or die "couldn't connect to $host port $opt_P: $!\n";
my %folders; my %counts;
FOLDER: foreach my $f ( $opt_F ? $opt_F : $imap->folders ) {
next if $opt_t and $f eq 'Trash';
$folders{$f} = 0;
$counts{$f} = $imap->message_count($f);
print "Processing folder $f\n" if $opt_v;
unless ( $imap->select($f)) {
warn "Error selecting $f: " . $imap->LastError . "\n";
next FOLDER;
}
my @msgs = $imap->search("ALL");
my %hash = ();
MESSAGE: foreach my $m (@msgs) {
my $mid;
if ($opt_a) {
my $h = $imap->parse_headers(
$m,"Date","Subject","From","Message-ID"
) or next MESSAGE;
$mid = "$h->{'Date'}[0]$;$h->{'Subject'}[0]$;".
"$h->{'From'}[0]$;$h->{'Message-ID'}[0]";
} else {
$mid = $imap->parse_headers(
$m,
"Message-ID"
)->{'Message-ID'}[0]
or next MESSAGE;
}
my $size = $imap->size($m);
if ( exists $hash{$mid} and $hash{$mid} == $size ) {
if ($opt_f) {
open F,">>$opt_f" or
die "can't open $opt_f: $!\n";
print F $imap->message_string($m),
"___END OF SAVED MESSAGE___","\n";
close F;
}
$imap->move("Trash",$m) if $opt_t;
$imap->delete_message($m) if $opt_d;
$folders{$f}++;
print "Found a duplicate in ${f}; key = $mid\n" if $opt_v;
} else {
$hash{$mid} = $size;
}
}
print "$f hash:\n",Data::Dumper::Dumper(\%hash) if $opt_v;
$imap->expunge if ($opt_t or $opt_d);
}
my $total; my $totms;
map { $total += $_} values %folders;
map { $totms += $_ } values %counts;
print "Found $total duplicate messages in ${uid}'s mailbox. ",
"The breakdown is:\n",
"\tFolder\tNumber of Duplicates\tNumber of Msgs in Folder\n",
"\t------\t--------------------\t------------------------\n",
map { "\t$_\t$folders{$_}\t$counts{$_}\n" } keys %folders,
"\tTOTAL\t$total\t$totms\n"
;
sub usage {
return "Usage:\n" .
"\t$0 [-d|-t] [-v] [-f filename] [-a] [-P port] \\\n".
"\t\t-s server -u user -p password\n\n" .
"\t-a\t\tdo an especially aggressive search for duplicates\n".
"\t-d\t\tdelete duplicates (default is to just report them)\n".
"\t-f file\t\tsave deleted messages in file named 'file'\n" .
"\t-F fldr\t\tOnly check the folder named 'fldr' (default is to check all folders)\n" .
"\t-h\t\tprint this help message (all other options are ignored)\n" .
"\t-p password\tspecify the target user's password\n" .
"\t-P port\t\tspecify the port to connect to (default is 143)\n" .
"\t-s server\tspecify the target mail server\n" .
"\t-u uid\t\tspecify the target user\n" .
"\t-t\t\tmove deleted messages to trash folder\n" .
"\t-v\t\tprint verbose status messages while processing\n".
"\n" ;
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
# History:
# $Log: find_dup_msgs.pl,v $
# Revision 19991216.5 2003/06/12 21:38:32 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 1.1 2003/06/12 21:38:14 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 19991216.4 2002/08/23 14:34:51 dkernen
#
# Modified Files: Changes IMAPClient.pm Makefile Makefile.PL test.txt for version 2.2.0
# Added Files: Makefile Makefile.PL Parse.grammar Parse.pm Parse.pod version 2.2.0
# Added Files: parse.t for version 2.2.0
# Added Files: bodystructure.t for 2.2.0
# Modified Files: find_dup_msgs.pl for v2.2.0
#
# Revision 1.6 2001/03/08 19:00:35 dkernen
#
# ----------------------------------------------------------------------
# Modified Files:
# copy_folder.pl delete_mailbox.pl find_dup_msgs.pl
# mbox_check.pl process_orphans.pl rename_id.pl
# scratch_indexes.pl
# to get ready for nsusmsg02 upgrade
# ----------------------------------------------------------------------
#
# Revision 1.5 2000/11/01 15:51:58 dkernen
#
# Modified Files: copy_folder.pl find_dup_msgs.pl restore_mbox.pl
#
# Revision 1.4 2000/04/13 21:17:18 dkernen
#
# Modified Files: find_dup_msgs.pl - to add -a switch (for aggressive dup search)
# Added Files: copy_folder.pl - a utility for copying a folder from one user's
# mailbox to another's
#
# Revision 1.3 2000/03/14 16:40:21 dkernen
#
# Modified Files: find_dup_msgs.pl -- to skip msgs with no message-id
#
# Revision 1.2 2000/03/13 19:05:50 dkernen
#
# Modified Files:
# delete_mailbox.pl find_dup_msgs.pl restore_mbox.pl -- to add cvs comments
# find_dup_msgs.pl -- to fix bug that occurred when -t (move-to-trash) switch is used
#

231
W/Mail-IMAPClient-3.40/examples/idle.pl Executable file
View File

@ -0,0 +1,231 @@
#!/usr/bin/perl
=head1 NAME
idle.pl - example using IMAP idle
=head1 SYNOPSIS
idle.pl [options]
Options: [*] == Required, [+] == Multiple vals OK, (val) == Default
--o Server=<server> *IMAP server name/IP
--o User=<user> *User account to login to
--o Password=<passwd> *Password to use for the User account
(see security note below)
--o Port=<port> port on Server to connect to
--o Ssl=<bool> use SSL on this connection
--o Starttls=<bool> call STARTTLS on this connection
--o Debug=<int> enable debugging in Mail::IMAPClient
--o ImapclientKey=Val any other Mail::IMAPClient attribute/value pair
--folder <folder> folder (mailbox) to IMAP SELECT (INBOX)
--maxidle <sec> maximum time to idle without receiving data (300)
--help display a brief help message
--man display the entire man page
--debug enable script debugging
=head1 NOTES
=head2 --o Password=<password>
A password specified as a command-line option may be visible
to other users via the system process table. It may alternately be
given in the PASSWORD environment variable.
=head2 --maxidle <sec>
RFC 2177 states, "The server MAY consider a client inactive if it has
an IDLE command running, and if such a server has an inactivity
timeout it MAY log the client off implicitly at the end of its timeout
period. Because of that, clients using IDLE are advised to terminate
the IDLE and re-issue it at least every 29 minutes to avoid being
logged off."
The default of --maxidle 300 is used to allow the client to notice
when a connection has silently been closed upstream due to network or
firewall issue or configuration without missing too many idle events.
=cut
use strict;
use warnings;
use File::Basename qw(basename);
use Getopt::Long qw(GetOptions);
use Mail::IMAPClient qw();
use Pod::Usage qw(pod2usage);
use POSIX qw();
use constant {
FOLDER => "INBOX",
MAXIDLE => 300,
};
$| = 1; # set autoflush
my $DEBUG = 0; # GLOBAL set by process_options()
my $QUIT = 0;
my $VERSION = "1.00";
my $Prog = basename($0);
###
# main program
main();
sub main {
my %Opt = process_options();
pout("started $Prog\n");
my $imap = Mail::IMAPClient->new( %{ $Opt{opt} } )
or die("$Prog: error: Mail::IMAPClient->new: $@\n");
my ( $folder, $chkseen, $tag ) = ( $Opt{folder}, 1, undef );
$imap->select($folder)
or die("$Prog: error: select '$folder': $@\n");
$SIG{'INT'} = \&sigint_handler;
until ($QUIT) {
unless ( $imap->IsConnected ) {
warn("$Prog: reconnecting due to error: $@\n") if $imap->LastError;
$imap->connect or last;
$imap->select($folder) or last;
$tag = undef;
}
my $ret;
if ($chkseen) {
$chkseen = 0;
# end idle if necessary
if ($tag) {
$tag = undef;
$ret = $imap->done or last;
}
my $unseen = $imap->unseen_count;
last if $@;
pout("$unseen unseen/new message(s) in '$folder'\n") if $unseen;
}
# idle for X seconds unless data was returned by done
unless ($ret) {
$tag ||= $imap->idle
or die("$Prog: error: idle: $@\n");
warn( "$Prog: DEBUG: ", _ts(), " do idle_data($Opt{maxidle})\n" )
if $DEBUG;
$ret = $imap->idle_data( $Opt{maxidle} ) or last;
# connection can go stale so we exit/re-enter of idle state
# - RFC 2177 mentions 29m but firewalls may be more strict
unless (@$ret) {
warn( "$Prog: DEBUG: ", _ts(), " force exit of idle\n" )
if $DEBUG;
$tag = undef;
# restarted lost connections on next iteration
$ret = $imap->done or next;
}
}
local ( $1, $2, $3 );
foreach my $resp (@$ret) {
$resp =~ s/\015?\012$//;
warn("$Prog: DEBUG: server response: $resp\n") if $DEBUG;
# ignore:
# - DONE command
# - <tag> OK IDLE...
next if ( $resp eq "DONE" );
next if ( $resp =~ /^\w+\s+OK\s+IDLE\b/ );
if ( $resp =~ /^\*\s+(\d+)\s+(EXISTS)\b/ ) {
my ( $num, $what ) = ( $1, $2 );
pout("$what: $num message(s) in '$folder'\n");
$chkseen++;
}
elsif ( $resp =~ /^\*\s+(\d+)\s+(EXPUNGE)\b/ ) {
my ( $num, $what ) = ( $1, $2 );
pout("$what: message $num from '$folder'\n");
}
# * 83 FETCH (FLAGS (\Seen))
elsif ( $resp =~ /^\*\s+(\d+)\s+(FETCH)\s+(.*)/ ) {
my ( $num, $what, $info ) = ( $1, $2, $3 );
$chkseen++ if ( $info =~ /[\(|\s]\\Seen[\)|\s]/ );
pout("$what: message $num from '$folder': $info\n");
}
else {
pout("server response: $resp\n");
}
}
}
my $rc = 0;
if ($@) {
if ($QUIT) {
warn("$Prog: caught signal\n");
}
else {
$rc = 1;
}
warn("$Prog: imap error: $@\n") if ( !$QUIT || $DEBUG );
}
exit($rc);
}
###
# supporting routines
sub pout {
print( _ts(), " ", @_ );
}
sub process_options {
my ( %Opt, @err );
GetOptions( \%Opt, "opt=s%", "debug:1", "help", "man", "folder=s",
"maxidle:i" )
or pod2usage( -verbose => 0 );
pod2usage( -message => "$Prog: version $VERSION\n", -verbose => 1 )
if ( $Opt{help} );
pod2usage( -verbose => 2 ) if ( $Opt{man} );
# set global DEBUG
$DEBUG = $Opt{debug} || 0;
# folder (mailbox) to watch
$Opt{folder} = FOLDER unless ( exists $Opt{folder} );
# restart idle when no idle_data seen for this long
$Opt{maxidle} = MAXIDLE unless ( exists $Opt{maxidle} );
$Opt{opt}->{Password} = $ENV{PASSWORD}
if ( !exists $Opt{opt}->{Password} && defined $ENV{PASSWORD} );
foreach my $arg (qw(Server User Password)) {
push( @err, "-o $arg=<val> is required" ) if !exists $Opt{opt}->{$arg};
}
pod2usage(
-verbose => 1,
-message => join( "", map( "$Prog: $_\n", @err ) )
) if (@err);
return %Opt;
}
# example: 2005-10-02 07:50:32
sub _ts {
my %opt = @_;
my $fmt = $opt{fmt} || "%Y-%m-%d %T";
return POSIX::strftime( $fmt, localtime(time) );
}
sub sigint_handler {
$QUIT = 1;
}

266
W/Mail-IMAPClient-3.40/examples/imap_to_mbox.pl Executable file
View File

@ -0,0 +1,266 @@
#!/usr/local/bin/perl
# (c) 1999 Thomas Stromberg, Research Triangle Commerce, Inc.
# This software is protected by the BSD License. No rights reserved anyhow.
# <tstromberg@rtci.com>
# DESC: Reads a users IMAP folders, and converts them to mbox
# Good for an interim switch-over from say, Exchange to Cyrus IMAP.
# $Header$
# History:
# --------
# 2008/08/07 - Added SSL support, fixed From header printing, and CR
# elimination (sobek)
# TODO:
# -----
# lsub instead of list option
use warnings;
use strict;
use Mail::IMAPClient; # a nice set of perl libs for imap
use IO::Socket::SSL; # for SSL support
use vars qw($opt_h $opt_u $opt_p $opt_P $opt_s $opt_i $opt_f $opt_m $opt_b
$opt_c $opt_r $opt_w $opt_W $opt_S $opt_D $opt_U $opt_d $opt_I
$opt_n);
use Getopt::Std; # for the command-line overrides. good for user
use File::Path; # create full file paths. (yummy!)
use File::Basename; # find a nice basename for a folder.
use Date::Manip; # to create From header date
$| = 1;
sub connect_imap();
sub find_folders();
sub write_folder($$$$);
sub help();
# Config for the imap migration kit.
getopts('u:p:P:s:i:f:m:b:c:r:w:W:SDUdhIn:') or
$opt_h = 1;
my $SSL = $opt_S || 0;
my $SERVER = $opt_s || 'machine';
my $USER = $opt_u || 'userid';
my $PASSWORD = $opt_p || 'password';
my $PORT = $opt_P || '143';
my $INBOX_PATH = $opt_i || "/var/mail/$USER";
my $DOINBOX = $opt_I ? 0 : 1 || 1;
my $FOLDERS_PATH = $opt_f || "./folders/$USER";
my $DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl';
my $READ_DELIMITER = $opt_r || '/';
my $WRITE_DELIMITER = $opt_w || '/';
my $WRITE_MODE = $opt_W || '>';
my $BANNED_CHARS = $opt_b || '.|^|%';
my $CR = $opt_c || "\r";
my $NUMBER = $opt_n || "";
my $DELETE = $opt_D || 0;
my $DEBUG = $opt_d || "0";
my $UNSEEN = $opt_U || 0;
my $FAIL = 0;
my $imap; # definition for IMAP structure
if ($opt_h) {
# print help here
help();
}
sub help() {
print "imap_to_mbox.pl - with the following optional arguments\:
-S Use an SSL connection (default $SSL)
-s <s> Server specification (default $SERVER)
-u <u> User login (default $USER)
-p <p> User password
-P <p> Server Port (default $PORT)
-i <i> INBOX save path (default $INBOX_PATH)
-I skip INBOX (default $DOINBOX)
-f <f> Save path for other folders (default $FOLDERS_PATH)
-m <r> Regexp for IMAP folders not to be saved:
$DONT_MOVE
-r <r> Read delimiter (default \"$READ_DELIMITER\")
-w <w> Write Delimiter (default \"$WRITE_DELIMITER\")
-b <b> Banned chars (default \"$BANNED_CHARS\")
-c <c> Strip CRs from saved files [for Unix] (default \"$CR\")
-n <n> Receive only <n> messages (Default ".($NUMBER ? "$NUMBER" : "all").")
-U Unseen messages Only
-D Delete downloaded files on server
-d Debug mode (default $DEBUG)\n";
exit 1;
}
## do our magic tricks ######################################
connect_imap();
find_folders();
sub connect_imap()
{
# Open an SSL session to the IMAP server
# Handles the SSL setup, and gives us back a socket
my $ssl;
if ($opt_S) {
$ssl=IO::Socket::SSL->new(
PeerHost => "$SERVER:imaps"
# , SSL_version => 'SSLv2' # for older versions of openssl
);
defined $ssl
or die "Error connecting to $SERVER:imaps - $@";
$ssl->autoflush(1);
}
$imap = Mail::IMAPClient->new(
Socket => ($opt_S ? $ssl : 0),
Server => $SERVER,
User => $USER,
Password => $PASSWORD,
Port => $PORT,
Debug => $DEBUG,
Uid => 0,
Clear => 1,
)
or die ("Could not connect to $SERVER:$PORT with $USER: $! $?\n");
}
sub find_folders()
{
my @folders = $imap->folders;
# push(@folders, "INBOX");
foreach my $folder (@folders) {
my $message_count;
if ($folder eq "INBOX" and $DOINBOX == 0) {
print "* $folder is unwanted, skipping.\n";
next;
}
if (!$UNSEEN) {
$message_count = $imap->message_count($folder);
} else {
$message_count = $imap->unseen_count($folder) || 0;
}
if(! $message_count) {
print "* $folder is empty, skipping.\n";
next;
}
if($folder =~ /$DONT_MOVE/) {
warn "! $folder matches DONT_MOVE ruleset, skipping\n";
next;
}
my $new_folder = $folder;
$new_folder =~ s/\./_/g;
$new_folder =~ s/\Q$READ_DELIMITER/$WRITE_DELIMITER/g;
my $path
= $new_folder eq "INBOX" ? "$INBOX_PATH"
: "$FOLDERS_PATH/$new_folder";
if ($NUMBER && $NUMBER < $message_count) {
printf "x %4i %-45.45s => %s", $NUMBER, $folder, $path;
write_folder $folder, $path, 1, $NUMBER;
} else {
printf "x %4i %-45.45s => %s", $message_count, $folder, $path;
write_folder $folder, $path, 1, $message_count;
}
}
}
sub write_folder($$$$)
{ my($folder, $newpath, $first_message, $last_message) = @_;
$imap->select($folder)
or warn "Could not examine $folder: $!";
my $new_dir = dirname $newpath;
my $new_file = basename $newpath;
-d $new_dir
or mkpath($new_dir, 0700)
or die "Cannot create $new_dir:$!\n";
open my $mbox, $WRITE_MODE, $newpath
or die "Cannot create file $newpath: $!\n";
my @msgs = $imap->unseen if $UNSEEN;
for (my $i=$first_message; $i<$last_message+1; ++$i)
{ my $m = ($UNSEEN ? shift @msgs : $i);
my $date = UnixDate(ParseDate($imap->internaldate($m)),
"%a %b %e %T %Y");
my $user = $imap->get_envelope($m)->from_addresses;
$user =~ s/^.*<([^>]*)>/$1/;
$user = '-' unless $user;
print '.' if $m%25 == 0;
my $msg_header = $imap->fetch($m, "FAST")
or warn "Could not fetch header $m from $folder\n";
my $msg_rfc822 = $imap->fetch($m, "RFC822");
unless($msg_rfc822)
{ warn "Could not fetch RFC822 $m from $folder\n";
$FAIL=1
}
undef my $start;
foreach (@$msg_rfc822)
{ my $message;
if($_ =~ /\: / && !$message)
{ ++$message;
print $mbox "From $user $date\n";
}
if(/^\)\r/)
{ undef $message;
print $mbox "\n\n";
}
next unless $message;
$_ =~ s/\r$//;
$_ = $imap->Strip_cr($_) if $CR;
print $mbox "$_";
}
if($DELETE && ! $FAIL)
{ $imap->delete_message($m)
or warn "Could not delete_message: $@\n";
$FAIL = 0;
}
}
close $mbox
or die "Write errors to $newpath: $!\n";
if($DELETE)
{ $imap->expunge($folder)
or warn "Could not expunge: $@\n";
}
print "\n";
}
# 2008/08/07 - Added SSL support, fixed From header printing, and CR
# elimination (sobek)
#
# Revision 19991216.7 2002/08/23 13:29:48 dkernen
#
# Revision 19991216.6 2000/12/11 21:58:52 dkernen
#
# Revision 19991216.5 1999/12/16 17:19:12 dkernen
# Bring up to same level
#
# Revision 19991124.3 1999/12/16 17:14:25 dkernen
# Incorporate changes for exists method performance enhancement
#
# Revision 19991124.02 1999/11/24 17:46:19 dkernen
# More fixes to t/basic.t
#
# Revision 19991124.01 1999/11/24 16:51:49 dkernen
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
#
# Revision 1.3 1999/11/23 17:51:06 dkernen
# Committing version 1.06 distribution copy

226
W/Mail-IMAPClient-3.40/examples/imtestExample.pl Executable file
View File

@ -0,0 +1,226 @@
#!/usr/local/bin/perl
use Sys::Hostname;
use Mail::IMAPClient;
use IPC::Open3;
use IO::Socket::UNIX;
use IO::Socket;
use Socket;
use Getopt::Std;
&getopts('ha:df:i:o:p:r:m:u:x:w:p:s:');
if ($opt_h) {
print <<" HELP";
$0 -- uses imtest to connect and authenticate to imap server
Options:
-h print this help message
-a auth authenticate as user 'auth'. This value is passed as the '-a' value
to imtest and defaults to whatever you supplied for -u.
-d turn on Mail::IMAPClient debugging
-f file write Mail::IMAPClient debugging info to file 'file'
-m mech use authentication mechanism "mech"; default is to not supply -m to
imtest
-i path path to imtest executable; default is to let your shell find it via the
PATH environmental variable.
-p port port on mail server to connect to (default is 143)
-r rlm Use realm 'rlm' (default is name of mail server)
-s srvr Name of IMAP mail server (default is the localhost's hostname)
-u usr Use 'usr' as the user id (required)
-w pswd Use 'pswd' as the password for 'usr' (required)
-x path Path to Unix socket (fifo). Default is '/tmp/$0.sock'.
-o 'ops' Pass the string 'ops' directy to imtest as additional options.
This is how you get "other" imtest options passed to imtest. (I only
included switches for options that are either really common or useful
to the IMAPClient object as well as to imtest.)
Many of these switches have the same function here as with imtest. I added a
few extras though!
Example:
$0 -o '-k 128 -l 128' -s imapmail -u test -w testpswd \
-i /usr/local/src/cyrus/cyrus-imapd-2.1.11/imtest/ \
-m DIGEST-MD5
It's a good idea to test your options by running imtest from the command line
(but without the -x switch) first. Once you have it working by hand you should
be able to get it to work from this script (or one remarkably like it) without
too much bloodshed.
HELP
exit;
}
$opt_u and $opt_w or die "No userid/password credentials supplied. I hate that.\n";
$opt_a ||= $opt_u;
if ($opt_i ) {
$opt_i =~ m#^[/\.]# or $opt_i = "./$opt_i";
$opt_i =~ m#imtest$# or ( -x $opt_i and -f $opt_i )
or $opt_i .= ( $opt_i =~ m#/$# ? "imtest" : "/imtest") ;
-x $opt_i and -f $opt_i or die "Cannot find executable $opt_i\n";
}
$opt_p ||= 143;
$opt_s ||= hostname;
$opt_r ||= $opt_s;
$opt_x ||= "/tmp/$0.sock";
my($rfh,$wfh,$efh) ;
my($imt) = ($opt_i ? "$opt_i " : "imtest ") .
($opt_m ? "-m $opt_m ":"" ) .
qq(-r $opt_r -a $opt_a -u $opt_u ).
qq(-x $opt_x -w $opt_w -p $opt_p $opt_s);
open3($wfh,$rfh,$efh,$imt);
my $line;
until ($line =~ /^Security strength factor:/i ) {
$line = <$rfh> or die "EOF\n";
print STDERR "Prolog: $line" if $opt_d;
}
sleep 5;
my $sock = IO::Socket::UNIX->new("$opt_x")
or warn "No socket: $!\n" and exit;
print STDERR "<<<END OF PROLOG>>>\n" if $opt_d;
my $imap = Mail::IMAPClient->new;
$imap->Prewritemethod(\&Mail::IMAPClient::Strip_cr);
$imap->User("$opt_u");
$imap->Server("$opt_s");
$imap->Port("$opt_p");
$imap->Debug($opt_d);
$imap->Debug_fh($opt_f||\*STDERR);
$imap->State($imap->Connected);
$imap->Socket($sock);
# Your code goes here:
$imap->Select("INBOX");
for my $m (@{$imap->search("TEXT SUBJECT")} ) {
print "Message $m:\t",$imap->subject($m),"\n";
}
# You should have finished your code by about here
$imap->logout;
print STDERR "<<<END>>>\n" if $opt_d;
exit;
=head1 NAME
imtestExample.pl -- uses imtest to connect and authenticate to imap server
=head1 DESCRIPTION
=head2 Options
=over 4
=item -h
print this help message
=item -a auth
authenticate as user 'auth'. This value is passed as the '-a' value
to imtest and defaults to whatever you supplied for -u.
=item -d
turn on Mail::IMAPClient debugging
=item -f file
write Mail::IMAPClient debugging info to file 'file'
=item -m mech
use authentication mechanism "mech"; default is to not supply -m to
imtest
=item -i path
path to imtest executable; default is to let your shell find it via the
PATH environmental variable.
=item -p port
port on mail server to connect to (default is 143)
=item -r rlm
Use realm 'rlm' (default is name of mail server)
=item -s srvr
Name of IMAP mail server (default is the localhost's hostname)
=item -u usr
Use 'usr' as the user id (required)
=item -w pswd
Use 'pswd' as the password for 'usr' (required)
=item -x path
Path to Unix socket (fifo). Default is '/tmp/$0.sock'.
=item -o 'ops'
Pass the string 'ops' directy to imtest as additional options.
This is how you get "other" imtest options passed to imtest. (I only
included switches for options that are either really common or useful
to the IMAPClient object as well as to imtest.)
Many of these switches have the same function here as with imtest. I added a
few extras though!
=back
Example:
imtestExample.pl -o '-k 128 -l 128' -s imapmail -u test -w testpswd \
-i /usr/local/src/cyrus/cyrus-imapd-2.1.11/imtest/ \
-m DIGEST-MD5
It's a good idea to test your options by running imtest from the command line
(but without the -x switch) first. Once you have it working by hand you should
be able to get it to work from this script (or one remarkably like it) without
too much bloodshed.
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
Based on a suggestion by Tara L. Andrews.
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut

326
W/Mail-IMAPClient-3.40/examples/migrate_mail2.pl Executable file
View File

@ -0,0 +1,326 @@
#!/usr/local/bin/perl
#$Id$
#
# An example of how to migrate from a Netscape server
# (which uses a slash as a separator and which does
# not allow subfolders under the INBOX, only next to it)
# to a Cyrus server (which uses a dot (.) as a separator
# and which requires subfolders to be under "INBOX").
# There are also some allowed-character differences taken
# into account but this is by no means complete AFAIK.
#
# This is an example. If you are doing mail migrations
# then this may in fact be a very helpful example but
# it is unlikely to work 100% correctly as-is.
# A good place to start is by testing a rather large-volume
# transfer of actual mail from the source server with the
# -v option turned on and redirect output to a file for
# perusal. Examine the output carefully for unexpected
# results, such as a number of messages being skipped because
# they're already in the target folder when you know darn
# well this is the first time you ran the script. This
# would indicate an incompatibility with the logic for
# detecting duplicates, unless for some reason the source
# mailbox contains a lot of duplicate messages to begin with.
# (The latter case is an example of why you should use an
# actual mailbox stuffed with actual mail for test; if you
# generate test messages and then test migrating those you
# will only prove that your test messages are migratable.
#
# Also, you may need to play with the rules
# for translating folder names based on what kind of
# names your target server and source server support.
#
# You may also need to play with the logic that determines
# whether or not a message has already been migrated,
# especially if your source server has messages that
# did not come from an SMTP gateway or something like that.
#
# Some servers allow folders to contain mail and subfolders,
# some allow folders to only contain either mail or subfolders.
# If you are migrating from a "mixed use" type to a "single use"
# type server then you'll have to figure out how to deal
# with this. (This script deals with this by creating folders like
# "/blah_mail", "/blah/blah_mail", and "/blah/blah/blah_mail"
# to hold mail if the source folder contains mail and subfolders
# and the target server supports only single-use folders.
# You may not choose a different strategy.)
#
# Finally, it's possible that in some server-to-server
# copies, the source server supports messages that the
# target server considers unacceptable. For example, some
# but not all IMAP servers flat out refuse to accept
# messages with "base newlines", which is to say messages
# whose lines are match the pattern /[^\r]\n$/. There is
# no logic in this script that deals with the situation;
# you will have to identify it if it exists and figure
# out how you want to handle it.
#
# This is probably not an exhaustive list of issues you'll
# face in a migration, but it's a start.
#
# If you're just migrating from an old version to a newer
# version of the same server then you'll probably have
# a much easier time of it.
#
#
use Mail::IMAPClient;
use Data::Dumper;
use IO::File;
use File::Basename ;
use Getopt::Std;
use strict;
use vars qw/ $opt_B $opt_D $opt_T $opt_U
$opt_W $opt_b $opt_d $opt_h
$opt_t $opt_u $opt_w $opt_v
$opt_s $opt_S $opt_W $opt_p
$opt_P $opt_f $opt_F $opt_m
$opt_M
/;
getopts('vs:S:u:U:dDb:B:f:F:w:W:p:P:t:T:hm:M:');
if ( $opt_h ) {
print STDERR <<"HELP";
$0 - an example script demonstrating the use of the Mail::IMAPClient's
migrate method.
Syntax:
$0 -s source_server -u source_user -w source_password -p source_port \
-d debug_source -f source_debugging_file -b source_buffsize \
-t source_timeout -m source_auth_mechanism \
-S target_server -U target_user -W target_password -P target_port \
-D debug_target -F target_debugging_file -B target_buffsize \
-T target_timeout -M target_auth_mechanism \
-v
where "source" refers to the "copied from" mailbox, target is the
"copied to" mailbox, and -v turns on verbose output.
Authentication mechanisms default to "PLAIN".
HELP
exit;
}
$opt_v and ++$|;
print "$0: Started at ",scalar(localtime),"\n" if $opt_v;
$opt_p||=143;
$opt_P||=143;
# Make a connection to the source mailbox:
my $imap = Mail::IMAPClient->new(
Server => $opt_s,
User => $opt_u,
Password=> $opt_w,
Uid => 1,
Port => $opt_p,
Debug => $opt_d||0,
Buffer => $opt_b||4096,
Fast_io => 1,
( $opt_m ? ( Authmechanism => $opt_m) : () ),
Timeout => $opt_t,
($opt_f ? ( Debug_fh=>IO::File->new(">$opt_f" )) : ()),
) or die "$@";
# Make a connection to the target mailbox:
my $imap2 = Mail::IMAPClient->new(
Server => $opt_S,
User => $opt_U,
Password=> $opt_W,
Port => $opt_P,
Uid => 1,
Debug => $opt_D||0,
( $opt_M ? ( Authmechanism => $opt_M) : () ),
($opt_F ? ( Debug_fh=>IO::File->new(">$opt_F")) : ()),
Buffer => $opt_B||4096,
Fast_io => 1,
Timeout => $opt_T, # True value
) or die "$@";
# Turn off buffering on debug files:
$imap->Debug_fh->autoflush;
$imap2->Debug_fh->autoflush;
# Get folder hierarchy separator characters from source and target:
my $sep1 = $imap->separator;
my $sep2 = $imap2->separator;
# Find out if source and target support subfolders inside INBOX:
my $inferiorFlag1 = $imap->is_parent("INBOX");
my $inferiorFlag2 = $imap2->is_parent("INBOX");
# Set up a test folders to see if the source and target support mixed-use
# folders (i.e. folders with both subfolders and mail messages):
my $testFolder1 = "Migrate_Test_$$" ; # Ex: Migrate_Test_1234
$testFolder1 = $inferiorFlag2 ?
"INBOX" . $sep2 . $testFolder1 :
$testFolder1 ;
# The following folder will be a subfolder of $testFolder1:
my $testFolder2 = "Migrate_Test_$$" . $sep2 . "Migrate_test_subfolder_$$" ;
$testFolder2 = $inferiorFlag2 ? "INBOX" . $sep2 . $testFolder2 : $testFolder2 ;
$imap2->create($testFolder2) ; # Create the subfolder first; RFC2060 dictates that
# the parent folder should be created at the same time
# The following line inspired the selectable method. It was also made obsolete by it,
# but I'm leaving it as is to demonstrate use of lower-level method calls:
my $mixedUse2 = grep(/NoSelect/i,$imap2->list("",$testFolder1))? 0 : 1;
# Repeat the above with the source mailbox:
$testFolder2 = "Migrate_Test_$$" . $sep1 . "Migrate_test_subfolder_$$" ;
$testFolder2 = $inferiorFlag1 ? "INBOX" . $sep1 . $testFolder1 : $testFolder1 ;
$imap->create($testFolder2) ;
my $mixedUse1 = grep(/NoSelect/i,$imap->list("",$testFolder1))? 0 : 1;
print "Imap host $opt_s:$opt_p uses a '$sep1' as a separator and ",
( defined($inferiorFlag1) ? "allows " : "does not allow "),
"children in the INBOX. It supports ",
($mixedUse1?"mixed use ":"single use "), "folders.\n" if $opt_v;
print "Imap host $opt_S:$opt_P uses a '$sep2' as a separator and ",
( defined($inferiorFlag2) ? "allows " : "does not allow "),
"children in the INBOX. It supports ",
($mixedUse2?"mixed use ":"single use "), "folders.\n" if $opt_v;
for ($testFolder1,$testFolder2) {$imap->delete($_); $imap2->delete($_);}
my($totalMsgs, $totalBytes) = (0,0);
# Now we will migrate the folder. Here we are doing one message at a time
# so that we can do more granular status reporting and error checking.
# A lazier way would be to do all the messages in one migrate method call
# (specifying "ALL" as the message number) but then we wouldn't be able
# to print out which message we were migrating and it would be a little
# bit tougher to control checking for duplicates and stuff like that.
# We could also check the size of the message on the target right after
# the migrate as an extra safety check if we wanted to but I didn't bother
# here. (I saved as an exercise for the reader. Yeah! That's it! An exercise!)
# Iterate over all the folders in the source mailbox:
for my $f ($imap->folders) {
# Select the folder on the source side:
$imap->select($f) ;
# Massage the foldername into an acceptable target-side foldername:
my $targF = "";
my $srcF = $f;
$srcF =~ s/^INBOX$sep1//i;
if ( $inferiorFlag2 ) {
$targF = $srcF eq "INBOX" ? "INBOX" : "INBOX.$f" ;
} else {
$targF = $srcF ;
}
$targF =~ s/$sep1/$sep2/go unless $sep1 eq $sep2;
$targF =~ tr/#\$\& '"/\@\@+_/;
if ( $imap->is_parent($f) and !$mixedUse2 ) {
$targF .= "_mail" ;
}
print "Migrating folder $f to $targF\n" if $opt_v;
# Create the (massaged) folder on the target side:
unless ( $imap2->exists($targF) ) {
$imap2->create($imap2->Massage($targF))
or warn "Cannot create $targF on " . $imap2->Server . ": $@\n" and next;
}
# ... and select it
$imap2->select($imap2->Massage($targF))
or warn "Cannot select $targF on " . $imap2->Server . ": $@\n" and next;
# now that we know the target folder is selectable, we can close it again:
$imap2->close;
my $count = 0;
my $expectedTotal = $imap->message_count($f) ;
# Now start iterating over all the messages on the source side...
for my $msg ($imap->messages) {
++$count;
my $h = "";
# Get some basic info about the message:
eval { $h = ($imap->parse_headers($msg,"Message-id")||{})->{'Message-id'}[0]};
my $tsize = $imap->size($msg);
my $ret = 0 ; my $h2 = [];
# Make sure we didn't already migrate the message in a previous pass:
$imap2->select($targF);
if ( $tsize and $h and $h2 = $imap2->search(
HEADER => 'Message-id' => $imap2->Quote($h),
NOT => SMALLER => $tsize,
NOT => LARGER => $tsize
)
) {
print
"Skipping $f/$msg to $targF. ",
"One or more messages (" ,join(", ",@$h2),
") with the same size and message id ($h) ",
"is already on the server. ",
"\n"
if $opt_v;
$imap2->close;
} else {
print
"Migrating $f/$msg to $targF. ",
"Message #$count of $expectedTotal has ",
$tsize , " bytes.",
"\n" if $opt_v;
$imap2->close;
# Migrate the message:
my $ret = $imap->migrate($imap2,$msg,"$targF") ;
$ret and ( $totalMsgs++ , $totalBytes += $tsize);
$ret or warn "Cannot migrate $f/$msg to $targF on " . $imap2->Server . ": $@\n" ;
}
}
}
print "$0: Finished migrating $totalMsgs messages and $totalBytes bytes at ",scalar(localtime),"\n"
if $opt_v;
exit;
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
#$Log: migrate_mail2.pl,v $
#Revision 19991216.4 2003/06/12 21:38:33 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#

131
W/Mail-IMAPClient-3.40/examples/migrate_mbox.pl Executable file
View File

@ -0,0 +1,131 @@
#!/usr/local/bin/perl
#
# This is an example demonstrating the use of the migrate method.
# Note that the migrate method is considered experimental and should
# be used with caution.
#
#$Id$
#
use Mail::IMAPClient;
use IO::File;
use File::Basename ;
use Getopt::Std;
use warnings;
use vars qw/$opt_h $opt_H
$opt_s $opt_u $opt_p $opt_d $opt_b $opt_o
$opt_S $opt_U $opt_P $opt_D $opt_B $opt_O
/;
getopts('Hhs:S:u:U:p:P:d:D:b:B:o:O:');
if ($opt_h or $opt_H ) {
print << "HELP";
Usage:
$0 -[h|H] -- prints this message
Lower-case options are for source server; upper-case options are for the target server.
$0 -s server -S server -u uid -U uid -p passwd -P passwd \
-b buffersize -B buffersize -o debugFile -O debugFile > error_file
All uppercase options except -O default to the lowercase option that was specified.
If you don't specify any uppercase options at all then God help you, I don't know
what will happen.
Always capture STDERR so that you'll be able to resolve any problems that come up.
HELP
exit;
}
my $imap = Mail::IMAPClient->new(
Server => $opt_s,
User => $opt_u,
Password=> $opt_p,
Uid => 1,
Debug => $opt_d,
Buffer => $opt_b||4096,
Fast_io => 1,
Timeout => 160, # True value
Debug_fh=> (
$opt_o ? IO::File->new(">$opt_o")||die "can't open $opt_o: $!\n" : undef )
) or die "Error opening source connection: $@\n";
my $imap2 = Mail::IMAPClient->new(
Server => $opt_S||$opt_s,
User => $opt_U||$opt_u,
Password=> $opt_P||$opt_p,
Uid => 1,
Debug => $opt_D||$opt_d,
Buffer => $opt_B||$opt_b||4096,
Fast_io => 1,
Timeout => 160,
Debug_fh=> (
$opt_O ? IO::File->new(">$opt_O")||die "can't open $opt_O: $!\n" : undef )
) or die "Error opening target connection: $@\n";
$imap->Debug_fh->autoflush;
$imap2->Debug_fh->autoflush;
for my $f ($imap->folders) { $imap->select($f) ; $imap->migrate($imap2,"ALL") ;}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
#
#$Log: migrate_mbox.pl,v $
#Revision 19991216.2 2003/06/12 21:38:33 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
#Revision 1.1 2003/06/12 21:38:15 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
#

246
W/Mail-IMAPClient-3.40/examples/populate_mailbox.pl Executable file
View File

@ -0,0 +1,246 @@
#!/usr/bin/perl
use Time::Local;
use FileHandle;
use File::Copy;
use Mail::IMAPClient;
use Sys::Hostname;
my $default_user = 'default';
my $default_pswd = 'default';
###
# ARGS: DATE = YYYYMMDDHHMM (defaults to current system date)
# UID = IMAP account id (defaults to $default_user)
# PSWD = uid's password (defaults to $default_pswd)
# HOST = Target host (defaults to localhost)
# CLEAN = 1 (defaults to 0; used to clean out mailbox 1st)
# CLEANONLY= 1 (defaults to 0; if 1 then only CLEAN is done)
# DOMAIN = x.com (no default) the mail domain for UID's address
#
# EG: populate_mailbox.pl DATE=200001010100 UID=testuser
###
( my ($x) = join( " ", @ARGV ) );
$x =~ s~=~ ~g;
chomp($x);
my %hash = split( /\s+/, $x ) if $x;
while ( my ( $k, $v ) = each %hash ) {
$hash{ uc $k } = $v;
}
while ( my ( $k, $v ) = each %hash ) {
delete $hash{$k} if $k =~ tr/[a-z]//;
}
$hash{UID} ||= "$default_user";
$hash{PSWD} ||= "$default_pswd";
$hash{HOST} ||= hostname;
while ( my ( $k, $v ) = each %hash ) {
print "Running with $k set to $v\n";
}
my $domain = $hash{DOMAIN} or die "No mail domain provided.\n";
my $now = seconds( $hash{DATE} ) || time;
my $six = $now - ( 6 * 24 * 60 * 60 );
my $seven = $now - ( 7 * 24 * 60 * 60 );
my $notthirty = $now - ( 29 * 24 * 60 * 60 );
my $thirty = $now - ( 30 * 24 * 60 * 60 );
my $notsixty = $now - ( 59 * 24 * 60 * 60 );
my $sixty = $now - ( 60 * 24 * 60 * 60 );
my $notd365 = $now - ( 364 * 24 * 60 * 60 );
my $d365 = $now - ( 365 * 24 * 60 * 60 );
$hash{SUBJECTS} = [
"Sixty days old",
"Less than sixty days old",
"365 days old",
"Less than 365 days old",
"Trash/Incinerator -- 7 days old",
"Sent -- 29 days old",
"Sent -- 30 days old",
"Trash -- 6 days old",
];
$hash{FOLDERS} = [
"Sent", "INBOX",
"Trash", "365_folder",
"Trash/Incinerator", "not_365_folder",
];
&clean_mailbox if $hash{CLEANONLY} || $hash{CLEAN};
exit if $hash{CLEANONLY};
# send to: date: subject:
# -------- --- ----- ---------
sendmail( $hash{UID}, $sixty, "Sixty days old" );
sendmail( $hash{UID}, $notsixty, "Less than sixty days old" );
sendmail( $hash{UID}, $d365, "365 days old" );
sendmail( $hash{UID}, $notd365, "Less than 365 days old" );
populate_trash( "Trash/Incinerator", $hash{UID}, $seven, 7 );
populate_trash( "Trash", $hash{UID}, $six, 6 );
populate_trash( "Sent", $hash{UID}, $thirty, 30 );
populate_trash( "Sent", $hash{UID}, $notthirty, 29 );
movemail( "365 days old", "365_folder" );
movemail( "Less than 365 days old", "not_365_folder" );
exit;
sub seconds {
my $d = shift or return undef;
my ( $yy, $moy, $dom, $hr, $min ) =
$d =~ m! ^ # anchor at start #
(\d\d\d\d) # year #
(\d\d) # month #
(\d\d) # day #
(\d\d) # hour #
(\d\d) # minute #
!x;
# allow year 0999 to be year 999, and year 0099 to be year 99
return timegm( 0, $min, $hr, $dom, $moy - 1,
( $yy > 999 ? $yy : $yy - 1900 ) );
}
sub sendmail {
my ( $to, $date, $subject ) = @_;
my $text = <<EOTEXT ;
To: $to\@$hash{DOMAIN}
Date: @{[&rfc822_date($date)]}
Subject: $subject
Dear mail tester,
This is a test message to test mail for messages \l$subject.
I hope you like it!
Love,
The E-Mail Engineering Team
EOTEXT
for ( my $x = 0 ; $x < 10 ; $x++ ) {
my $imap = Mail::IMAPClient->new(
Server => $hash{HOST},
User => $hash{UID},
Password => $hash{PSWD}
) or die "can't connect: $!\n";
$imap->append( "INBOX", $text );
$imap->logout;
}
}
sub populate_trash {
my $where = shift;
my $to = shift;
my $date = shift;
my $d = shift;
my ( $ss, $min, $hr, $day, $mon, $year ) = gmtime($date);
$mon++;
$year += 1900;
my $fn = sprintf( "%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d",
$year, $mon, $day, $hr, $min, $ss );
my $x = 0;
my $subject = "$where -- $d days old";
while ( $x++ < 10 ) {
my $fh;
$fh .= "Date: @{[&rfc822_date($date)]}\n";
$fh .= <<EOTRAH ;
Subject: $subject
This note was put in the $where folder $d days ago. (My how time flies!)
I hope you enjoyed testing with it!
EOTRAH
my $imap = Mail::IMAPClient->new(
Server => $hash{HOST},
User => $hash{UID},
Password => $hash{PSWD}
) or die "can't connect: $!\n";
$imap->append( $where, $fh );
}
}
sub movemail {
my ( $subj, $fold ) = @_;
my $fh = Mail::IMAPClient->new(
Debug => 0,
Server => $hash{HOST},
User => $hash{UID},
Password => $hash{PSWD},
);
$fh->select("inbox") or die "cannot open inbox: $!\n";
foreach my $f ( $fh->search(qq(SUBJECT "$subj")) ) {
$fh->move( $fold, $f );
}
}
sub clean_mailbox {
my $fh = Mail::IMAPClient->new(
Debug => 0,
Server => $hash{HOST},
User => $hash{UID},
Password => $hash{PSWD},
);
for my $x ( @{ $hash{FOLDERS} } ) {
my @msgs;
$fh->create($x) unless $fh->exists($x);
$fh->select($x);
for my $s ( @{ $hash{SUBJECTS} } ) {
push @msgs, $fh->search(qq(SUBJECT "$s"));
}
$fh->delete_message(@msgs) if scalar(@msgs);
$fh->expunge;
}
}
# Date: Fri, 09 Jul 1999 13:10:55 -0400
sub rfc822_date {
my $date = shift;
my @date = localtime($date);
my @dow = qw{ Sun Mon Tue Wed Thu Fri Sat };
my @mnt = qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
return sprintf(
"%s, %2.2d %s %4.4s %2.2d:%2.2d:%2.2d -0400",
$dow[ $date[6] ],
$date[3],
$mnt[ $date[4] ],
$date[5] += 1900,
$date[2], $date[1], $date[0]
);
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut

88
W/Mail-IMAPClient-3.40/examples/sharedFolder.pl Executable file
View File

@ -0,0 +1,88 @@
#!/usr/local/bin/perl
#$Id$
use Mail::IMAPClient;
use Getopt::Std;
use File::Basename;
getopts('s:u:p:f:dh');
if ($opt_h) {
print STDERR "$0 -- example of how to select shared folder\n",
"\n\nUsage:\n",
"\t-s server -- specify name or ip address of mail server\n",
"\t-u userid -- specify login name of authenticating user\n",
"\t-p passwd -- specify login password of authenticating user\n",
"\t-f folder -- specify shared folder to access (i.e. '-f frank/INBOX')\n",
"\t-h display this help message\n\n";
"\t-d turn on debugging output\n\n";
exit;
}
my $server = $opt_s or die "No server name specified\n";
my $user = $opt_u or die "No user name specified\n";
my $pass = $opt_p or die "No password specified\n";
my $folder = $opt_f or die "No shared folder specified\n";
chomp $pass;
my $imap = Mail::IMAPClient->new(Server=>$server,User=>$user,Password=>$pass,Debug=>$opt_d)
or die "Can't connect to $user\@$server: $@ $!\n";
my($prefix,$prefSep) = @{$imap->namespace->[1][0]}
or die "Can't get shared folder namespace or separator: $@\n";
my $target = $prefix .
( $prefix =~ /\Q$prefSep\E$/ || $opt_f =~ /^\Q$prefSep/ ? "" : $prefSep ) .
$opt_f ;
print "Selecting $target\n";
$imap->select($target)
or die "Cannot select $target: $@\n";
print "Ok: $target has ", $imap->message_count($target)," messages.\n";
$imap->logout;
exit;
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
#
#$Log: sharedFolder.pl,v $
#Revision 19991216.1 2003/06/12 21:38:35 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
#

3549
W/Mail-IMAPClient-3.40/lib/Mail/IMAPClient.pm Normal file
View File

File diff suppressed because it is too large Load Diff

3997
W/Mail-IMAPClient-3.40/lib/Mail/IMAPClient.pod Normal file
View File

File diff suppressed because it is too large Load Diff

576
W/Mail-IMAPClient-3.40/lib/Mail/IMAPClient/BodyStructure.pm Normal file
View File

@ -0,0 +1,576 @@
use warnings;
use strict;
package Mail::IMAPClient::BodyStructure;
use Mail::IMAPClient::BodyStructure::Parse;
# BUG?: old code used name "HEAD" instead of "HEADER", change?
my $HEAD = "HEAD";
# my has file scope, not limited to package!
my $parser = Mail::IMAPClient::BodyStructure::Parse->new
or die "Cannot parse rules: $@\n"
. "Try remaking Mail::IMAPClient::BodyStructure::Parse.\n";
sub new {
my $class = shift;
my $bodystructure = shift;
my $self = $parser->start($bodystructure)
or return undef;
$self->{_prefix} = "";
$self->{_id} = exists $self->{bodystructure} ? $HEAD : 1;
$self->{_top} = 1;
bless $self, ref($class) || $class;
}
sub _get_thingy {
my $thingy = shift;
my $object = shift || ( ref $thingy ? $thingy : undef );
unless ( $object && ref $object ) {
warn $@ = "No argument passed to $thingy method.";
return undef;
}
unless ( UNIVERSAL::isa( $object, 'HASH' ) && exists $object->{$thingy} ) {
my $a = $thingy =~ /^[aeiou]/i ? 'an' : 'a';
my $has = ref $object eq 'HASH' ? join( ", ", keys %$object ) : '';
warn $@ =
ref($object)
. " $object does not have $a $thingy. "
. ( $has ? "It has $has" : '' );
return undef;
}
my $value = $object->{$thingy};
$value =~ s/\\ ( [\\\(\)"\x0d\x0a] )/$1/gx;
$value =~ s/^"(.*)"$/$1/;
$value;
}
BEGIN {
no strict 'refs';
foreach my $datum (
qw/ bodytype bodysubtype bodyparms bodydisp bodyid bodydesc bodyenc
bodysize bodylang envelopestruct textlines /
)
{
*$datum = sub { _get_thingy( $datum, @_ ) };
}
}
sub parts {
my $self = shift;
return wantarray ? @{ $self->{PartsList} } : $self->{PartsList}
if exists $self->{PartsList};
my @parts;
$self->{PartsList} = \@parts;
# BUG?: should this default to ($HEAD, TEXT)
unless ( exists $self->{bodystructure} ) {
$self->{PartsIndex}{1} = $self;
@parts = ( $HEAD, 1 );
return wantarray ? @parts : \@parts;
}
foreach my $p ( $self->bodystructure ) {
my $id = $p->id;
push @parts, $id;
$self->{PartsIndex}{$id} = $p;
my $type = uc $p->bodytype || '';
push @parts, "$id.$HEAD"
if $type eq 'MESSAGE';
}
wantarray ? @parts : \@parts;
}
sub bodystructure {
my $self = shift;
my $partno = 0;
my @parts;
if ( $self->{_top} ) {
$self->{_id} ||= $HEAD;
$self->{_prefix} ||= $HEAD;
$partno = 0;
foreach my $b ( @{ $self->{bodystructure} } ) {
$b->{_id} = ++$partno;
$b->{_prefix} = $partno;
push @parts, $b, $b->bodystructure;
}
return wantarray ? @parts : \@parts;
}
my $prefix = $self->{_prefix} || "";
$prefix =~ s/\.?$/./;
foreach my $p ( @{ $self->{bodystructure} } ) {
$partno++;
# BUG?: old code didn't add .TEXT sections, should we skip these?
# - This code needs to be generalised (maybe it belongs in parts()?)
# - Should every message should have HEAD (actually MIME) and TEXT?
# at least dovecot and iplanet appear to allow this even for
# non-multipart sections
my $pno = $partno;
my $stype = $self->{bodytype} || "";
my $ptype = $p->{bodytype} || "";
# a message and the multipart inside of it "collapse together"
if ( $partno == 1 and $stype eq 'MESSAGE' and $ptype eq 'MULTIPART' ) {
$pno = "TEXT";
$p->{_prefix} = "$prefix";
}
else {
$p->{_prefix} = "$prefix$partno";
}
$p->{_id} ||= "$prefix$pno";
push @parts, $p, $p->{bodystructure} ? $p->bodystructure : ();
}
wantarray ? @parts : \@parts;
}
sub id {
my $self = shift;
return $self->{_id}
if exists $self->{_id};
return $HEAD
if $self->{_top};
# BUG?: can this be removed? ... seems wrong
if ( $self->{bodytype} eq 'MULTIPART' ) {
my $p = $self->{_id} || $self->{_prefix};
$p =~ s/\.$//;
return $p;
}
else {
return $self->{_id} ||= 1;
}
}
package Mail::IMAPClient::BodyStructure::Part;
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
package Mail::IMAPClient::BodyStructure::Envelope;
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
sub new {
my ( $class, $envelope ) = @_;
$parser->envelope($envelope);
}
sub parse_string {
my ( $class, $envelope ) = @_;
$envelope = "(" . $envelope . ")" unless ( $envelope =~ /^\(/ );
$parser->envelopestruct($envelope);
}
sub from_addresses { shift->_addresses( from => 1 ) }
sub sender_addresses { shift->_addresses( sender => 1 ) }
sub replyto_addresses { shift->_addresses( replyto => 1 ) }
sub to_addresses { shift->_addresses( to => 0 ) }
sub cc_addresses { shift->_addresses( cc => 0 ) }
sub bcc_addresses { shift->_addresses( bcc => 0 ) }
sub _addresses($$$) {
my ( $self, $name, $isSender ) = @_;
ref $self->{$name} eq 'ARRAY'
or return ();
my @list;
foreach ( @{ $self->{$name} } ) {
my $pn = $_->personalname;
my $name = $pn && $pn ne 'NIL' ? "$pn " : '';
push @list, $name . '<' . $_->mailboxname . '@' . $_->hostname . '>';
}
wantarray ? @list
: $isSender ? $list[0]
: \@list;
}
BEGIN {
no strict 'refs';
for my $datum (
qw(subject inreplyto from messageid bcc date
replyto to sender cc)
)
{
*$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} }
}
}
package Mail::IMAPClient::BodyStructure::Address;
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
for my $datum (qw(personalname mailboxname hostname sourcename)) {
no strict 'refs';
*$datum = sub { shift->{$datum}; };
}
1;
__END__
=head1 NAME
Mail::IMAPClient::BodyStructure - parse fetched results
=head1 SYNOPSIS
use Mail::IMAPClient;
use Mail::IMAPClient::BodyStructure;
my $imap = Mail::IMAPClient->new(
Server => $server, User => $login, Password => $pass
);
$imap->select("INBOX") or die "Could not select INBOX: $@\n";
my @recent = $imap->search("recent") or die "No recent msgs in INBOX\n";
foreach my $id (@recent) {
my $bsdat = $imap->fetch( $id, "bodystructure" );
my $bso = Mail::IMAPClient::BodyStructure->new( join("", $imap->History) );
my $mime = $bso->bodytype . "/" . $bso->bodysubtype;
my $parts = map( "\n\t" . $_, $bso->parts );
print "Msg $id (Content-type: $mime) contains these parts:$parts\n";
}
=head1 DESCRIPTION
This extension will parse the result of an IMAP FETCH BODYSTRUCTURE
command into a perl data structure. It also provides helper methods
to help pull information out of the data structure.
This module requires Parse::RecDescent.
=head1 Class Methods
The following class method is available:
=head2 new
This class method is the constructor method for instantiating new
Mail::IMAPClient::BodyStructure objects. The B<new> method accepts
one argument, a string containing a server response to a FETCH
BODYSTRUCTURE directive.
The module B<Mail::IMAPClient> provides the B<get_bodystructure>
convenience method to simplify use of this module when starting with
just a messages sequence number or unique ID (UID).
=head1 Object Methods
The following object methods are available:
=head2 bodytype
The B<bodytype> object method requires no arguments. It returns the
bodytype for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodysubtype
The B<bodysubtype> object method requires no arguments. It returns the
bodysubtype for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyparms
The B<bodyparms> object method requires no arguments. It returns the
bodyparms for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodydisp
The B<bodydisp> object method requires no arguments. It returns the
bodydisp for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyid
The B<bodyid> object method requires no arguments. It returns the
bodyid for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodydesc
The B<bodydesc> object method requires no arguments. It returns the
bodydesc for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyenc
The B<bodyenc> object method requires no arguments. It returns the
bodyenc for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodysize
The B<bodysize> object method requires no arguments. It returns the
bodysize for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodylang
The B<bodylang> object method requires no arguments. It returns the
bodylang for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodystructure
The B<bodystructure> object method requires no arguments. It returns
the bodystructure for the message whose structure is described by the
calling B<Mail::IMAPClient::Bodystructure> object.
=head2 envelopestruct
The B<envelopestruct> object method requires no arguments. It returns
a B<Mail::IMAPClient::BodyStructure::Envelope> object for the message
from the calling B<Mail::IMAPClient::Bodystructure> object.
=head2 textlines
The B<textlines> object method requires no arguments. It returns the
textlines for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head1 Mail::IMAPClient::BodyStructure::Envelope
The IMAP standard specifies that output from the IMAP B<FETCH
ENVELOPE> command will be an RFC2060 envelope structure. It further
specifies that output from the B<FETCH BODYSTRUCTURE> command may also
contain embedded envelope structures (if, for example, a message's
subparts contain one or more included messages). Objects belonging to
B<Mail::IMAPClient::BodyStructure::Envelope> are Perl representations
of these envelope structures, which is to say the nested parenthetical
lists of RFC2060 translated into a Perl datastructure.
Note that all of the fields relate to the specific part to which they
belong. In other words, output from a FETCH nnnn ENVELOPE command
(or, in B<Mail::IMAPClient>, C<$imap->fetch($msgid,"ENVELOPE")> or
C<my $env = $imap->get_envelope($msgid)>) are for the message, but
fields from within a bodystructure relate to the message subpart and
not the parent message.
An envelope structure's B<Mail::IMAPClient::BodyStructure::Envelope>
representation is a hash of thingies that looks like this:
{
subject => "subject",
inreplyto => "reference_message_id",
from => [ addressStruct1 ],
messageid => "message_id",
bcc => [ addressStruct1, addressStruct2 ],
date => "Tue, 09 Jul 2002 14:15:53 -0400",
replyto => [ adressStruct1, addressStruct2 ],
to => [ adressStruct1, addressStruct2 ],
sender => [ adressStruct1 ],
cc => [ adressStruct1, addressStruct2 ],
}
The B<...::Envelope> object also has methods for accessing data in the
structure. They are:
=over 4
=item date
Returns the date of the message.
=item inreplyto
Returns the message id of the message to which this message is a reply.
=item subject
Returns the subject of the message.
=item messageid
Returns the message id of the message.
=back
You can also use the following methods to get addressing information.
Each of these methods returns an array of
B<Mail::IMAPClient::BodyStructure::Address> objects, which are perl
data structures representing RFC2060 address structures. Some of
these arrays would naturally contain one element (such as B<from>,
which normally contains a single "From:" address); others will often
contain more than one address. However, because RFC2060 defines all
of these as "lists of address structures", they are all translated
into arrays of B<...::Address> objects.
See the section on B<Mail::IMAPClient::BodyStructure::Address>, below,
for alternate (and preferred) ways of accessing these data.
The methods available are:
=over 4
=item bcc
Returns an array of blind cc'ed recipients' address structures.
(Don't expect much in here unless the message was sent from the
mailbox you're poking around in, by the way.)
=item cc
Returns an array of cc'ed recipients' address structures.
=item from
Returns an array of "From:" address structures--usually just one.
=item replyto
Returns an array of "Reply-to:" address structures. Once again there
is usually just one address in the list.
=item sender
Returns an array of senders' address structures--usually just one and
usually the same as B<from>.
=item to
Returns an array of recipients' address structures.
=back
Each of the methods that returns a list of address structures (i.e. a
list of B<Mail::IMAPClient::BodyStructure::Address> arrays) also has
an analogous method that will return a list of E-Mail addresses
instead. The addresses are in the format C<personalname
E<lt>mailboxname@hostnameE<gt>> (see the section on
B<Mail::IMAPClient::BodyStructure::Address>, below) However, if the
personal name is 'NIL' then it is omitted from the address.
These methods are:
=over 4
=item bcc_addresses
Returns a list (or an array reference if called in scalar context) of
blind cc'ed recipients' email addresses. (Don't expect much in here
unless the message was sent from the mailbox you're poking around in,
by the way.)
=item cc_addresses
Returns a list of cc'ed recipients' email addresses. If called in a
scalar context it returns a reference to an array of email addresses.
=item from_addresses
Returns a list of "From:" email addresses. If called in a scalar
context it returns the first email address in the list. (It's usually
a list of just one anyway.)
=item replyto_addresses
Returns a list of "Reply-to:" email addresses. If called in a scalar
context it returns the first email address in the list.
=item sender_addresses
Returns a list of senders' email addresses. If called in a scalar
context it returns the first email address in the list.
=item to_addresses
Returns a list of recipients' email addresses. If called in a scalar
context it returns a reference to an array of email addresses.
=back
Note that context affects the behavior of all of the above methods.
Those fields that will commonly contain multiple entries (i.e. they
are recipients) will return an array reference when called in scalar
context. You can use this behavior to optimize performance.
Those fields that will commonly contain just one address (the
sender's) will return the first (and usually only) address. You can
use this behavior to optimize your development time.
=head1 Addresses and the Mail::IMAPClient::BodyStructure::Address
Several components of an envelope structure are address structures.
They are each parsed into their own object,
B<Mail::IMAPClient::BodyStructure::Address>, which looks like this:
{
mailboxname => 'somebody.special',
hostname => 'somplace.weird.com'
personalname => 'Somebody Special
sourceroute => 'NIL'
}
RFC2060 specifies that each address component of a bodystructure is a
list of address structures, so B<Mail::IMAPClient::BodyStructure>
parses each of these into an array of
B<Mail::IMAPClient::BodyStructure::Address> objects.
Each of these objects has the following methods available to it:
=over 4
=item mailboxname
Returns the "mailboxname" portion of the address, which is the part to
the left of the '@' sign.
=item hostname
Returns the "hostname" portion of the address, which is the part to
the right of the '@' sign.
=item personalname
Returns the "personalname" portion of the address, which is the part
of the address that's treated like a comment.
=item sourceroute
Returns the "sourceroute" portion of the address, which is typically "NIL".
=back
Taken together, the parts of an address structure form an address that
will look something like this:
C<personalname E<lt>mailboxname@hostnameE<gt>>
Note that because the B<Mail::IMAPClient::BodyStructure::Address>
objects come in arrays, it's generally easier to use the methods
available to B<Mail::IMAPClient::BodyStructure::Envelope> to obtain
all of the addresses in a particular array in one operation. These
methods are provided, however, in case you'd rather do things the hard
way. (And also because the aforementioned methods from
B<Mail::IMAPClient::BodyStructure::Envelope> need them anyway.)
=cut
=head1 AUTHOR
Original author: David J. Kernen; Reworked by: Mark Overmeer;
Maintained by Phil Pearl.
=head1 SEE ALSO
perl(1), Mail::IMAPClient, Parse::RecDescent, and RFC2060.
=cut

189
W/Mail-IMAPClient-3.40/lib/Mail/IMAPClient/BodyStructure/Parse.grammar Normal file
View File

@ -0,0 +1,189 @@
# Directives
# ( none)
# Start-up Actions
{
my $mibs = "Mail::IMAPClient::BodyStructure";
my $subpartCount = 0;
my $partCount = 0;
sub take_optional_items($$@)
{ my ($r, $items) = (shift, shift);
foreach (@_)
{ my $opt = $_ .'(?)';
exists $items->{$opt} or next;
$r->{$_} = UNIVERSAL::isa($items->{$opt}, 'ARRAY')
? $items->{$opt}[0] : $items->{$opt};
}
}
sub merge_hash($$)
{ my $to = shift;
my $from = shift or return;
while( my($k,$v) = each %$from) { $to->{$k} = $v }
}
}
# Atoms
TEXT: /^"TEXT"|^TEXT/i { $return = "TEXT" }
PLAIN: /^"PLAIN"|^PLAIN/i { $return = "PLAIN" }
HTML: /"HTML"|HTML/i { $return = "HTML" }
MESSAGE: /^"MESSAGE"|^MESSAGE/i { $return = "MESSAGE"}
RFC822: /^"RFC822"|^RFC822/i { $return = "RFC822" }
NIL: /^NIL/i { $return = "NIL" }
RFCNONCOMPLY: /^\(\)/i { $return = "NIL" }
NUMBER: /^(\d+)/ { $return = $item[1] }
# Strings:
SINGLE_QUOTED_STRING: "'" /(?:\\['\\]|[^'])*/ "'" { $return = $item{__PATTERN1__} }
DOUBLE_QUOTED_STRING: '"' /(?:\\["\\]|[^"])*/ '"' { $return = $item{__PATTERN1__} }
BARESTRING: ...!/^[)('"]/ /^(?!\(|\))(?:\\ |\S)+/
{ $return = $item{__PATTERN1__} }
STRING: DOUBLE_QUOTED_STRING | SINGLE_QUOTED_STRING | BARESTRING
STRINGS: "(" STRING(s) ")" { $return = $item{'STRING(s)'} }
textlines: NIL | NUMBER
rfc822message: MESSAGE RFC822 { $return = "MESSAGE RFC822" }
bodysubtype: PLAIN | HTML | NIL | STRING
key: STRING
value: NIL | NUMBER | STRING | KVPAIRS
kvpair: ...!")" key value
{ $return = { $item{key} => $item{value} } }
KVPAIRS: "(" kvpair(s) ")"
{ $return = { map { (%$_) } @{$item{'kvpair(s)'}} } }
bodytype: STRING
bodyparms: NIL | KVPAIRS
bodydisp: NIL | KVPAIRS
bodyid: ...!/[()]/ NIL | STRING
bodydesc: ...!/[()]/ NIL | STRING
bodysize: ...!/[()]/ NIL | NUMBER
bodyenc: NIL | STRING | KVPAIRS
bodyMD5: NIL | STRING
bodylang: NIL | STRING | STRINGS
bodyextra: NIL | STRING | STRINGS
bodyloc: NIL | STRING
personalname: NIL | STRING
sourceroute: NIL | STRING
mailboxname: NIL | STRING
hostname: NIL | STRING
addressstruct: "(" personalname sourceroute mailboxname hostname ")"
{ bless { personalname => $item{personalname}
, sourceroute => $item{sourceroute}
, mailboxname => $item{mailboxname}
, hostname => $item{hostname}
}, 'Mail::IMAPClient::BodyStructure::Address';
}
subject: NIL | STRING
inreplyto: NIL | STRING
messageid: NIL | STRING
date: NIL | STRING
ADDRESSES: NIL | RFCNONCOMPLY
| "(" addressstruct(s) ")" { $return = $item{'addressstruct(s)'} }
cc: ADDRESSES
bcc: ADDRESSES
from: ADDRESSES
replyto: ADDRESSES
sender: ADDRESSES
to: ADDRESSES
envelopestruct: "(" date subject from sender replyto to cc
bcc inreplyto messageid ")"
{ $return = bless {}, "Mail::IMAPClient::BodyStructure::Envelope";
$return->{$_} = $item{$_}
for qw/date subject from sender replyto to cc/
, qw/bcc inreplyto messageid/;
1;
}
basicfields: bodysubtype bodyparms(?) bodyid(?)
bodydesc(?) bodyenc(?) bodysize(?)
{ $return = { bodysubtype => $item{bodysubtype} };
take_optional_items($return, \%item,
qw/bodyparms bodyid bodydesc bodyenc bodysize/);
1;
}
textmessage: TEXT <commit> basicfields textlines(?) bodyMD5(?)
bodydisp(?) bodylang(?) bodyextra(?)
{
$return = $item{basicfields} || {};
$return->{bodytype} = 'TEXT';
take_optional_items($return, \%item
, qw/textlines bodyMD5 bodydisp bodylang bodyextra/);
1;
}
othertypemessage: bodytype basicfields bodyMD5(?) bodydisp(?)
bodylang(?) bodyextra(?)
{ $return = { bodytype => $item{bodytype} };
take_optional_items($return, \%item
, qw/bodyMD5 bodydisp bodylang bodyextra/ );
merge_hash($return, $item{basicfields});
1;
}
nestedmessage: rfc822message <commit> bodyparms bodyid bodydesc bodyenc
# bodysize envelopestruct bodystructure textlines
bodysize envelopestruct(?) bodystructure(?) textlines(?)
bodyMD5(?) bodydisp(?) bodylang(?) bodyextra(?)
{
$return = {};
$return->{$_} = $item{$_}
for qw/bodyparms bodyid bodydesc bodyenc bodysize/;
# envelopestruct bodystructure textlines/;
take_optional_items($return, \%item
, qw/envelopestruct bodystructure textlines/
, qw/bodyMD5 bodydisp bodylang bodyextra/);
merge_hash($return, $item{bodystructure}[0]);
merge_hash($return, $item{basicfields});
$return->{bodytype} = "MESSAGE" ;
$return->{bodysubtype} = "RFC822" ;
1;
}
multipart: subpart(s) <commit> bodysubtype
bodyparms(?) bodydisp(?) bodylang(?) bodyloc(?) bodyextra(?)
<defer: $subpartCount = 0>
{ $return =
{ bodysubtype => $item{bodysubtype}
, bodytype => 'MULTIPART'
, bodystructure => $item{'subpart(s)'}
};
take_optional_items($return, \%item
, qw/bodyparms bodydisp bodylang bodyloc bodyextra/);
1;
}
subpart: "(" part ")" {$return = $item{part}} <defer: ++$subpartCount;>
part: multipart { $return = bless $item{multipart}, $mibs }
| textmessage { $return = bless $item{textmessage}, $mibs }
| nestedmessage { $return = bless $item{nestedmessage}, $mibs }
| othertypemessage { $return = bless $item{othertypemessage}, $mibs }
bodystructure: "(" part(s) ")"
{ $return = $item{'part(s)'} }
start: /.*?\(.*?BODYSTRUCTURE \(/i part(1) /\).*\)\r?\n?/
{ $return = $item{'part(1)'}[0] }
envelope: /.*?\(.*?ENVELOPE/ envelopestruct /.*\)/
{ $return = $item{envelopestruct} }

17063
W/Mail-IMAPClient-3.40/lib/Mail/IMAPClient/BodyStructure/Parse.pm Normal file
View File

File diff suppressed because it is too large Load Diff

15
W/Mail-IMAPClient-3.40/lib/Mail/IMAPClient/BodyStructure/Parse.pod Normal file
View File

@ -0,0 +1,15 @@
=head1 NAME
Mail::IMAPClient::BodyStructure::Parse - used internally by Mail::IMAPClient::BodyStructure
=head1 DESCRIPTION
This module is used internally by L<Mail::IMAPClient::BodyStructure>
and is generated using L<Parse::RecDescent>. It is not meant to be used
directly by other scripts nor is there much point in debugging it.
=head1 SYNOPSIS
This module is used internally by L<Mail::IMAPClient::BodyStructure>
and is not meant to be used or called directly from applications. So
don't do that.

280
W/Mail-IMAPClient-3.40/lib/Mail/IMAPClient/MessageSet.pm Normal file
View File

@ -0,0 +1,280 @@
use warnings;
use strict;
package Mail::IMAPClient::MessageSet;
=head1 NAME
Mail::IMAPClient::MessageSet - ranges of message sequence numbers
=cut
use overload
'""' => "str"
, '.=' => sub {$_[0]->cat($_[1])}
, '+=' => sub {$_[0]->cat($_[1])}
, '-=' => sub {$_[0]->rem($_[1])}
, '@{}' => "unfold"
, fallback => 1;
sub new
{ my $class = shift;
my $range = $class->range(@_);
bless \$range, $class;
}
sub str { overload::StrVal( ${$_[0]} ) }
sub _unfold_range($)
# { my $x = shift; return if $x =~ m/[^0-9,:]$/; $x =~ s/\:/../g; eval $x; }
{ map { /(\d+)\s*\:\s*(\d+)/ ? ($1..$2) : $_ }
split /\,/, shift;
}
sub rem
{ my $self = shift;
my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_;
$$self = $self->range(grep {not $delete{$_}} $self->unfold);
$self;
}
sub cat
{ my $self = shift;
$$self = $self->range($$self, @_);
$self;
}
sub range
{ my $self = shift;
my @msgs;
foreach my $m (@_)
{ defined $m && length $m
or next;
foreach my $mm (ref $m eq 'ARRAY' ? @$m : $m)
{ push @msgs, _unfold_range $mm;
}
}
@msgs
or return undef;
@msgs = sort {$a <=> $b} @msgs;
my $low = my $high = shift @msgs;
my @ranges;
foreach my $m (@msgs)
{ next if $m == $high; # double
if($m == $high + 1) { $high = $m }
else
{ push @ranges, $low == $high ? $low : "$low:$high";
$low = $high = $m;
}
}
push @ranges, $low == $high ? $low : "$low:$high" ;
join ",", @ranges;
}
sub unfold
{ my $self = shift;
wantarray ? ( _unfold_range $$self ) : [ _unfold_range $$self ];
}
=head1 SYNOPSIS
my @msgs = $imap->search("SUBJECT","Virus"); # returns 1,3,4,5,6,9,10
my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
print $msgset; # prints "1,3:6,9:10"
# add message 14 to the set:
$msgset += 14;
print $msgset; # prints "1,3:6,9:10,14"
# add messages 16,17,18,19, and 20 to the set:
$msgset .= "16,17,18:20";
print $msgset; # prints "1,3:6,9:10,14,16:20"
# Hey, I didn't really want message 17 in there; let's take it out:
$msgset -= 17;
print $msgset; # prints "1,3:6,9:10,14,16,18:20"
# Now let's iterate over each message:
for my $msg (@$msgset)
{ print "$msg\n"; # Prints: "1\n3\n4\n5\n6..16\n18\n19\n20\n"
}
print join("\n", @$msgset)."\n"; # same simpler
local $" = "\n"; print "@$msgset\n"; # even more simple
=head1 DESCRIPTION
The B<Mail::IMAPClient::MessageSet> module is designed to make life easier
for programmers who need to manipulate potentially large sets of IMAP
message UID's or sequence numbers.
This module presents an object-oriented interface into handling your
message sets. The object reference returned by the L<new> method is an
overloaded reference to a scalar variable that contains the message set's
compact RFC2060 representation. The object is overloaded so that using
it like a string returns this compact message set representation. You
can also add messages to the set (using either a '.=' operator or a '+='
operator) or remove messages (with the '-=' operator). And if you use
it as an array reference, it will humor you and act like one by calling
L<unfold> for you.
RFC2060 specifies that multiple messages can be provided to certain IMAP
commands by separating them with commas. For example, "1,2,3,4,5" would
specify messages 1, 2, 3, 4, and (you guessed it!) 5. However, if you are
performing an operation on lots of messages, this string can get quite long.
So long that it may slow down your transaction, and perhaps even cause the
server to reject it. So RFC2060 also permits you to specify a range of
messages, so that messages 1, 2, 3, 4 and 5 can also be specified as
"1:5".
This is where B<Mail::IMAPClient::MessageSet> comes in. It will convert
your message set into the shortest correct syntax. This could potentially
save you tons of network I/O, as in the case where you want to fetch the
flags for all messages in a 10000 message folder, where the messages
are all numbered sequentially. Delimited as commas, and making the
best-case assumption that the first message is message "1", it would take
48893 bytes to specify the whole message set using the comma-delimited
method. To specify it as a range, it takes just seven bytes (1:10000).
Note that the L<Mail::IMAPClient> B<Range> method can be used as
a short-cut to specifying C<Mail::IMAPClient::MessageSet-E<gt>new(@etc)>.)
=head1 CLASS METHODS
The only class method you need to worry about is B<new>. And if you create
your B<Mail::IMAPClient::MessageSet> objects via L<Mail::IMAPClient>'s
B<Range> method then you don't even need to worry about B<new>.
=head2 new
Example:
my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
The B<new> method requires at least one argument. That argument can be
either a message, a comma-separated list of messages, a colon-separated
range of messages, or a combination of comma-separated messages and
colon-separated ranges. It can also be a reference to an array of messages,
comma-separated message lists, and colon separated ranges.
If more then one argument is supplied to B<new>, then those arguments should
be more message numbers, lists, and ranges (or references to arrays of them)
just as in the first argument.
The message numbers passed to B<new> can really be any kind of number at
all but to be useful in a L<Mail::IMAPClient> session they should be either
message UID's (if your I<Uid> parameter is true) or message sequence numbers.
The B<new> method will return a reference to a B<Mail::IMAPClient::MessageSet>
object. That object, when double quoted, will act just like a string whose
value is the message set expressed in the shortest possible way, with the
message numbers sorted in ascending order and with duplicates removed.
=head1 OBJECT METHODS
The only object method currently available to a B<Mail::IMAPClient::MessageSet>
object is the L<unfold> method.
=head2 unfold
Example:
my $msgset = $imap->Range( $imap->messages ) ;
my @all_messages = $msgset->unfold;
The B<unfold> method returns an array of messages that belong to the
message set. If called in a scalar context it returns a reference to the
array instead.
=head1 OVERRIDDEN OPERATIONS
B<Mail::IMAPClient::MessageSet> overrides a number of operators in order
to make manipulating your message sets easier. The overridden operations are:
=head2 stringify
Attempts to stringify a B<Mail::IMAPClient::MessageSet> object will result in
the compact message specification being returned, which is almost certainly
what you will want.
=head2 Auto-increment
Attempts to autoincrement a B<Mail::IMAPClient::MessageSet> object will
result in a message (or messages) being added to the object's message set.
Example:
$msgset += 34;
# Message #34 is now in the message set
=head2 Concatenate
Attempts to concatenate to a B<Mail::IMAPClient::MessageSet> object will
result in a message (or messages) being added to the object's message set.
Example:
$msgset .= "34,35,36,40:45";
# Messages 34,35,36,40,41,42,43,44,and 45 are now in the message set
The C<.=> operator and the C<+=> operator can be used interchangeably, but
as you can see by looking at the examples there are times when use of one
has an aesthetic advantage over use of the other.
=head2 Autodecrement
Attempts to autodecrement a B<Mail::IMAPClient::MessageSet> object will
result in a message being removed from the object's message set.
Examples:
$msgset -= 34;
# Message #34 is no longer in the message set
$msgset -= "1:10";
# Messages 1 through 10 are no longer in the message set
If you attempt to remove a message that was not in the original message set
then your resulting message set will be the same as the original, only more
expensive. However, if you attempt to remove several messages from the message
set and some of those messages were in the message set and some were not,
the additional overhead of checking for the messages that were not there
is negligible. In either case you get back the message set you want regardless
of whether it was already like that or not.
=head1 AUTHOR
David J. Kernen
The Kernen Consulting Group, Inc
=head1 COPYRIGHT
Copyright 1999, 2000, 2001, 2002 The Kernen Group, Inc.
All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the terms of either:
=over 4
=item a) the "Artistic License" which comes with this Kit, or
=item b) the GNU General Public License as published by the Free Software
Foundation; either version 1, or (at your option) any later version.
=back
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU
General Public License or the Artistic License for more details. All your
base are belong to us.
=cut
1;

18
W/Mail-IMAPClient-3.40/lib/Mail/IMAPClient/Thread.grammar Normal file
View File

@ -0,0 +1,18 @@
# Atoms:
NUMBER: /\d+/
# Rules:
threadmember: NUMBER { $return = $item{NUMBER} ; } |
thread { $return = $item{thread} ; }
thread: "(" threadmember(s) ")"
{
$return = $item{'threadmember(s)'}||undef;
}
# Start:
start: /^\* THREAD /i thread(s?) {
$return=$item{'thread(s?)'}||undef;
}

1039
W/Mail-IMAPClient-3.40/lib/Mail/IMAPClient/Thread.pm Normal file
View File

File diff suppressed because it is too large Load Diff

14
W/Mail-IMAPClient-3.40/lib/Mail/IMAPClient/Thread.pod Normal file
View File

@ -0,0 +1,14 @@
=head1 NAME
Mail::IMAPClient::Thread - used internally by Mail::IMAPClient->thread
=head1 DESCRIPTION
This module is used internally by L<Mail::IMAPClient> and is
generated using L<Parse::RecDescent>. It is not meant to be used directly by
other scripts nor is there much point in debugging it.
=head1 SYNOPSIS
This module is used internally by L<Mail::IMAPClient> and is not meant to
be used or called directly from applications. So don't do that.

43
W/Mail-IMAPClient-3.40/prepare_dist Executable file
View File

@ -0,0 +1,43 @@
#!/usr/bin/perl
use strict;
use warnings;
use File::Copy qw/move/;
use Parse::RecDescent 1.94;
sub read_file {
my $file = shift;
local ( $/, *FH );
open( FH, $file ) or return undef;
return <FH>;
}
build_parser(
'lib/Mail/IMAPClient/BodyStructure/Parse.grammar',
'Mail::IMAPClient::BodyStructure::Parse'
);
build_parser( 'lib/Mail/IMAPClient/Thread.grammar',
'Mail::IMAPClient::Thread' );
sub build_parser {
my ( $grammarfn, $package ) = @_;
print("* building $package\n");
my $grammar = read_file($grammarfn)
or die("cannot read grammar from $grammarfn: $!\n");
Parse::RecDescent->Precompile( $grammar, $package );
# clumpsy output by Parse::RecDescent
my $outfn = $package . '.pm';
$outfn =~ s/.*\:\://;
my $realfn = $grammarfn;
$realfn =~ s/\.\w+$/.pm/;
move( $outfn, $realfn )
or die("cannot move $outfn to $realfn: $!\n");
}

490
W/Mail-IMAPClient-3.40/t/basic.t Normal file
View File

@ -0,0 +1,490 @@
#!/usr/bin/perl
use strict;
use warnings;
use IO::File qw();
use Test::More;
use File::Temp qw(tempfile);
use lib "t/lib";
use MyTest;
my $params;
BEGIN {
eval { $params = MyTest->new; };
$@
? plan skip_all => $@
: plan tests => 107;
}
BEGIN { use_ok('Mail::IMAPClient') or exit; }
my $debug = $ARGV[0];
my $range = 0;
my $uidplus = 0;
my %new_args = (
Clear => 0,
Uid => $uidplus,
Debug => $debug,
);
# allow other options to be placed in test.txt
%new_args = ( %new_args, %${params} );
my $imap = Mail::IMAPClient->new(
%new_args,
Range => $range,
Debug_fh => ( $debug ? IO::File->new( 'imap1.debug', 'w' ) : undef ),
);
ok( defined $imap, 'created client' );
$imap
or die "Cannot log into $new_args{Server} as $new_args{User}.\n"
. "Are server/user/password correct?\n";
isa_ok( $imap, 'Mail::IMAPClient' );
{
my $type = ref $imap->Socket;
ok( $type =~ /^IO::Socket::.*/, "Socket ref is $type" );
}
$imap->Debug_fh->autoflush() if $imap->Debug_fh;
my $testmsg = <<__TEST_MSG;
Date: @{[$imap->Rfc822_date(time)]}
To: <$new_args{User}\@$new_args{Server}>
From: Perl <$new_args{User}\@$new_args{Server}>
Subject: Testing from pid $$
This is a test message generated by $0 during a 'make test' as part of
the installation of the Mail::IMAPClient module from CPAN.
__TEST_MSG
ok( $imap->noop, "noop" );
ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" );
my $sep = $imap->separator;
ok( defined $sep, "separator is '$sep'" );
{
my $list = $imap->list();
is( ref($list), "ARRAY", "list" );
my $lsub = $imap->lsub();
is( ref($lsub), "ARRAY", "lsub" );
}
my ( $target, $target2 );
{
my $ispar = $imap->is_parent('INBOX');
my $pre = $ispar ? "INBOX${sep}" : "";
( $target, $target2 ) = ( "${pre}IMAPClient_$$", "${pre}IMAPClient_2_$$" );
ok( defined $ispar, "INBOX is_parent '$ispar' (note: target '$target')" );
}
ok( $imap->select('inbox'), "select inbox" );
# folders
{
my @f = $imap->folders();
ok( @f, "folders" . ( $debug ? ":@f" : "" ) );
my @fh = $imap->folders_hash();
my @fh_keys = qw(attrs delim name);
ok( @fh, "folders_hash keys: @fh_keys" );
is_deeply(
[ sort keys %{ $fh[0] } ],
[ sort @fh_keys ],
"folders eq folders_hash"
);
}
# test append_file
my $append_file_size;
{
my ( $afh, $afn ) = tempfile UNLINK => 1;
# write message to autoflushed file handle since we keep $afh around
my $oldfh = select($afh);
$| = 1;
select($oldfh);
print( $afh $testmsg ) or die("print testmsg failed");
cmp_ok( -s $afn, '>', 0, "tempfile has size" );
ok( $imap->create($target), "create target" );
my $uid = $imap->append_file( $target, $afn );
ok( defined $uid, "append_file test message to $target" );
ok( $imap->select($target), "select $target" );
my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0];
my $size = $imap->size($msg);
cmp_ok( $size, '>', 0, "has size $size" );
my $string = $imap->message_string($msg);
ok( defined $string, "returned string" );
cmp_ok( length($string), '==', $size, "string matches server size" );
# dovecot may disconnect client if deleting selected folder
ok( $imap->select("INBOX"), "select INBOX" );
ok( $imap->delete($target), "delete folder $target" );
$append_file_size = $size;
}
# rt.cpan.org#91912: selectable test for /NoSelect
{
my $targetno = $target . "_noselect";
my $targetsubf = $targetno . "${sep}subfolder";
ok( $imap->create($targetsubf), "create target subfolder" );
ok( !$imap->selectable($targetno),
"not selectable (non-mailbox w/inferior)" );
ok( $imap->delete($targetsubf), "delete target subfolder" );
ok( $imap->delete($targetno), "delete parent folder" );
}
ok( $imap->create($target), "create target" );
ok( $imap->select($target), "select $target" );
# Test append / append_string if we also have UID capability
SKIP: {
skip "UIDPLUS not supported", 3 unless $imap->has_capability("UIDPLUS");
my $ouid = $imap->Uid();
$imap->Uid(1);
# test with date that has a leading space
my $d = " 1-Jan-2011 01:02:03 -0500";
my $uid = $imap->append_string( $target, $testmsg, undef, $d );
ok( defined $uid, "append test message to $target with date (uid=$uid)" );
# hash results do not have UID unless requested
my $h1 = $imap->fetch_hash( $uid, "RFC822.SIZE" );
is( ref($h1), "HASH", "fetch_hash($uid,RFC822.SIZE)" );
is( scalar keys %$h1, 1, "fetch_hash: fetched one msg (as requested)" );
is( !exists $h1->{$uid}->{UID}, 1, "fetch_hash: no UID (not requested)" );
$h1 = $imap->fetch_hash( $uid, "UID RFC822.SIZE" );
is( exists $h1->{$uid}->{UID}, 1, "fetch_hash: has UID (as requested)" );
ok( $imap->delete_message($uid), "delete_message $uid" );
ok( $imap->uidexpunge($uid), "uidexpunge $uid" );
=begin comment
my $ol = $imap->Maxcommandlength();
$imap->Maxcommandlength(64);
my $exp = $imap->uidexpunge($uid . "," . join(",", map{$_*2} 2..40) );
$imap->Maxcommandlength($ol);
is( $exp->[0], $imap->Count . " UID EXPUNGE $uid", "UID EXPUNGE $uid" );
is( grep( /^\* $uid EXPUNGE/, @$exp ), !undef, "found EXPUNGE response" );
=cut
# multiple args joined internally in append()
$uid = $imap->append( $target, $testmsg, "Some extra text too" );
ok( defined $uid, "append test message to $target with date (uid=$uid)" );
ok( $imap->delete_message($uid), "delete_message $uid" );
ok( $imap->uidexpunge($uid), "uidexpunge $uid" );
$imap->Uid($ouid);
}
# test append
{
my $uid = $imap->append( $target, $testmsg );
ok( defined $uid, "append test message to $target" );
my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0];
my $size = $imap->size($msg);
cmp_ok( $size, '>', 0, "has size $size" );
my $string = $imap->message_string($msg);
ok( defined $string, "returned string" );
cmp_ok( length($string), '==', $size, "string == server size" );
{
my $var;
ok( $imap->message_to_file( \$var, $msg ), "to SCALAR ref" );
cmp_ok( length($var), '==', $size, "correct size" );
my ( $fh, $fn ) = tempfile UNLINK => 1;
ok( $imap->message_to_file( $fn, $msg ), "to file $fn" );
cmp_ok( -s $fn, '==', $size, "correct size" );
}
cmp_ok( $size, '==', $append_file_size, "size matches string/file" );
# save first message/folder for use below...
#OFF ok( $imap->delete($target), "delete folder $target" );
}
#OFF ok( $imap->create($target), "create target" );
ok( $imap->exists($target), "exists $target" );
ok( $imap->create($target2), "create $target2" );
ok( $imap->exists($target2), "exists $target2" );
is( defined $imap->is_parent($sep), 1, "is_parent($sep)" );
is( !$imap->is_parent($target2), 1, "is_parent($target2)" );
{
ok( $imap->subscribe($target), "subscribe $target" );
my $sub1 = $imap->subscribed();
is( ( grep( /^\Q$target\E$/, @$sub1 ) )[0], "$target", "subscribed" );
ok( $imap->unsubscribe($target), "unsubscribe target" );
my $sub2 = $imap->subscribed();
is( ( grep( /^\Q$target\E$/, @$sub2 ) )[0], undef, "unsubscribed" );
}
my $fwquotes = qq($target has "quotes");
if ( $imap->create($fwquotes) ) {
ok( 1, "create '$fwquotes'" );
ok( $imap->select($fwquotes), "select '$fwquotes'" );
ok( $imap->close, "close '$fwquotes'" );
$imap->select('inbox');
ok( $imap->delete($fwquotes), "delete '$fwquotes'" );
}
else {
my $err = $imap->LastError || "(no error)";
ok( 1, "failed creation with quotes, assume not supported: $err" );
ok( 1, "skipping 1/3 tests" );
ok( 1, "skipping 2/3 tests" );
ok( 1, "skipping 3/3 tests" );
}
ok( $imap->select($target), "select $target" );
my $fields = $imap->search( "HEADER", "Message-id", "NOT_A_MESSAGE_ID" );
is( scalar @$fields, 0, 'bogus message id does not exist' );
my @seen = $imap->seen;
cmp_ok( scalar @seen, '==', 1, 'have seen 1' );
ok( $imap->deny_seeing( \@seen ), 'deny seeing' );
my @unseen = $imap->unseen;
cmp_ok( scalar @unseen, '==', 1, 'have unseen 1' );
ok( $imap->see( \@seen ), "let's see one" );
cmp_ok( scalar @seen, '==', 1, 'have seen 1' );
$imap->deny_seeing(@seen); # reset
$imap->Peek(1);
my $subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0];
unlike( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==1' );
$imap->deny_seeing(@seen);
$imap->Peek(0);
$subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0];
like( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==0' );
$imap->deny_seeing(@seen);
$imap->Peek(undef);
$subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0];
unlike( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==undef' );
my $uid2 = $imap->copy( $target2, 1 );
ok( $uid2, "copy $target2" );
my @res = $imap->fetch( 1, "RFC822.TEXT" );
ok( scalar @res, "fetch rfc822" );
{
my $h1 = $imap->fetch_hash("RFC822.SIZE");
is( ref($h1), "HASH", "fetch_hash(RFC822.SIZE)" );
my $id = ( sort { $a <=> $b } keys %$h1 )[0];
my $h2 = $imap->fetch_hash( $id, "RFC822.SIZE" );
is( ref($h2), "HASH", "fetch_hash($id,RFC822.SIZE)" );
is( scalar keys %$h2, 1, "fetch_hash($id,RFC822.SIZE) => fetched one msg" );
}
{
my $seq = "1:*";
my @dat = (qw(RFC822.SIZE INTERNALDATE));
my $h1 = $imap->fetch_hash( $seq, @dat );
is( ref($h1), "HASH", "fetch_hash($seq, " . join( ", ", @dat ) . ")" );
# verify legacy and less desirable use case still works
my $h2 = $imap->fetch_hash("$seq @dat");
is( ref($h2), "HASH", "fetch_hash('$seq @dat')" );
is_deeply( $h1, $h2, "fetch_hash same result with array or string args" );
}
my $h = $imap->parse_headers( 1, "Subject" );
ok( $h, "got subject" );
like( $h->{Subject}[0], qr/^Testing from pid/, "subject matched" );
ok( $imap->select($target), "select $target" );
my @hits = $imap->search( SUBJECT => 'Testing' );
cmp_ok( scalar @hits, '==', 1, 'hit subject Testing' );
ok( defined $hits[0], "subject is defined" );
ok( $imap->delete_message(@hits), 'delete hits' );
my $flaghash = $imap->flags( \@hits );
my $flagflag = 0;
foreach my $v ( values %$flaghash ) {
$flagflag += grep /\\Deleted/, @$v;
}
cmp_ok( $flagflag, '==', scalar @hits, "delete verified" );
my @nohits = $imap->search( \qq(SUBJECT "Productioning") );
cmp_ok( scalar @nohits, '==', 0, 'no hits expected' );
ok( $imap->restore_message(@hits), 'restore messages' );
$flaghash = $imap->flags( \@hits );
foreach my $v ( values %$flaghash ) {
$flagflag-- unless grep /\\Deleted/, @$v;
}
cmp_ok( $flagflag, '==', 0, "restore verified" );
$imap->select($target2);
ok(
$imap->delete_message( scalar( $imap->search("ALL") ) )
&& $imap->close
&& $imap->delete($target2),
"delete $target2"
);
$imap->select("INBOX");
$@ = undef;
@hits =
$imap->search( BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED" );
ok( !$@, "search undeleted" ) or diag( '$@:' . $@ );
#
# Test migrate method
#
my $im2 = Mail::IMAPClient->new(
%new_args,
Timeout => 30,
Debug_fh => ( $debug ? IO::File->new(">./imap2.debug") : undef ),
);
ok( defined $im2, 'started second imap client' );
my $source = $target;
$imap->select($source)
or die "cannot select source $source: $@";
$imap->append( $source, $testmsg ) for 1 .. 5;
$imap->close;
$imap->select($source);
my $migtarget = $target . '_mirror';
$im2->create($migtarget)
or die "can't create $migtarget: $@";
$im2->select($migtarget)
or die "can't select $migtarget: $@";
$imap->migrate( $im2, scalar( $imap->search("ALL") ), $migtarget )
or die "couldn't migrate: $@";
$im2->close;
$im2->select($migtarget)
or die "can't select $migtarget: $@";
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
#
my $total_bytes1 = 0;
for ( $imap->search("ALL") ) {
my $s = $imap->size($_);
$total_bytes1 += $s;
print "Size of msg $_ is $s\n" if $debug;
}
my $total_bytes2 = 0;
for ( $im2->search("ALL") ) {
my $s = $im2->size($_);
$total_bytes2 += $s;
print "Size of msg $_ is $s\n" if $debug;
}
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
cmp_ok( $total_bytes1, '==', $total_bytes2, 'size source==target' );
# cleanup
$im2->select($migtarget);
$im2->delete_message( @{ $im2->messages } )
if $im2->message_count;
ok( $im2->close, "close" );
$im2->delete($migtarget);
ok_relaxed_logout($im2);
# Test IDLE
SKIP: {
skip "IDLE not supported", 4 unless $imap->has_capability("IDLE");
ok( my $idle = $imap->idle, "idle" );
sleep 1;
ok( $imap->idle_data, "idle_data" );
ok( $imap->done($idle), "done" );
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
}
$imap->select('inbox');
if ( $imap->rename( $target, "${target}NEW" ) ) {
ok( 1, 'rename' );
$imap->close;
$imap->select("${target}NEW");
$imap->delete_message( @{ $imap->messages } ) if $imap->message_count;
$imap->close;
$imap->delete("${target}NEW");
}
else {
ok( 0, 'rename failed' );
$imap->delete_message( @{ $imap->messages } )
if $imap->message_count;
$imap->close;
$imap->delete($target);
}
{
$imap->select('inbox');
my $bogusf = $imap->flags(42);
is( $bogusf, undef, '(scalar) flags returns undef for bogus message' );
my @bogusf = $imap->flags(42);
is( $bogusf[0], undef, '(list) flags returns array with undef element 0 for bogus message' );
}
$imap->_disconnect;
ok( $imap->reconnect, "reconnect" );
ok_relaxed_logout($imap);
# STARTTLS - an optional feature
if ( $imap->_load_module("SSL") ) {
$imap->connect( Ssl => 0, Starttls => 1 );
ok( 1, "OPTIONAL connect(Starttls=>1)" . ( $@ ? ": (error) $@ " : "" ) );
}
else {
ok( 1, "skipping optional STARTTLS test" );
}
# LOGOUT
# - on successful LOGOUT $code is OK (not BYE!) see RFC 3501 sect 7.1.5
# however some servers return BYE instead so we let that pass here...
sub ok_relaxed_logout {
my $imap = shift;
local ($@);
my $rc = $imap->logout;
my $err = $imap->LastError || "";
ok( ( $rc or $err =~ /^\* BYE/ ), "logout" . ( $err ? ": $err" : "" ) );
}

76
W/Mail-IMAPClient-3.40/t/body_string.t Normal file
View File

@ -0,0 +1,76 @@
#!/usr/bin/perl
#
# tests for body_string()
#
# body_string() calls fetch() internally. rather than refactor
# body_string() just for testing, we subclass M::IC and use the
# overidden fetch() to feed it test data.
use strict;
use warnings;
use IO::Socket qw(:crlf);
use Test::More tests => 3;
BEGIN { use_ok('Mail::IMAPClient') or exit; }
my @tests = (
[
"simple fetch",
[
'12 FETCH 1 BODY[TEXT]',
'* 1 FETCH (FLAGS (\\Seen \\Recent) BODY[TEXT]',
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
")$CRLF",
"12 OK Fetch completed.$CRLF",
],
[ 1 ],
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
],
# 2010-05-27: test for bug reported by Heiko Schlittermann
[
"uwimap IMAP4rev1 2007b.404 fetch unseen",
[
'4 FETCH 1 BODY[TEXT]',
'* 1 FETCH (BODY[TEXT]',
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
")$CRLF",
"* 1 FETCH (FLAGS (\\Recent \\Seen)$CRLF",
"4 OK Fetch completed$CRLF",
],
[ 1 ],
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
],
);
package Test::Mail::IMAPClient;
use base qw(Mail::IMAPClient);
sub new {
my ( $class, %args ) = @_;
my %me = %args;
return bless \%me, $class;
}
sub fetch {
my ( $self, @args ) = @_;
return $self->{_next_fetch_response} || [];
}
package main;
sub run_tests {
my ( $imap, $tests ) = @_;
for my $test (@$tests) {
my ( $comment, $fetch, $request, $response ) = @$test;
$imap->{_next_fetch_response} = $fetch;
my $r = $imap->body_string(@$request);
is_deeply( $r, $response, $comment );
}
}
my $imap = Test::Mail::IMAPClient->new( Uid => 0, Debug => 0 );
run_tests( $imap, \@tests );

172
W/Mail-IMAPClient-3.40/t/bodystructure.t Normal file
View File

File diff suppressed because one or more lines are too long

317
W/Mail-IMAPClient-3.40/t/fetch_hash.t Normal file
View File

@ -0,0 +1,317 @@
#!/usr/bin/perl
#
# tests for fetch_hash()
#
# fetch_hash() calls fetch() internally. rather than refactor
# fetch_hash() just for testing, we instead subclass M::IC and use the
# overidden fetch() to feed it test data.
use strict;
use warnings;
use Test::More tests => 27;
BEGIN { use_ok('Mail::IMAPClient') or exit; }
my @tests = (
[
"unquoted value",
[ q{* 1 FETCH (UNQUOTED foobar)}, ],
[ [1], qw(UNQUOTED) ],
{ "1" => { "UNQUOTED" => q{foobar}, } },
],
[
"quoted value",
[ q{* 1 FETCH (QUOTED "foo bar baz")}, ],
[ [1], qw(QUOTED) ],
{ "1" => { "QUOTED" => q{foo bar baz}, }, },
],
[
"escaped-backslash before end-quote",
[ q{* 1 FETCH (QUOTED "foo bar baz\\\\")}, ],
[ [1], qw(QUOTED) ],
{ "1" => { "QUOTED" => q{foo bar baz\\\\}, }, },
],
[
"parenthesized value",
[ q{* 1 FETCH (PARENS (foo bar))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo bar}, }, },
],
[
"parenthesized value with quotes",
[ q{* 1 FETCH (PARENS (foo "bar" baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo "bar" baz}, }, },
],
[
"parenthesized value with parens at start",
[ q{* 1 FETCH (PARENS ((foo) bar baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{(foo) bar baz}, }, },
],
[
"parenthesized value with parens in middle",
[ q{* 1 FETCH (PARENS (foo (bar) baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo (bar) baz}, }, },
],
[
"parenthesized value with parens at end",
[ q{* 1 FETCH (PARENS (foo bar (baz)))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo bar (baz)}, }, },
],
[
"parenthesized value with quoted parentheses",
[ q{* 1 FETCH (PARENS (foo "(bar)" baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo "(bar)" baz}, }, },
],
[
"parenthesized value with quoted unclosed parentheses",
[ q{* 1 FETCH (PARENS (foo "(bar" baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo "(bar" baz}, }, },
],
[
"parenthesized value with quoted unopened parentheses",
[ q{* 1 FETCH (PARENS (foo "bar)" baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo "bar)" baz}, }, },
],
[
"complex parens",
[ q{* 1 FETCH (PARENS ((((foo) "bar") baz (quux))))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{(((foo) "bar") baz (quux))}, }, },
],
[
"basic literal value",
[ q{* 1 FETCH (LITERAL}, q{foo}, q{)}, ],
[ [1], qw(LITERAL) ],
{ "1" => { "LITERAL" => q{foo}, }, },
],
[
"multiline literal value",
[ q{* 1 FETCH (LITERAL}, q{foo\r\nbar\r\nbaz\r\n}, q{)}, ],
[ [1], qw(LITERAL) ],
{ "1" => { "LITERAL" => q{foo\r\nbar\r\nbaz\r\n}, }, },
],
[
"multiple attributes",
[ q{* 1 FETCH (FOO foo BAR bar BAZ baz)}, ],
[ [1], qw(FOO BAR BAZ) ],
{
"1" => {
"FOO" => q{foo},
"BAR" => q{bar},
"BAZ" => q{baz},
},
},
],
[
"dotted attribute",
[ q{* 1 FETCH (FOO.BAR foobar)}, ],
[ [1], qw(FOO.BAR) ],
{ "1" => { "FOO.BAR" => q{foobar}, }, },
],
[
"complex attribute",
[ q{* 1 FETCH (FOO.BAR[BAZ (QUUX)] quuz)}, ],
[ [1], q{FOO.BAR[BAZ (QUUX)]} ],
{ "1" => { q{FOO.BAR[BAZ (QUUX)]} => q{quuz}, }, },
],
[
"BODY.PEEK[] requests match BODY[] responses",
[q{* 1 FETCH (BODY[] foo)}],
[ [1], qw(BODY.PEEK[]) ],
{ "1" => { "BODY[]" => q{foo}, }, },
],
[
"BODY.PEEK[] requests match BODY.PEEK[] responses also",
[q{* 1 FETCH (BODY.PEEK[] foo)}],
[ [1], qw(BODY.PEEK[]) ],
{ "1" => { "BODY.PEEK[]" => q{foo}, }, },
],
[
"BODY[]<0.1024> requests match BODY[]<0> responses",
[ q{* 1 FETCH (BODY[]<0>}, q{foo}, ")\r\n" ],
[ [1], qw(BODY[]<0.1024>) ],
{ "1" => { "BODY[]<0>" => q{foo}, }, },
],
[
"BODY.PEEK[]<0.1024> requests match BODY[]<0> responses",
[ q{* 1 FETCH (BODY[]<0>}, q{foo}, ")\r\n" ],
[ [1], qw(BODY.PEEK[]<0.1024>) ],
{ "1" => { "BODY[]<0>" => q{foo}, }, },
],
[
"non-escaped BODY[HEADER.FIELDS (...)]",
[
q{* 1 FETCH (FLAGS () BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]},
'From: Phil Pearl (Lobbes) <phil+from@perkpartners.com>
To: phil+to@perkpartners.com
Subject: foo "bar\" (baz\)
Date: Sat, 22 Jan 2011 20:43:58 -0500
'
],
[ [1], ( qw(FLAGS), 'BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]' ) ],
{
'1' => {
'BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]' =>
'From: Phil Pearl (Lobbes) <phil+from@perkpartners.com>
To: phil+to@perkpartners.com
Subject: foo "bar\" (baz\)
Date: Sat, 22 Jan 2011 20:43:58 -0500
',
'FLAGS' => '',
},
},
],
);
my @uid_tests = (
[
"uid enabled",
[ q{* 1 FETCH (UID 123 UNQUOTED foobar)}, ],
[ [123], qw(UNQUOTED) ],
{ "123" => { "UNQUOTED" => q{foobar}, } },
],
[
"ENVELOPE with escaped-backslash before end-quote",
[ q{* 1 FETCH (UID 1 FLAGS (\Seen) ENVELOPE ("Fri, 28 Jan 2011 00:03:30 -0500" "Subject" (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken Backslash\\\\" NIL "ken.bl" "dom.loc")) NIL NIL NIL "<msgid>")) } ],
[ [1], qw(UID FLAGS ENVELOPE) ],
{
"1" => {
'UID' => '1',
'FLAGS' => '\\Seen',
'ENVELOPE' =>
q{"Fri, 28 Jan 2011 00:03:30 -0500" "Subject" (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken Backslash\\\\" NIL "ken.bl" "dom.loc")) NIL NIL NIL "<msgid>"}
},
},
],
[
"escaped ENVELOPE subject",
[
q{* 1 FETCH (UID 1 X-SAVEDATE "28-Jan-2011 16:52:31 -0500" FLAGS (\Seen) ENVELOPE ("Fri, 28 Jan 2011 00:03:30 -0500"},
q{foo "bar\\" (baz\\)},
q{ (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>")) }
],
[ [1], qw(UID X-SAVEDATE FLAGS ENVELOPE) ],
{
"1" => {
'X-SAVEDATE' => '28-Jan-2011 16:52:31 -0500',
'UID' => '1',
'FLAGS' => '\\Seen',
'ENVELOPE' =>
q{"Fri, 28 Jan 2011 00:03:30 -0500" "foo \\"bar\\\\\\" (baz\\\\)" (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>"}
},
},
],
[
"real life example",
[
'* 1 FETCH (UID 541 FLAGS (\\Seen) INTERNALDATE "15-Sep-2009 20:05:45 +1000" RFC822.SIZE 771 BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]',
'Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
',
' BODY[]',
'Return-Path: <rob@pyro>
Delivered-To: rob@pyro
Received: from pyro (pyro [127.0.0.1])
by pyro.home (Postfix) with ESMTP id A5C8115A066
for <rob@pyro>; Tue, 15 Sep 2009 20:05:45 +1000 (EST)
Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks
Message-Id: <20090915100545.A5C8115A066@pyro.home>
Lines: 1
This is a test mailing
',
')
',
],
[
[1],
q{BODY.PEEK[HEADER.FIELDS (To From Date Subject)]},
qw(FLAGS INTERNALDATE RFC822.SIZE BODY[])
],
{
"541" => {
'BODY[]' => 'Return-Path: <rob@pyro>
Delivered-To: rob@pyro
Received: from pyro (pyro [127.0.0.1])
by pyro.home (Postfix) with ESMTP id A5C8115A066
for <rob@pyro>; Tue, 15 Sep 2009 20:05:45 +1000 (EST)
Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks
Message-Id: <20090915100545.A5C8115A066@pyro.home>
Lines: 1
This is a test mailing
',
'INTERNALDATE' => '15-Sep-2009 20:05:45 +1000',
'FLAGS' => '\\Seen',
'BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]' =>
'Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
',
'RFC822.SIZE' => '771',
},
},
],
);
package Test::Mail::IMAPClient;
use vars qw(@ISA);
@ISA = qw(Mail::IMAPClient);
sub new {
my ( $class, %args ) = @_;
my %me = %args;
return bless \%me, $class;
}
sub fetch {
my ( $self, @args ) = @_;
return $self->{_next_fetch_response} || [];
}
sub Escaped_results {
my ( $self, @args ) = @_;
return $self->{_next_fetch_response} || [];
}
package main;
sub run_tests {
my ( $imap, $tests ) = @_;
for my $test (@$tests) {
my ( $comment, $fetch, $request, $expect ) = @$test;
$imap->{_next_fetch_response} = $fetch;
my $r = $imap->fetch_hash(@$request);
is_deeply( $r, $expect, $comment );
}
}
my $imap = Test::Mail::IMAPClient->new( Uid => 0 );
run_tests( $imap, \@tests );
$imap->Uid(1);
run_tests( $imap, \@uid_tests );

35
W/Mail-IMAPClient-3.40/t/lib/MyTest.pm Normal file
View File

@ -0,0 +1,35 @@
package MyTest;
use strict;
use warnings;
my $infile = "test.txt";
sub new {
my ($class) = @_;
my %self;
open( my $fh, "<", $infile )
or die("test parameters not provided in $infile\n");
my %argmap = ( passed => "Password", authmech => "Authmechanism" );
while ( my $l = <$fh> ) {
chomp $l;
next if $l =~ /^\s*#/;
my ( $p, $v ) = split( /=/, $l, 2 );
s/^\s+//, s/\s+$// for $p, $v;
$p = $argmap{$p} if $argmap{$p};
$self{ ucfirst($p) } = $v if defined $v;
}
close($fh);
my @missing;
foreach my $p (qw/Server User Password/) {
push( @missing, $p ) unless defined $self{$p};
}
die("missing value for: @missing") if (@missing);
return \%self;
}
1;

37
W/Mail-IMAPClient-3.40/t/messageset.t Normal file
View File

@ -0,0 +1,37 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 7;
BEGIN { use_ok('Mail::IMAPClient::MessageSet') or exit; }
my $one = q/1:4,3:6,10:15,20:25,2:8/;
my $range = Mail::IMAPClient::MessageSet->new($one);
is( $range, "1:8,10:15,20:25", 'range simplify' );
is(
join( ",", $range->unfold ),
"1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25",
'range unfold'
);
$range .= "30,31,32,31:34,40:44";
is( $range, "1:8,10:15,20:25,30:34,40:44", 'overload concat' );
is(
join( ",", $range->unfold ),
"1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25,"
. "30,31,32,33,34,40,41,42,43,44",
'unfold extended'
);
$range -= "1:2";
is( $range, "3:8,10:15,20:25,30:34,40:44", 'overload subtract' );
is(
join( ",", $range->unfold ),
"3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25,"
. "30,31,32,33,34,40,41,42,43,44",
'subtract unfold'
);

10
W/Mail-IMAPClient-3.40/t/pod.t Normal file
View File

@ -0,0 +1,10 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok();

45
W/Mail-IMAPClient-3.40/t/quota.t Normal file
View File

@ -0,0 +1,45 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use lib "t/lib";
use MyTest;
my $params;
BEGIN {
eval { $params = MyTest->new; };
$@
? plan skip_all => $@
: plan tests => 7;
}
BEGIN { use_ok('Mail::IMAPClient') or exit; }
my %args = ( Debug => $ARGV[0], %$params );
my $imap = Mail::IMAPClient->new(%args);
ok( !$@, "successful login" ) or diag( '$@:' . $@ );
# RFC 2087: QUOTA
SKIP: {
my ( $res, $root );
skip "QUOTA not supported", 5 unless $imap->has_capability("QUOTA");
foreach my $root ( "", "INBOX", "/blah" ) {
$res = $imap->getquotaroot($root);
ok( $res, "getquotaroot($root)" ) or diag( '$@:' . $@ );
#my $tag = $imap->Count;
#foreach my $r ( @{$res||[]} ) {
# next if $r =~ /^$tag\s+/;
# chomp($r);
# warn("gqr r=$r\n");
#}
}
ok( $imap->getquota("User quota"), "getquota" ) or diag( '$@:' . $@ );
my $dne = "ThisDoesNotExist";
ok( !$imap->getquota($dne), "getquota($dne)" ) or diag( '$@:' . $@ );
}

36
W/Mail-IMAPClient-3.40/t/simple.t Normal file
View File

@ -0,0 +1,36 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 13;
BEGIN { use_ok('Mail::IMAPClient') or exit; }
{
my $obj = Mail::IMAPClient->new();
my %t = ( 0 => "01-Jan-1970" );
foreach my $k ( sort keys %t ) {
my $v = $t{$k};
my $s = $v . ' 00:00:00 +0000';
is( Mail::IMAPClient::Rfc2060_date($k), $v, "Rfc2060_date($k)=$v" );
is( Mail::IMAPClient::Rfc3501_date($k), $v, "Rfc3501_date($k)=$v" );
is( Mail::IMAPClient::Rfc3501_datetime($k),
$s, "Rfc3501_datetime($k)=$s" );
is( Mail::IMAPClient::Rfc2060_datetime($k),
$s, "Rfc3501_datetime($k)=$s" );
is( $obj->Rfc3501_date($k), $v, "->Rfc3501_date($k)=$v" );
is( $obj->Rfc2060_date($k), $v, "->Rfc2060_date($k)=$v" );
is( $obj->Rfc3501_datetime($k), $s, "->Rfc3501_datetime($k)=$s" );
is( $obj->Rfc2060_datetime($k), $s, "->Rfc2060_datetime($k)=$s" );
foreach my $z (qw(+0000 -0500)) {
my $vz = $v . ' 00:00:00 ' . $z;
is( Mail::IMAPClient::Rfc2060_datetime( $k, $z ),
$vz, "Rfc2060_datetime($k)=$vz" );
is( Mail::IMAPClient::Rfc3501_datetime( $k, $z ),
$vz, "Rfc3501_datetime($k)=$vz" );
}
}
}

30
W/Mail-IMAPClient-3.40/t/thread.t Normal file
View File

@ -0,0 +1,30 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 7;
BEGIN { use_ok('Mail::IMAPClient::Thread') or exit; }
my $t1 = <<'e1';
* THREAD (166)(167)(168)(169)(172)(170)(171)(173)(174 175 176 178 181 180)(179)(177 183 182 188 184 185 186 187 189)(190)(191)(192)(193)(194 195)(196 197 198)(199)(200 202)(201)(203)(204)(205)(206 207)(208)
e1
my $t2 = <<'e2';
* THREAD (166)(167)(168)(169)(172)((170)(179))(171)(173)((174)(175)(176)(178)(181)(180))((177)(183)(182)(188 (184)(189))(185 186)(187))(190)(191)(192)(193)((194)(195 196))(197 198)(199)(200 202)(201)(203)(204)(205 206 207)(208)
e2
my $parser = Mail::IMAPClient::Thread->new;
ok( defined $parser, 'created parser' );
isa_ok( $parser, 'Parse::RecDescent' ); # !!!
my $thr1 = $parser->start($t1);
ok( defined $thr1, 'thread1 start' );
cmp_ok( scalar(@$thr1), '==', 25 );
my $thr2 = $parser->start($t2);
ok( defined $thr2, 'thread2 start' );
cmp_ok( scalar(@$thr2), '==', 23 );

5
W/Mail-IMAPClient-3.40/test_template.txt Normal file
View File

@ -0,0 +1,5 @@
server=imap.server.hostname
user=username
passed=password
port=143
authmechanism=LOGIN

17
W/check_win64err Executable file
View File

@ -0,0 +1,17 @@
#!/bin/sh
# $Id: check_winerr,v 1.4 2016/06/30 11:10:37 gilles Exp gilles $
test -n "$1" || { echo usage: "$0 script.bat" && exit 1 ; }
test -d W/LOG_bat || mkdir W/LOG_bat
ERROR_FILENAME=$1.txt
rm -f "W/LOG_bat/$ERROR_FILENAME"
if scp pc_HP_DV7_p24:'Desktop/imapsync_build/LOG_bat/'"$ERROR_FILENAME" W/LOG_bat/ > /dev/null 2>&1 ; then
#echo -n "W/LOG_bat/$ERROR_FILENAME : "
#cat "W/LOG_bat/$ERROR_FILENAME"
sed -e "s#^#W/LOG_bat/$ERROR_FILENAME : #" "W/LOG_bat/$ERROR_FILENAME"
exit 1
else
echo NO errror
fi

72
W/gts/gts_graphs Executable file
View File

@ -0,0 +1,72 @@
#!/bin/sh
printf_this_one()
{
#echo "[$1]"
printf "%s %s %0${1}s \n" $prj $date $1
}
printf_this_one_div10()
{
num=$1
printf "%s %s %0$((num/10))s \n" $prj $date $1
}
echo graph_clones_uniq
graph_clones_uniq()
{
cat csv/imapsync_github_stats_clone.csv \
| tr '\r\n' ',\n' \
| while IFS=, read -r prj date all uniq
do
#echo -n "[$prj $date $all $uniq]"
#printf_this_one $all
printf_this_one $uniq
done
}
echo graph_clones_all
graph_clones_all()
{
cat csv/imapsync_github_stats_clone.csv \
| tr '\r\n' ',\n' \
| while IFS=, read -r prj date all uniq
do
#echo -n "[$prj $date $all $uniq]"
printf_this_one $all
#printf_this_one $uniq
done
}
echo graph_visitors_uniq
graph_visitors_uniq()
{
cat csv/imapsync_github_stats_traffic.csv \
| tr '\r\n' ',\n' \
| while IFS=, read -r prj date all uniq
do
#echo -n "[$prj $date $all $uniq]"
#printf_this_one_div10 $all
printf_this_one_div10 $uniq
done
}
echo graph_visitors_views
graph_visitors_views()
{
cat csv/imapsync_github_stats_traffic.csv \
| tr '\r\n' ',\n' \
| while IFS=, read -r prj date all uniq
do
#echo -n "[$prj $date $all $uniq]"
printf_this_one_div10 $all
#printf_this_one_div10 $uniq
done
}

0
W/learn/+ZyhnUA- Normal file
View File

10
W/learn/bug_Mail-IMAPClient-3.40_connect Executable file
View File

@ -0,0 +1,10 @@
#!/usr/bin/perl
use strict ;
use warnings ;
use Mail::IMAPClient ;
my $imap = Mail::IMAPClient->new( ) ;
$imap->connect( ) ;
print "I hope I'm not dead but...\n" ;

38
W/learn/bug_io_prompt_local_ARGV Executable file
View File

@ -0,0 +1,38 @@
#!/usr/bin/perl
use strict;
use warnings;
use IO::Prompt;
# The defect is when used with a pipe, like the following on the command line example,
# prompt() does not print the prompt string 'Say something: '
# however the variable @ARGV is locally empty.
# The output is then only:
#
# $ echo bla bla bla | ./bug_io_prompt_local_ARGV param1 param2
# ARGV are param1 param2
# You said: bla bla bla
# I tried also
# prompt( \*STDOUT, 'Say something: ');
# The behavior is ok without the pipe:
# ./bug_io_prompt_local_ARGV param1 param2
print "$IO::Prompt::VERSION\n" ;
print "ARGV are @ARGV\n" ;
my $input = get_stdin();
print "You said: $input\n" ;
sub get_stdin
{
local(@ARGV) ;
my $input = prompt(
-prompt => 'Say it: ',
-echo => '*',
-newline => "\nGot it\n"
) ;
return $input ;
}

44
W/learn/bug_io_prompter_local_ARGV Executable file
View File

@ -0,0 +1,44 @@
#!/usr/bin/perl
use strict;
use warnings;
use IO::Prompter;
# The defect is when used with a pipe, like the following on the command line example,
# prompt() does not print the prompt string 'Say something: '
# however the variable @ARGV is locally empty.
# The output is then only:
#
# $ echo bla bla bla | ./bug_io_prompt_local_ARGV param1 param2
# ARGV are param1 param2
# You said: bla bla bla
# I tried also
# prompt( \*STDOUT, 'Say something: ');
# The behavior is ok without the pipe:
# ./bug_io_prompt_local_ARGV param1 param2
# echo input | { echo -n "prompt: " ; read stdin ; echo "got $stdin" ; }
# { echo -n "prompt: " ; read stdin ; echo "got $stdin" ; }
print "$IO::Prompter::VERSION\n" ;
print "ARGV are @ARGV\n" ;
my $input = get_stdin();
print "You said: $input\n" ;
sub get_stdin
{
#local(@ARGV) ;
my $prompt = 'Say something: ' ;
my $input = prompt(
-prompt => $prompt,
-echo => '*',
-in => *STDIN,
-out => *STDOUT,
);
return $input ;
}

67
W/learn/file_append Executable file
View File

@ -0,0 +1,67 @@
#!/usr/bin/perl
use warnings;
use strict;
use English;
use Mail::IMAPClient;
my $rcs = '$Id: append,v 1.1 2011/07/14 16:49:02 gilles Exp gilles $ ';
main();
sub main {
$ARGV[4] or die "usage: $0 host user password folder file\n";
my $host = $ARGV[0];
my $user = $ARGV[1];
my $password = $ARGV[2];
my $folder = $ARGV[3];
my $file = $ARGV[4];
my $imap = Mail::IMAPClient->new();
$imap->Debug(1);
$imap->Server($host);
#$imap->Ssl(1);
$imap->connect() or die;
$imap->User($user);
$imap->Password($password);
$imap->login() or die;
$imap->Uid(1);
$imap->Peek(1);
$imap->Clear(0);
print map {"$_\n"} $imap->folders();
$imap->select($folder) or $imap->create($folder) or die;
$imap->select($folder) ;
my @msgs = $imap->messages ;
print "LIST: @msgs\n";
my $msgtext = file_to_string( $file ) || die ;
my $new_id_1b = $imap->append_string( $folder, $msgtext ) ;
print "==== OK 1b $new_id_1b\n" if $new_id_1b ;
@msgs = $imap->messages ;
print "LIST: @msgs\n";
$imap->close();
}
sub file_to_string {
my $file = shift ;
if ( ! $file ) { return ; }
if ( ! -e $file ) { return ; }
if ( ! -f $file ) { return ; }
if ( ! -r $file ) { return ; }
my @string ;
if ( open my $FILE, '<', $file ) {
@string = <$FILE> ;
close $FILE ;
return( join q{}, @string ) ;
}else{
myprint( "Error reading file $file : $OS_ERROR\n" ) ;
return ;
}
}

24
W/learn/here_comment Executable file
View File

@ -0,0 +1,24 @@
#!/usr/bin/perl
use strict ;
use warnings ;
0 and <<'COMMENT';
This is a multiline comment.
Based on David Carter discussion, to do:
* Call parameters stay the same.
* Now always "return( $string, $error )". Descriptions below.
OK * Still capture STDOUT via "1> $output_tmpfile" to finish in $string and "return( $string, $error )"
OK * Now also capture STDERR via "2> $error_tmpfile" to finish in $error and "return( $string, $error )"
OK * in case of CHILD_ERROR, return( undef, $error )
and print $error, with folder/UID/maybeSubject context,
on console and at the end with the final error listing. Count this as a sync error.
* in case of good command, take final $string as is, unless void. In case $error with value then print it.
* in case of good command and final $string empty, consider it like CHILD_ERROR =>
return( undef, $error ) and print $error, with folder/UID/maybeSubject context,
on console and at the end with the final error listing. Count this as a sync error.
COMMENT
# End of multiline comment.

5
W/learn/imap_gbk_Q_decode Normal file
View File

@ -0,0 +1,5 @@
perl -E 'use open qw(:std :utf8);
use Encode;
say Encode::decode("MIME-Header", "Subject: Re: =?gbk?Q?=C3=C9=B9=C5=CF=EE=C4=BF=D0=CD=D6=C6=D7=F7=B7=BD=B0=B8?=");'

16
W/rsync_exclude_dist.txt Executable file
View File

@ -0,0 +1,16 @@
# $Id: rsync_exclude_dist.txt,v 1.3 2019/02/17 15:29:44 gilles Exp gilles $
imapsync.exe
imapsync_64bit.exe
W/gts/csv
W/imapsync.tdy
W/paypal_reply
LOG_imapsync
nytprof.out
nytprof/
vnstat
VERSION_EXE
cover_db

9
W/tools/addFromIfMissing2 Executable file
View File

@ -0,0 +1,9 @@
#!/usr/bin/env python
import email
import sys
msg = email.message_from_string(sys.stdin.read())
if msg['From'] is None:
msg['From'] = sys.argv[1]
print(msg)

1
W/tools/cgi_memo Symbolic link
View File

@ -0,0 +1 @@
../../X/cgi_memo

4
X/.htaccess Normal file
View File

@ -0,0 +1,4 @@
RewriteEngine On
RewriteCond %{SERVER_PORT} !^443$
RewriteRule (.*) https://%{HTTP_HOST}/X/$1 [R=301,L]

684
X/cgi_memo Executable file
View File

@ -0,0 +1,684 @@
#!/bin/sh
# $Id: cgi_memo,v 1.45 2019/02/10 14:28:53 gilles Exp gilles $
if test -n "$1"; then
echoq() { echo "$@" ; } # not quiet mode
else
echoq() { : ; } # quiet mode: nop
fi
echoq list_all_logs
list_all_logs() {
cat list_all_logs.txt
}
echoq list_all_logs_generate
list_all_logs_generate() {
echo Result in list_all_logs.txt
sortmtimef . | grep -v 385d7a4d8d428d7aa2b57c8982629e2bd67698ed/ | grep /LOG_imapsync/ > list_all_logs.txt.tmp
mv list_all_logs.txt.tmp list_all_logs.txt
}
echoq biggest_transfer
biggest_transfer() {
bytestohuman `datamash_file_op_index G_Total_bytes_transferred.txt max 5`
}
echoq total_bytes_transferred
total_bytes_transferred() {
datamash_file_op_index G_Total_bytes_transferred.txt sum 5
}
# Total volume transferred
echoq total_volume_transferred
total_volume_transferred() {
#echo -n 'numfmt --to=iec-i '
bytestohuman `total_bytes_transferred`
}
echoq mean_bytes_transferred
mean_bytes_transferred() {
nb_transfers_ended=`wc -l < transfers_sizes_in_bytes.txt`
total_bytes_transferred=`total_bytes_transferred`
echo "$total_bytes_transferred / $nb_transfers_ended" | bc
}
echoq mean_volume_transferred
mean_volume_transferred() {
bytestohuman `mean_bytes_transferred`
}
echoq total_messages_transferred
total_messages_transferred() {
datamash_file_op_index G_Messages_transferred.txt sum 4 %16.0f | tr -d ' '
}
longest_transfer() {
printf "%.0f\n" `datamash_file_op_index G_Transfer_time.txt max 4`
}
echoq number_and_pids_of_imapsync_running
number_and_pids_of_imapsync_running() {
echo "`number_of_imapsync_running` : `pids_of_imapsync_running`"
: # always return true
}
echoq number_of_imapsync_running
number_of_imapsync_running() {
pids_of_imapsync_running | wc -w
: # always return true
}
echoq pids_of_imapsync_running
pids_of_imapsync_running() {
pgrep -d ' ' -f cgi-bin/imapsync
: # always return true
}
echoq oom_immune_imapsync_running
oom_immune_imapsync_running() {
for pid in `pids_of_imapsync_running`
do
test -f /proc/$pid/oom_adj || continue
echo -n "$pid "
cat /proc/$pid/oom_* | tr '\n' ' '
{ test -f /proc/$pid/oom_adj && echo -12 > /proc/$pid/oom_adj && echo -n ">>> " && cat /proc/$pid/oom_adj ; }
done
}
echoq nb_migrations_launched
nb_migrations_launched() {
/bin/ls . | egrep [a-f0-9]{40} | wc -l
}
echoq current_stats
current_stats() {
echo -n "Nb accounts: "; nb_migrations_launched
echo -n "Nb imapsync running: "; number_and_pids_of_imapsync_running
# dstat, Linux
dstat --version > /dev/null 2>&1 && dstat -l -n -cdgyms 60 1 && return
# no dstat, FreeBSD
dstat --version > /dev/null 2>&1 || vmstat 2 15 && return
#clear
}
echoq watch_current_stats
watch_current_stats() {
export -f current_stats
# watch -n 120 current_stats
while : ; do
clear
oom_immune_imapsync_running
current_stats
done
}
echoq 'grep_in_all_logs str1 str2 ... # up to str5. Results in mtime order of logfiles'
grep_in_all_logs() {
grep_file=grep_`echo "$1 $2 $3 $4 $5" | tr ' ' '_' | tr -cd '0-9a-zA-Z_.\n'`.txt
echo results in "${grep_file}"
list_all_logs | tr '\n' '\000'| xargs -0 egrep -E -i "$1" | egrep -i "$2" | egrep -i "$3" | egrep -i "$4" | egrep -i "$5" | tee "${grep_file}.tmp"
mv "${grep_file}.tmp" "${grep_file}"
}
echoq grep_in_logs_manual
grep_in_logs_manual() {
cat << EOF
list_all_logs | tail -500 | tr '\n' '\000'| xargs -0 egrep -i LALALA | tee grep_LALALA.txt
EOF
}
echoq 'grep_stats_from_list_all_logs # long'
grep_stats_from_list_all_logs() {
echo results in grep_stats.txt
list_all_logs | tr '\n' '\000'| xargs -0 egrep -i -f stat_patterns.txt > grep_stats.txt.tmp
mv grep_stats.txt.tmp grep_stats.txt
}
grep_any() {
file=G_`echo "$1" | tr ' .' '__' | tr -cd '0-9a-zA-Z_.\n'`.txt
echo $file
egrep -i "$1" grep_stats.txt > $file.tmp
mv $file.tmp $file
}
grep_load() {
echo G_Load.txt
egrep -o 'Load is ..?\... ..?\... ..?\...' grep_stats.txt > G_Load.txt
}
grep_all2() {
for k in "$@" ; do
grep_any "$k"
done
}
echoq 'grep_all_stat_from_patterns_list # long'
grep_all_stat_from_patterns_list() {
grep_load
stat_patterns_list | while read k; do grep_all2 "$k" ; done
}
stat_patterns_list() {
cat stat_patterns.txt | tr -d '^'
}
echoq stat_load
stat_load() {
echo -n 'Load min: ' ; datamash --format=%6.1f -W min 3 min 4 min 5 < G_Load.txt
echo -n 'Load q1: ' ; datamash --format=%6.1f -W q1 3 q1 4 q1 5 < G_Load.txt
echo -n 'Load median: ' ; datamash --format=%6.1f -W median 3 median 4 median 5 < G_Load.txt
echo -n 'Load mean: ' ; datamash --format=%6.1f -W mean 3 mean 4 mean 5 < G_Load.txt
echo -n 'Load q3: ' ; datamash --format=%6.1f -W q3 3 q3 4 q3 5 < G_Load.txt
echo -n 'Load max: ' ; datamash --format=%6.1f -W max 3 max 4 max 5 < G_Load.txt
}
datamash_file_op_index() {
file="$1"
op="${2:-mean}"
index="${3:-4}" # the four field by default
format="${4:-%16.1f}" # --format=%16.1f by default
datamash --format="$format" -W "$op" "$index" < "$file"
}
stat_any() {
file="$1"
index=${2:-4} # the four field by default
for op in \
"min " \
"q1 " \
"median" \
"mean " \
"q3 " \
"max " \
do
echo -n "$file $index $op " ; datamash_file_op_index $file $op $index
done
echo
}
echoq stat_all
stat_all() {
stat_load ; echo
# stat_any G_REMOTE_ADDR.txt
# stat_any G_REMOTE_HOST.txt
# stat_any G_HTTP_COOKIE.txt
# stat_any G_HTTP_USER_AGENT.txt
# stat_any G_HTTP_REFERER.txt
# stat_any G_Host__IMAP_server.txt
# stat_any G_Host__banner.txt
stat_any G_Messages_transferred.txt
stat_any G_Messages_skipped.txt
# stat_any G_Folders_synced.txt
stat_any G_Transfer_time.txt
stat_any G_Total_bytes_transferred.txt 5
stat_any G_Message_rate.txt
stat_any G_Average_bandwidth_rate.txt 5
stat_any G_Biggest_message.txt
stat_any G_Detected_errors.txt 2
stat_any G_Exiting_with_return_value.txt 5 # GROUP
stat_any G_Memory_consumption_at_the_end.txt 7
#stat_any G_failure_Error_login.txt
}
echoq dirs_of_syncs_finished_recently
dirs_of_syncs_finished_recently() {
find . -maxdepth 1 -mtime "${1:--1}" | grep -v "385d7a4d8d428d7aa2b57c8982629e2bd67698ed" | egrep [a-f0-9]{40} | while read d; do
test -f "$d" && continue
test -f $d/imapsync.pid && continue
echo $d
done
}
echoq 'logfiles_finished_recently -3 # less than 3 days, default is like -1'
logfiles_finished_recently()
{
{
# +2 more than 2 days ago
# -3 less than 3 days ago
# 7 exactly 7 days ago
#set -x
find . -maxdepth 1 -mtime "${1:--1}" | grep -v "385d7a4d8d428d7aa2b57c8982629e2bd67698ed" | egrep [a-f0-9]{40} | while read f; do
test -f "$f" && continue
test -f $f/imapsync.pid && continue
test -d $f/LOG_imapsync || continue
# { ls -trb $f/LOG_imapsync/* ; }
find $f/LOG_imapsync/ -type f -mtime "${1:--1}"
done
}
}
last_dirs_written()
{
ls -tr | tail -800
}
last_file_written_in_dir()
{
ls -trd $1/LOG_imapsync/* |tail -1
}
is_dir_running_imapsync()
{
test -d "$1" || return 1
test -f "$1/imapsync.pid" && PID=`cat "$1/imapsync.pid"` &&
ps -p $PID -o comm= > /dev/null
}
echoq logfiles_running
logfiles_running()
{
last_dirs_written | while read d
do
is_dir_running_imapsync "$d" &&
last_file_written_in_dir "$d"
done
}
epoch_of_file()
{
date -r "$1" +%s
}
epoch_of_now()
{
date +%s
}
is_file_older_than()
{
# return 1 if not exist or recent
# return 0 if older than "$2" seconds or 15 minutes (900 secondes)
test -f "$1" || return 1
epoch_file=`epoch_of_file "$1"`
epoch_now=`epoch_of_now`
epoch_diff=`expr $epoch_now - $epoch_file`
#echo "$epoch_now - $epoch_file = $epoch_diff"
if test "${2:-900}" -lt "$epoch_diff"
then
#echo older than $2
return 0
else
#echo newer than $2
return 1
fi
}
pids_of_imapsync_not_writing_since_x_secondes()
{
x_secondes=${1:-900} # 15 minutes by default
last_dirs_written | while read d
do
is_dir_running_imapsync "$d" &&
is_file_older_than `last_file_written_in_dir "$d"` "$x_secondes" &&
cat "$d/imapsync.pid" && echo -n " "
done
}
kill_HUP_pids_of_imapsync_not_writing_since_x_secondes()
{
pids_not_writing=`pids_of_imapsync_not_writing_since_x_secondes ${1:-900}`
test -n "$pids_not_writing" && echo kill -HUP "$pids_not_writing" && kill -HUP "$pids_not_writing"
}
watch_logfiles_running_old() {
# the "tail --pid=" option does not exist on FreeBSD, it's GNU/Linux
while date; do
inotifywait /var/tmp/imapsync_cgi -e create 2>/dev/null &
PID_inotifywait=$!
logfiles_running | xargs -d'\n' tail --pid=$PID_inotifywait -f -v
echo "NEW SYNC IS RUNNING"
echo "Syncs running: "; number_and_pids_of_imapsync_running
sleep 3
done
}
watch_logfiles_running_old2() {
while date; do
kill $PID_inotifywait
inotifywait /var/tmp/imapsync_cgi -e create 2>/dev/null &
PID_inotifywait=$!
kill_tail_logfiles_running
tail_logfiles_running
wait $PID_inotifywait
kill_tail_logfiles_running
echo "NEW SYNC IS RUNNING"
echo "Syncs running: "; number_and_pids_of_imapsync_running
sleep 3
done
}
tail_logfiles_running() {
logfiles_running=`logfiles_running`
test -n "$logfiles_running" && tail -f $logfiles_running
#PID_tail_logfiles_running=$!
#fg
}
echoq watch_logfiles_running
watch_logfiles_running() {
tail_logfiles_running
}
kill_tail_logfiles_running() {
kill $PID_tail_logfiles_running
}
echoq watch_new_runs
watch_new_runs() {
while { date; echo -n "Nb syncs currently: " ; number_and_pids_of_imapsync_running ; } do
inotifywait . -e create 2>/dev/null | { read path action f
echo $f
sleep 2
test -f $f/imapsync.pid && PID=`cat $f/imapsync.pid` && echo PID $PID
echo -e '\a'
}
done
}
echoq pidfiles_running_and_not_running
pidfiles_running_and_not_running() {
ls -tr | while read f; do
test -f $f/imapsync.pid && PID=`cat $f/imapsync.pid` && echo -n "$PID " &&
{ ps -p $PID -o comm= | tr '\n' ' ' && { test -f /proc/$PID/oom_score &&
{ echo -12 > /proc/$PID/oom_adj ; } && echo -n "oom_score " && cat /proc/$PID/oom_score | tr '\n' ' ' ; : ; }
} &&
{ ls -tr $f/LOG_imapsync/* |tail -1 ; }
done
}
pidfile_dandling() {
pidfile_dandling_DIR=$1
test -d $pidfile_dandling_DIR || return 2
test -f $pidfile_dandling_DIR/imapsync.pid || return 3
pidfile_dandling_PID=`cat $pidfile_dandling_DIR/imapsync.pid`
#echo "$pidfile_dandling_PID"
test -n "$pidfile_dandling_PID" || return 4
test "$pidfile_dandling_PID" -ge 1 || return 5
if ! ps -p "$pidfile_dandling_PID" -o comm= > /dev/null ; then
#echo -n "DANDLING $pidfile_dandling_DIR/imapsync.pid "
#echo "# PID $pidfile_dandling_PID"
return 0
fi
return 99
}
echoq pidfiles_not_running
pidfiles_not_running() {
ls -tr | while read f; do
if pidfile_dandling "$f" ; then
pidfiles_not_running_PID=`cat $f/imapsync.pid`
echo -n "rm $f/imapsync.pid # "
{ ls -tr $f/LOG_imapsync/* 2>/dev/null |tail -1 ; } | tr '\n' ' '
echo "# PID $pidfiles_not_running_PID"
fi
done
}
first_use() {
test -f first_use && cat first_use && return
echo "${1:-2017} ${2:-01} ${3:-09}"
}
days_since_first_use() {
first_use=`first_use "$@"`
#echo $[$[$(date +%s)-$(epoch_of_y_m_d_h_m_s 2017 01 09 00 00 00)]/60/60/24]
echo $[$[$(date +%s)-$(epoch_of_y_m_d_h_m_s $first_use 00 00 00)]/60/60/24]
}
epoch_of_y_m_d_h_m_s() {
date -v -1d > /dev/null 2>&1 && date -u -v ${1:-1970}y -v ${2:-1}m -v ${3:-1}d -v ${4:-0}H -v ${5:-0}M -v ${6:-0}S +%s && return
date --date="1 day ago" > /dev/null && date -u -d "${1:-1970}-${2:-1}-${3:-1} ${4:-0}:${5:-0}:${6:-0}" +%s && return
}
date_x_days_ago() {
date -v -1d > /dev/null 2>&1 && date -u -v -${1:-0}d "+%Y-%m-%d %a" && return
date --date="1 day ago" > /dev/null && date -u --date="${1:-0} day ago" "+%Y-%m-%d %a" && return
}
seconds_to_days_hours() {
#eval "echo $(date -ud "@${1:-0}" +'$((%s/3600/24)) days %_H hours %_M min %_S sec')"
date -v -1d > /dev/null 2>&1 && eval "echo $(date -ur "${1:-0}" +'$((%s/3600/24)) days %_H hours %_M min %_S sec')" && return
date --date="1 day ago" > /dev/null && eval "echo $(date -ud "@${1:-0}" +'$((%s/3600/24)) days %_H hours %_M min %_S sec')" && return
}
seconds_to_days_hours_echo() {
date -v -1d > /dev/null 2>&1 && echo "echo $(date -ur "${1:-0}" +'$((%s/3600/24)) days %_H hours %_M min %_S sec')" && return
date --date="1 day ago" > /dev/null && echo "echo $(date -ud "@${1:-0}" +'$((%s/3600/24)) days %_H hours %_M min %_S sec')" && return
}
echoq 'runs_per_day 7 # last 7 days'
runs_per_day() {
historic_start=`days_since_first_use`
start=${1:-$historic_start}
for cc in `count 0 $start`; do
DATE=`date_x_days_ago $cc`
echo -n "$DATE $cc days ago: "; find . -maxdepth 1 -mtime $cc -ls |wc -l
done
}
echoq summary_run
summary_run() {
for summary_run_DIR in "$@"; do
echo Analysing $summary_run_DIR
echo -n "Nb logs: "; ls $summary_run_DIR/LOG_imapsync/*.txt | wc -l
summary_run_LOGS_LIST=`ls $summary_run_DIR/LOG_imapsync/*.txt`
echo -n "List logs: "; echo $summary_run_LOGS_LIST
#echo connect failure
summary_run_CONNECT_FAIL=`grep -i 'failure: can not open imap connection on' $summary_run_DIR/LOG_imapsync/*.txt|wc -l`
echo CONN $summary_run_CONNECT_FAIL
#echo login failure
grep -i 'failure: Error login on' $summary_run_DIR/LOG_imapsync/*.txt
#echo Differences
grep -i "difference host2 - host1" $summary_run_DIR/LOG_imapsync/*.txt
done
}
logs_nb() {
logs_nb_DIR="$1"
logs_nb_LOGS_LIST="$logs_nb_DIR"/LOG_imapsync/*.txt
}
vnstat_init() {
test FreeBSD = `uname -s` && VNSTATI_DIR=/usr/local/www/apache24/data/vnstat/
test Linux = `uname -s` && VNSTATI_DIR=/var/www/vnstat/
test -d $VNSTATI_DIR || mkdir -p $VNSTATI_DIR
}
echoq vnstat_gen
vnstat_gen() {
vnstat_init || return
for opt in s h hg hs d m y t vs 5 ; do
test "$1" && echo vnstati -$opt -o $VNSTATI_DIR/vnstat_${opt}.png
vnstati -$opt -o $VNSTATI_DIR/vnstat_${opt}.png
done
}
echoq vnstat_archive
vnstat_archive() {
(
vnstat_gen "$1" || return
now_ymdhms=`date +%Y_%m_%d_%H_%M_%S` || return
mkdir $VNSTATI_DIR/$now_ymdhms/ || return
cd $VNSTATI_DIR/$now_ymdhms/ || return
test "$1" && pwd
ln ../*.png ../*.html .
)
test "$1" && pwd
}
echoq dstat_csv
dstat_csv() {
#dstat -l -n -cdgyms 60 1
dstat -t -l -n -cdgyms --output dstat.csv 60
}
echoq 'ratio_killed_by_TERM -3 # last 3 days'
ratio_killed_by_TERM() {
logfiles_finished_recently=`logfiles_finished_recently $1`
nb_logfiles_finished_recently=`echo $logfiles_finished_recently | wc -w`
echo -n "Got a signal TERM: " && echo $logfiles_finished_recently | xargs grep -i 'Got a signal TERM' | wc -l
echo -n "Got a signal : " && echo $logfiles_finished_recently | xargs grep -i 'Got a signal' | wc -l
echo -n "Among finished : " && echo $nb_logfiles_finished_recently
echo "logfiles_finished_recently $1 | xargs grep -i 'Got a signal TERM' "
}
echoq 'nb_syncs_badly_finished -1 # last 1 day'
nb_syncs_badly_finished() {
logfiles_finished_recently=`logfiles_finished_recently $1`
nb_logfiles_finished_recently=`echo $logfiles_finished_recently | wc -w`
nb_syncs_badly_finished=`echo $logfiles_finished_recently | xargs grep -i 'Exiting with return value' | grep -v 'return value 0' | wc -l `
echo $nb_syncs_badly_finished / $nb_logfiles_finished_recently
cat <<EOF
logfiles_finished_recently $1 | xargs grep -i 'Exiting with return value' | grep -v 'return value 0'
EOF
}
echoq 'referrer_of_x /var/log/apache2/imapsync_access.log /var/log/apache/httpd-access.log | sort | uniq -c | sort -n'
referrer_of_x() {
zegrep -h -s -o 'GET /X/? .*http[^"]+' "${@:-/var/log/apache2/imapsync_access.log}" | grep -o 'http.*'
}
biggest_message_seen() {
datamash -W max 4 < G_Biggest_message.txt | xargs bytestohuman
}
biggest_message_transferred() {
grep 'Host2 Biggest message' < G_Biggest_message.txt | datamash -W max 4 | xargs bytestohuman
}
biggest_bandwidth_rate() {
datamash_file_op_index G_Average_bandwidth_rate.txt max 5 | tr -d ' ' | tr '\n' ' '
echo KiB/s
}
echoq number_of_X_users
number_of_X_users() {
datamash_file_op_index G_REMOTE_ADDR.txt unique 3 | tr , '\n' | wc -l
}
echoq summary_compute2
summary_compute2() {
list_all_logs_generate \
&& grep_stats_from_list_all_logs \
&& grep_all_stat_from_patterns_list \
&& summary_display
}
echoq summary_display
summary_display() {
vnstat_gen > /dev/null
echo "Start date of /X (aaaa mm dd): `first_use` (`days_since_first_use` days of service)"
echo -n "Number of /X users: " ; number_of_X_users
echo -n "Number of /X accounts synced: " ; nb_migrations_launched
echo -n "Number of /X syncs: " ; list_all_logs| grep -v abort.txt | wc -l
echo -n "Total volume /X transferred: " ; total_volume_transferred
echo -n "Total messages /X transferred: " ; total_messages_transferred
echo -n "Biggest transfer: " ; biggest_transfer
echo -n "Biggest message seen: " ; biggest_message_seen
echo -n "Biggest message transferred: " ; biggest_message_transferred
echo -n "Biggest bandwidth rate: " ; biggest_bandwidth_rate
echo -n "Longest transfer: " ; seconds_to_days_hours `longest_transfer`
}
echoq sync_ks2_i005
sync_ks2_i005()
{
test "Xks2" = "X`hostname`" \
&& echo Here is ks2 nothing to do \
&& return
test "Xi005" = "X`hostname`" && echo Here is i005 \
&& date \
&& cd /home/imapsync_cgi_ks2/ \
&& rsync -a root@ks2:/var/tmp/imapsync_cgi/ /home/imapsync_cgi_ks2/ \
&& summary_compute2 \
&& echo sending txt back to ks2 \
&& rsync -av /home/imapsync_cgi_ks2/*txt root@ks2:/var/tmp/imapsync_cgi/ \
&& date \
&& pwd
}
echoq watch_number_of_imapsync_running
watch_number_of_imapsync_running()
{
date_space
while number_of_imapsync_running | tr -d ' \n'
do
sleep 6
date_if_new_hour
done
}
#echoq date_if_new_hour
date_if_new_hour()
{
min=`date +%M`
sec=`date +%S`
#echo $min $sec
if test "00" = "$min" && test 6 -ge $sec
then
echo
date_space
sleep 1
fi
}
date_space()
{
date | tr -d '\n'
echo -n " "
}
echoq various_usefull
various_usefull() {
cat <<'EOF'
sort -k5 -n grep_Messages_transferred____.txt
sort -k5 -n grep_Memory_consumption___.txt
sort -k5 -n grep_Average_bandwidth_rate__.txt
sort -k4 -n grep_Transfer_time____.txt
strace -e trace=signal -f `pgrep apache | xargs -n1 echo -n " -p "` 2>&1
logfiles_finished_recently -1 | xargs grep -i 'Exiting with return value' | grep -v 'return value 0'
egrep -o 'Host1: IMAP server \[[^]]+\]' G_Host__IMAP_server.txt | sort | uniq -c | sort -n | tail -15
egrep -o 'Host2: IMAP server \[[^]]+\]' G_Host__IMAP_server.txt | sort | uniq -c | sort -n | tail -15
egrep -o '[0-9]+/[0-9]+' G_Folders_synced.txt | sort -n
EOF
}
# hosts used and counted
# grep Host grep_success_login_on_with_user.txt | egrep -o 'on \[[^[]+]' | sort | uniq -c | sort -n
# grep Host1 grep_success_login_on_with_user.txt | egrep -o 'on \[[^[]+]' | sort | uniq -c | sort -n
# grep Host2 grep_success_login_on_with_user.txt | egrep -o 'on \[[^[]+]' | sort | uniq -c | sort -n

10253
X/jquery-3.2.1.js vendored Normal file
View File

File diff suppressed because it is too large Load Diff

4
X/jquery-3.2.1.min.js vendored Normal file
View File

File diff suppressed because one or more lines are too long

10364
X/jquery-3.3.1.js vendored Normal file
View File

File diff suppressed because it is too large Load Diff

2
X/jquery-3.3.1.min.js vendored Normal file
View File

File diff suppressed because one or more lines are too long

BIN
X/logo_imapsync_Xn.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 43 KiB

41
X/stat_patterns.txt Normal file
View File

@ -0,0 +1,41 @@
^Here is imapsync
^Load end is
^Load is
^Temp directory is
^Current directory is
^REMOTE_ADDR
^REMOTE_HOST
^HTTP_COOKIE
^HTTP_USER_AGENT
^HTTP_REFERER
^Host1: IMAP server
^Host1 banner:
^Host1 Nb folders:
^Host1 Nb messages:
^Host1 Total size:
^Host1 Biggest message:
^Host1 Time spent:
^Host2: IMAP server
^Host2 banner:
^Host2 Nb folders:
^Host2 Nb messages:
^Host2 Total size:
^Host2 Biggest message:
^Host2 Time spent:
^Messages transferred
^Messages found in host1 not in host2
^Messages found in host2 not in host1
^Messages skipped
^Folders synced
^Transfer time
^Total bytes transferred
^Message rate
^Average bandwidth rate
^Biggest message
^Detected.*errors
^Ended by a signal
^Exiting with return value
^Memory consumption
^Memory consumption at the end
failure: Error login
^Read:.*\* *ID

30
X/vnstati.html Normal file
View File

@ -0,0 +1,30 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<meta name="Generator" content="vnstat.cgi 1.0">
<title>Traffic Statistics for Some Server</title>
<style type="text/css">
<!--
a { text-decoration: underline; }
a:link { color: #b0b0b0; }
a:visited { color: #b0b0b0; }
a:hover { color: #000000; }
small { font-size: 8px; color: #cbcbcb; }
-->
</style>
</head>
<body bgcolor="#ffffff">
<img src="vnstat_s.png" border="0" alt="summary"><br>
<img src="vnstat_5.png" border="0" alt="5 minutes"><br>
<img src="vnstat_h.png" border="0" alt="hourly"><br>
<img src="vnstat_d.png" border="0" alt="daily"><br>
<img src="vnstat_m.png" border="0" alt="monthly"><br>
<img src="vnstat_y.png" border="0" alt="yearly"><br>
<img src="vnstat_t.png" border="0" alt="top 12"><br>
<small><br>&nbsp;Images generated using <a href="http://humdi.net/vnstat/">vnStat</a> image output.</small>
</body>
</html>

1
dist Symbolic link
View File

@ -0,0 +1 @@
dist2