zydronium/imapsync
1
0
Fork 0
mirror of https://github.com/imapsync/imapsync.git synced 2025-08-03 23:41:52 +02:00
Code Issues Projects Releases Packages Wiki Activity

1.727

Browse source
This commit is contained in:
Nick Bebout 2016-09-19 10:17:24 -05:00
parent 3eaac56812
commit 137242e609
114 changed files with 10852 additions and 8980 deletions
Download patch file Download diff file Expand all files Collapse all files

11
W/learn/automap_languages Normal file
View file

@ -0,0 +1,11 @@
From
http://stackoverflow.com/questions/2185391/localized-gmail-imap-folders/2185548#2185548
drafts Borradores, Borradores, Bozze, Brouillons, Concepten, Entwürfe, Kladder, Koncepty, Kopie robocze, Rascunhos, Rascunhos, Taslaklar, Utkast, Utkast, Πρόχειρα, Черновики, 下書き, 草稿, 草稿, 임시보관함
inbox Bandeja de entrada, Boîte de réception, Caixa de entrada, Caixa de entrada, Doručená pošta, Gelen Kutusu, Indbakke, Inkorgen, Innboks, Odebrane, Posta in arrivo, Posteingang, Postvak IN, Recibidos, Εισερχόμενα, Входящие, 受信トレイ, 收件匣, 收件箱, 받은편지함
junk Correio electrónico não solicitado, Correo basura, Junk, Junk, Lixo, Nettsøppel, Nevyžádaná pošta, No solicitado, Ongewenst, Posta indesiderata, Skräp, Spam, Wiadomości-śmieci, Önemsiz, Ανεπιθύμητα, Спам, 垃圾邮件, 垃圾郵件, 迷惑メール, 스팸
outbox Bandeja de salida, Boîte d'envoi, Caixa de saída, Caixa de saída, Do wysłania, Enviados, Giden Kutusu, Posta in uscita, Postausgang, Postvak UIT, Pošta k odeslání, Udbakke, Utboks, Utkorgen, Εξερχόμενα, Исходящие, 发件箱, 寄件匣, 送信トレイ, 보낼편지함
sent E-mails enviados, Enviada, Enviado, Enviado, Gesendet, Gönderildi, Inviati, Odeslaná pošta, Sendt, Sendt, Skickat, Verzonden, Wysłane, Éléments envoyés, Απεσταλμένα, Отправленные, 寄件備份, 已发送邮件, 送信済み, 보낸편지함
trash Cestino, Corbeille, Kosz, Koš, Lixeira, Lixo, Papelera, Papelera, Papierkorb, Papirkurv, Papirkurv, Papperskorgen, Prullenbak, Çöp Kutusu, Κάδος απορριμμάτων, Корзина, ゴミ箱, 垃圾桶, 已删除邮件, 휴지통

29
W/learn/create_folder Executable file
View file

@ -0,0 +1,29 @@
#!/usr/bin/perl -w
use Mail::IMAPClient;
$ARGV[2] or die "usage: $0 host user password folder1 folder2 ...\n";
$host = $ARGV[0];
$user = $ARGV[1];
$password = $ARGV[2];
my $imap = Mail::IMAPClient->new();
$imap->Debug(1);
$imap->Server($host);
$imap->connect() or die;
$imap->User($user);
$imap->Password($password);
$imap->login() or die;
$imap->Uid(1);
$imap->Peek(1);
foreach $folder (@ARGV[3..$#ARGV]) {
print "creating folder $folder\n";
$imap->create($folder);
}
$imap->logout();
# $imap->close();

36
W/learn/delete_all_folders Executable file
View file

@ -0,0 +1,36 @@
#!/usr/bin/perl -w
# $Id: delete_folder,v 1.1 2016/07/05 20:59:43 gilles Exp gilles $
use Mail::IMAPClient;
$ARGV[2] or die "usage: $0 host user password folder1 folder2 ...\n";
$host = $ARGV[0];
$user = $ARGV[1];
$password = $ARGV[2];
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);
my @folders = $imap->folders( ) ;
print map { "$_\n" } @folders ;
foreach $folder ( @folders) {
print "deleting folder $folder\n";
$imap->delete( $folder ) ;
}
$imap->logout();
# $imap->close();

36
W/learn/delete_folder Executable file
View file

@ -0,0 +1,36 @@
#!/usr/bin/perl -w
# $Id: delete_folder,v 1.1 2016/07/05 20:59:43 gilles Exp gilles $
use Mail::IMAPClient;
$ARGV[2] or die "usage: $0 host user password folder1 folder2 ...\n";
$host = $ARGV[0];
$user = $ARGV[1];
$password = $ARGV[2];
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);
my @folders = $imap->folders( ) ;
print map { "$_\n" } @folders ;
foreach $folder (@ARGV[3..$#ARGV]) {
print "deleting folder $folder\n";
$imap->delete( $folder ) ;
}
$imap->logout();
# $imap->close();

205
W/learn/dns_srv_imap Executable file
View file

@ -0,0 +1,205 @@
#!/usr/bin/perl
# $Id: dns_srv_imap,v 1.5 2016/08/15 01:24:20 gilles Exp gilles $
use strict ;
use warnings ;
use English ;
use Test::More ;
use Net::DNS ;
foreach my $email ( @ARGV ) {
my $domain = domain_name_of( $email ) ;
print "Domain for email $email: $domain\n" ;
my ( $host, $port ) = host_port_from_lookup_srv( '_imaps._tcp.' . $domain ) ;
$host ||= q{} ;
$port ||= q{} ;
print "IMAPS server name and port for $email: $host $port\n" ;
( $host, $port ) = host_port_from_lookup_srv( '_imap._tcp.' . $domain ) ;
$host ||= q{} ;
$port ||= q{} ;
print "IMAP server name and port for $email: $host $port\n" ;
}
tests_server_name_from_srv_string( ) ;
tests_server_port_from_srv_string( ) ;
tests_domain_name_of( ) ;
tests_host_port_ssl_from_user( ) ;
done_testing( ) ;
my $debug = 1 ;
sub host_port_ssl_from_user {
my $user = shift @ARG ;
if ( ! $user ) {
return ;
}
my $domain = domain_name_of( $user ) ;
if ( ! $domain ) {
return ;
}
my ( $host, $port ) = host_port_from_lookup_srv( qq{_imaps._tcp.$domain} ) ;
my $ssl = 1 ;
if ( $host and $port ) {
return ( $host, $port, $ssl ) ;
}
# fallback to imap in clear
$ssl = 0 ;
( $host, $port ) = host_port_from_lookup_srv( qq{_imap._tcp.$domain} ) ;
if ( $host and $port ) {
return ( $host, $port, $ssl ) ;
}
return ;
}
sub tests_host_port_ssl_from_user {
is( undef, host_port_ssl_from_user( ), 'host_port_ssl_from_user: no args => undef' ) ;
is_deeply( [qw( imap.gmail.com. 993 1 )], [host_port_ssl_from_user( 'gilles.lamiral@gmail.com' )],
'host_port_ssl_from_user: gilles.lamiral@gmail.com => imap.gmail.com. 993 1 (ssl)' ) ;
}
sub host_port_from_lookup_srv {
my $request = shift @ARG ;
my $lookup = lookup_srv_string( $request ) ;
if ( ! $lookup ) {
return ;
}
my $host = server_name_from_srv_string( $lookup ) ;
my $port = server_port_from_srv_string( $lookup ) ;
if( $host and $port ) {
return ( $host, $port ) ;
}
else {
return ;
}
}
sub domain_name_of_email {
my $email = shift ;
return( undef ) if ( not $email ) ;
my $domain ;
if ( $email =~ /^.*@([^@]+)$/ ) {
$domain = $1 ;
$debug and print "domain: $domain\n" ;
return( $domain ) ;
}
return ;
}
sub domain_name_of {
my $email = shift ;
return( undef ) if ( not $email ) ;
my $domain = domain_name_of_email( $email ) ;
if ( ! $domain ) {
$domain = $email ;
}
return( $domain ) ;
}
sub tests_domain_name_of {
ok( not( domain_name_of( '' ) ), 'domain_name_of: void => undef' ) ;
ok( not( domain_name_of( ) ), 'domain_name_of: undef => undef' ) ;
ok( 'foo' eq domain_name_of( 'foo' ), 'domain_name_of: foo => foo' ) ;
#ok( 'foo' eq domain_name_of( 'foo ' ), 'domain_name_of: foo => foo' ) ;
#ok( 'foo' eq domain_name_of( 'foo ' ), 'domain_name_of: foo => foo' ) ;
ok( 'example.com' eq domain_name_of( 'foo@example.com' ), 'domain_name_of: foo@example.com => example.com' ) ;
ok( 'example.com' eq domain_name_of( '@foo@example.com' ), 'domain_name_of: @foo@example.com => example.com' ) ;
ok( 'example.com' eq domain_name_of( 'bar@foo@example.com' ), 'domain_name_of: bar@foo@example.com => example.com' ) ;
}
sub lookup_srv_string {
my $name = shift ;
my $resolver = new Net::DNS::Resolver( ) ;
my $reply = $resolver->query( $name, 'SRV' ) ;
my $string ;
if ( $reply ) {
#($reply->answer)[0]->print;
foreach my $rr ( $reply->answer ) {
$debug and print 'name: ' . $rr->name . "\n" ;
$debug and print 'class: ' . $rr->class . "\n" ;
$debug and print 'type: ' . $rr->type . "\n" ;
$debug and print 'ttl: ' . $rr->ttl . "\n" ;
$debug and print 'string: ' . $rr->string . "\n" ;
next if ( 'SRV' ne $rr->type ) ;
next if ( not( $rr->string ) ) ;
$string = $rr->string ;
return( $string ) ;
}
} else {
print "Query failed SRV for domain $name: ", $resolver->errorstring, "\n" ;
return( undef ) ;
}
return( $string ) ;
}
sub server_name_from_srv_string {
my $srv_string = shift ;
return( undef ) if ( not $srv_string ) ;
my $server_name = (split( /\s+/ , $srv_string ) )[7] ;
return( undef ) if ( '.' eq $server_name ) ;
return( $server_name ) ;
}
sub tests_server_name_from_srv_string {
ok( not( server_name_from_srv_string( '' ) ), 'server_name_from_srv_string: void' ) ;
ok( not( server_name_from_srv_string( ) ), 'server_name_from_srv_string: undef' ) ;
ok( 'imap.gmail.com.' eq
server_name_from_srv_string( '_imaps._tcp.gmail.com. 82466 IN SRV 5 0 993 imap.gmail.com.' ),
'server_name_from_srv_string: _imaps._tcp.gmail.com. => imap.gmail.com.' ) ;
ok( not( server_name_from_srv_string( '_imap._tcp.gmail.com. 81999 IN SRV 0 0 0 .' ) ),
'server_name_from_srv_string: _imap._tcp.gmail.com. => undef' ) ;
return( ) ;
}
sub server_port_from_srv_string {
my $srv_string = shift ;
return( undef ) if ( not $srv_string ) ;
my $server_port = (split( /\s+/ , $srv_string ) )[6] ;
return( undef ) if ( 0 == $server_port ) ;
return( $server_port ) ;
}
sub tests_server_port_from_srv_string {
ok( not( server_port_from_srv_string( '' ) ), 'server_port_from_srv_string: void' ) ;
ok( not( server_port_from_srv_string( ) ), 'server_port_from_srv_string: undef' ) ;
ok( '993' eq
server_port_from_srv_string( '_imaps._tcp.gmail.com. 82466 IN SRV 5 0 993 imap.gmail.com.' ),
'server_port_from_srv_string: _imaps._tcp.gmail.com. => 993' ) ;
ok( not( server_port_from_srv_string( '_imap._tcp.gmail.com. 81999 IN SRV 0 0 0 .' ) ),
'server_port_from_srv_string: _imap._tcp.gmail.com. => undef' ) ;
return( ) ;
}

249
W/learn/dns_srv_imap.tdy Executable file
View file

@ -0,0 +1,249 @@
#!/usr/bin/perl
# $Id: dns_srv_imap,v 1.5 2016/08/15 01:24:20 gilles Exp gilles $
use strict;
use warnings;
use English;
use Test::More;
use Net::DNS;
# _imaps._tcp.gmail.com. 86183 IN SRV 5 0 993 imap.gmail.com.
lookup_srv_string('_imaps._tcp.gmail.com');
#lookup_srv( '_imap._tcp.gmail.com' ) ;
#lookup_srv( '_imaps._tcp.lamiral.info' ) ;
#lookup_srv( '_imap._tcp.lamiral.info' ) ;
foreach my $email (@ARGV) {
my $domain = domain_name_of($email);
print "Domain for email $email: $domain\n";
my ( $host, $port ) = host_port_from_lookup_srv( '_imaps._tcp.' . $domain );
$host ||= q{};
$port ||= q{};
print "IMAPS server name and port for $email: $host $port\n";
( $host, $port ) = host_port_from_lookup_srv( '_imap._tcp.' . $domain );
$host ||= q{};
$port ||= q{};
print "IMAP server name and port for $email: $host $port\n";
}
tests_server_name_from_srv_string();
tests_server_port_from_srv_string();
tests_domain_name_of();
tests_host_port_ssl_from_user();
done_testing();
my $debug = 1;
sub host_port_ssl_from_user {
my $user = shift @ARG;
if ( !$user ) {
return;
}
my $domain = domain_name_of($user);
if ( !$domain ) {
return;
}
my ( $host, $port ) = host_port_from_lookup_srv(qq{_imaps._tcp.$domain});
my $ssl = 1;
if ( $host and $port ) {
return ( $host, $port, $ssl );
}
# fallback to imap in clear
$ssl = 0;
( $host, $port ) = host_port_from_lookup_srv(qq{_imap._tcp.$domain});
if ( $host and $port ) {
return ( $host, $port, $ssl );
}
return;
}
sub tests_host_port_ssl_from_user {
is( undef, host_port_ssl_from_user(),
'host_port_ssl_from_user: no args => undef' );
is_deeply(
[qw( imap.gmail.com. 993 1 )],
[ host_port_ssl_from_user('gilles.lamiral@gmail.com') ],
'host_port_ssl_from_user: gilles.lamiral@gmail.com => imap.gmail.com. 993 1 (ssl)'
);
}
sub host_port_from_lookup_srv {
my $request = shift @ARG;
my $lookup = lookup_srv_string($request);
if ( !$lookup ) {
return;
}
my $host = server_name_from_srv_string($lookup);
my $port = server_port_from_srv_string($lookup);
if ( $host and $port ) {
return ( $host, $port );
}
else {
return;
}
}
sub domain_name_of_email {
my $email = shift;
return (undef) if ( not $email );
my $domain;
if ( $email =~ /^.*@([^@]+)$/ ) {
$domain = $1;
$debug and print "domain: $domain\n";
return ($domain);
}
return;
}
sub domain_name_of {
my $email = shift;
return (undef) if ( not $email );
my $domain = domain_name_of_email($email);
if ( !$domain ) {
$domain = $email;
}
return ($domain);
}
sub tests_domain_name_of {
ok( not( domain_name_of('') ), 'domain_name_of: void => undef' );
ok( not( domain_name_of() ), 'domain_name_of: undef => undef' );
ok( 'foo' eq domain_name_of('foo'), 'domain_name_of: foo => foo' );
#ok( 'foo' eq domain_name_of( 'foo ' ), 'domain_name_of: foo => foo' ) ;
#ok( 'foo' eq domain_name_of( 'foo ' ), 'domain_name_of: foo => foo' ) ;
ok(
'example.com' eq domain_name_of('foo@example.com'),
'domain_name_of: foo@example.com => example.com'
);
ok(
'example.com' eq domain_name_of('@foo@example.com'),
'domain_name_of: @foo@example.com => example.com'
);
ok(
'example.com' eq domain_name_of('bar@foo@example.com'),
'domain_name_of: bar@foo@example.com => example.com'
);
}
sub lookup_srv_string {
my $name = shift;
my $resolver = new Net::DNS::Resolver();
my $reply = $resolver->query( $name, 'SRV' );
my $string;
if ($reply) {
#($reply->answer)[0]->print;
foreach my $rr ( $reply->answer ) {
$debug and print 'name: ' . $rr->name . "\n";
$debug and print 'class: ' . $rr->class . "\n";
$debug and print 'type: ' . $rr->type . "\n";
$debug and print 'ttl: ' . $rr->ttl . "\n";
$debug and print 'string: ' . $rr->string . "\n";
next if ( 'SRV' ne $rr->type );
next if ( not( $rr->string ) );
$string = $rr->string;
return ($string);
}
}
else {
print "Query failed SRV for domain $name: ", $resolver->errorstring,
"\n";
return (undef);
}
return ($string);
}
sub server_name_from_srv_string {
my $srv_string = shift;
return (undef) if ( not $srv_string );
my $server_name = ( split( /\s+/, $srv_string ) )[7];
return (undef) if ( '.' eq $server_name );
return ($server_name);
}
sub tests_server_name_from_srv_string {
ok(
not( server_name_from_srv_string('') ),
'server_name_from_srv_string: void'
);
ok(
not( server_name_from_srv_string() ),
'server_name_from_srv_string: undef'
);
ok(
'imap.gmail.com.' eq server_name_from_srv_string(
'_imaps._tcp.gmail.com. 82466 IN SRV 5 0 993 imap.gmail.com.'
),
'server_name_from_srv_string: _imaps._tcp.gmail.com. => imap.gmail.com.'
);
ok(
not(
server_name_from_srv_string(
'_imap._tcp.gmail.com. 81999 IN SRV 0 0 0 .')
),
'server_name_from_srv_string: _imap._tcp.gmail.com. => undef'
);
return ();
}
sub server_port_from_srv_string {
my $srv_string = shift;
return (undef) if ( not $srv_string );
my $server_port = ( split( /\s+/, $srv_string ) )[6];
return (undef) if ( 0 == $server_port );
return ($server_port);
}
sub tests_server_port_from_srv_string {
ok(
not( server_port_from_srv_string('') ),
'server_port_from_srv_string: void'
);
ok(
not( server_port_from_srv_string() ),
'server_port_from_srv_string: undef'
);
ok(
'993' eq server_port_from_srv_string(
'_imaps._tcp.gmail.com. 82466 IN SRV 5 0 993 imap.gmail.com.'
),
'server_port_from_srv_string: _imaps._tcp.gmail.com. => 993'
);
ok(
not(
server_port_from_srv_string(
'_imap._tcp.gmail.com. 81999 IN SRV 0 0 0 .')
),
'server_port_from_srv_string: _imap._tcp.gmail.com. => undef'
);
return ();
}

9
W/learn/imap_utf7_tests Executable file
View file

@ -0,0 +1,9 @@
#!/bin/sh
echo 收件箱
touch './+ZyhnUA-'

4
W/learn/mi2
View file

@ -1,4 +0,0 @@
#!/bin/sh
perl -I../Mail-IMAPClient-2.2.9 "$@"

4
W/learn/mi3
View file

@ -1,4 +0,0 @@
#!/bin/sh
perl -I../Mail-IMAPClient-3.28/lib "$@"

46
W/learn/net_dns_srv_imap
View file

@ -1,46 +0,0 @@
#!/usr/bin/perl
use strict ;
use warnings ;
use Net::DNS;
lookup_srv( '_imaps._tcp.gmail.com' ) ;
lookup_srv( '_imap._tcp.gmail.com' ) ;
sub lookup_srv {
my $name = shift ;
my $resolver = new Net::DNS::Resolver( ) ;
my $reply = $resolver->query( $name, 'SRV' ) ;
if ( $reply ) {
#($reply->answer)[0]->print;
foreach my $rr ($reply->answer) {
print $rr->name . "\n" ;
print $rr->class . "\n" ;
print $rr->type . "\n" ;
print $rr->ttl . "\n" ;
print $rr->string . "\n" ;
}
} else {
print "query failed: ", $resolver->errorstring, "\n";
}
}
sub lookup_address {
# Perform a lookup, using the searchlist if appropriate.
my $resolver = new Net::DNS::Resolver( ) ;
my $reply = $resolver->search( 'example.com' );
if ($reply) {
foreach my $rr ($reply->answer) {
next unless $rr->type eq "A";
print $rr->address, "\n";
}
} else {
warn "query failed: ", $resolver->errorstring, "\n";
}
}

16
W/learn/perlcritic_ProhibitInterpolationOfLiterals Executable file
View file

@ -0,0 +1,16 @@
#!/usr/bin/perl
# $Id: perlcritic_ProhibitInterpolationOfLiterals,v 1.3 2016/06/15 22:18:23 gilles Exp gilles $
use strict;
use warnings;
our $VERSION = q$Revision: 1.3 $;
if ( "\1foo" eq '\1foo' ) {
print "equal\n";
}
else {
print "not equal\n";
}

16
W/learn/perlcritic_ProhibitInterpolationOfLiterals_2 Executable file
View file

@ -0,0 +1,16 @@
#!/usr/bin/perl
# $Id: perlcritic_ProhibitInterpolationOfLiterals,v 1.3 2016/06/15 22:18:23 gilles Exp gilles $
use strict;
use warnings;
our $VERSION = q$Revision: 1.3 $;
if ( "\afoo" eq '\afoo' ) {
print "equal\n";
}
else {
print "not equal\n";
}

27
W/learn/print Executable file
View file

@ -0,0 +1,27 @@
#!/usr/bin/perl
# $Id: print,v 1.1 2016/06/16 19:10:04 gilles Exp gilles $
use strict;
use warnings;
use English;
our $VERSION = q$Revision: 1.1 $;
# myprint( STDOUT "Hello\n" ) ; # DO NOT WORK
open my $stdout, ">-" ;
#myprint( $stdout, "Hello from myprint & filehandle\n" ) ; # DO NOT WORK
close $stdout ;
myprint( "Hello\n" ) ; # WORKS
myprint( << 'EOF' ) ;
lalala
myprint inline
EOF
exit;
sub myprint { print @ARG ; }

24
W/learn/quotes Executable file
View file

@ -0,0 +1,24 @@
#!/usr/bin/perl
use strict ;
use warnings ;
print "123456789\\" ."\n" ;
print '123456789\\' ."\n" ;
print "123456789\"" ."\n" ;
print '123456789\'' ."\n" ;
print "\\" ."\n" ;
print q{\\} ."\n" ;
print qq{ !"#$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefg\n} ;
print "\1auth=Bearer " . "\1\1" . "\n" ;
print '\1auth=Bearer ' . '\1\1' . "\n" ;
if ( "\1foo" eq '\1foo' ) {
print "equal\n" ;
}else{
print "not equal\n" ;
}

12
W/learn/ref Executable file
View file

@ -0,0 +1,12 @@
#!/usr/bin/perl
use strict;
use warnings;
my $debug = 'val_debug' ;
print "ref(\\\$debug)=" . ref(\$debug) . "\n" ;
print "ref(\$debug)=" . ref($debug) . "\n" ;
print "\n$debug=$debug\n" ;

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

0
W/learn/tmp/收件箱 Normal file
View file

21
W/learn/utf7_to_utf7imap Executable file
View file

@ -0,0 +1,21 @@
#!/usr/bin/perl
# $Id: utf7_to_utf7imap,v 1.1 2016/08/08 22:57:44 gilles Exp gilles $
use strict ;
use warnings ;
foreach my $str_utf7 ( @ARGV ) {
my $str_utf7imap = utf7_to_uft7imap( $str_utf7 ) ;
print qq{mv '$str_utf7' '$str_utf7imap'\n} ;
}
# http://cpansearch.perl.org/src/FABPOT/Unicode-IMAPUtf7-2.01/lib/Unicode/IMAPUtf7.pm
sub utf7_to_uft7imap {
my ( $s ) = @_ ;
$s =~ s/\+([^\/&\-]*)\/([^\/\-&]*)\-/\+$1,$2\-/g ;
$s =~ s/&/&\-/g ;
$s =~ s/\+([^+\-]+)?\-/&$1\-/g ;
return( $s ) ;
}