mirror of
https://github.com/imapsync/imapsync.git
synced 2025-06-05 12:17:16 +02:00
305 lines
7.6 KiB
Perl
Executable file
305 lines
7.6 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
my $uid;
|
|
|
|
use warnings;
|
|
use strict;
|
|
|
|
use Test::More;
|
|
use File::Temp 'tempfile';
|
|
|
|
my $debug = $ARGV[0];
|
|
|
|
my %parms;
|
|
my $range = 0;
|
|
my $uidplus = 0;
|
|
my $fast = 0;
|
|
|
|
BEGIN
|
|
{ open TST, 'test.txt'
|
|
or plan skip_all => 'test parameters not provided';
|
|
|
|
while(my $l = <TST>)
|
|
{ chomp $l;
|
|
my($p,$v) = split /\=/, $l, 2;
|
|
s/(?:^\s+)|(?:\s+$)//g for $p, $v;
|
|
$parms{$p} = $v if $v;
|
|
}
|
|
|
|
close TST;
|
|
|
|
foreach my $p ( qw/server user passed/ )
|
|
{ $parms{$p}
|
|
or plan skip_all => "missing value for $_"
|
|
}
|
|
|
|
plan tests => 40;
|
|
}
|
|
|
|
use_ok('Mail::IMAPClient');
|
|
|
|
my $imap = Mail::IMAPClient->new
|
|
( Server => $parms{server}
|
|
, Port => $parms{port}
|
|
, User => $parms{user}
|
|
, Password => $parms{passed}
|
|
, Authmechanism => $parms{authmechanism}
|
|
, Clear => 0
|
|
, Timeout => 30
|
|
, Fast_IO => $fast
|
|
, Uid => $uidplus
|
|
, Range => $range
|
|
|
|
, Debug => 1
|
|
, Debug_fh => ($debug ? IO::File->new('imap1.debug', 'w') : undef)
|
|
);
|
|
|
|
ok(defined $imap, 'created client');
|
|
die "Cannot log into $parms{server} as $parms{user}.\n"
|
|
. "Are server/user/password correct?\n" ;
|
|
|
|
isa_ok($imap, 'Mail::IMAPClient');
|
|
|
|
$imap->Debug_fh->autoflush() if $imap->Debug_fh ;
|
|
|
|
my $testmsg = <<__TEST_MSG;
|
|
Date: @{[$imap->Rfc822_date(time)]}
|
|
To: <$parms{user}\@$parms{server}>
|
|
From: Perl <$parms{user}\@$parms{server}>
|
|
Subject: Testing from pid $$
|
|
|
|
This is a test message generated by $0 during a 'make test' as part of
|
|
the installation of that nifty Mail::IMAPClient module from CPAN. Like
|
|
all things perl, it's way cool.
|
|
__TEST_MSG
|
|
|
|
my $sep = $imap->separator;
|
|
ok(defined $sep, "separator is '$sep'");
|
|
|
|
my $isparent = $imap->is_parent("INBOX") || 0;
|
|
my ($target, $target2) = $isparent
|
|
? ("INBOX${sep}IMAPClient_$$", "INBOX${sep}IMAPClient_2_$$")
|
|
: ("IMAPClient_$$", "IMAPClient_2_$$");
|
|
|
|
ok(1, "parent $isparent, target $target");
|
|
|
|
ok($imap->select('inbox'), "select inbox");
|
|
ok($imap->create($target), "create target");
|
|
|
|
if(!$imap->is_parent($target))
|
|
{ ok(1, "not parent, skipping quote test 1/3");
|
|
ok(1, "not parent, skipping quote test 2/3");
|
|
ok(1, "not parent, skipping quote test 3/3");
|
|
}
|
|
elsif( eval {$imap->create( qq[ $target${sep}has "quotes" ] )} )
|
|
{ ok(1, "supports quotes, create");
|
|
ok($imap->select( qq[$target${sep}has "quotes"] ), 'select');
|
|
$imap->close;
|
|
$imap->select('inbox');
|
|
ok($imap->delete(qq($target${sep}has "quotes")), 'delete');
|
|
}
|
|
else
|
|
{ if($imap->LastError =~ /NO Invalid.*name/)
|
|
{ ok(1, "$parms{server} doesn't support quotes in folder names") }
|
|
else { ok(0, "failed creation with quotes") }
|
|
ok(1, "skipping 1/2 tests");
|
|
ok(1, "skipping 2/2 tests");
|
|
}
|
|
|
|
ok($imap->exists($target), "exists $target");
|
|
ok($imap->create($target2), "create $target2");
|
|
ok($imap->exists($target2), "exists $target2");
|
|
|
|
$uid = $imap->append($target, $testmsg);
|
|
ok(defined $uid, "append test message to $target");
|
|
|
|
ok($imap->select($target), "select $target");
|
|
|
|
$target = ref $uid ? ($imap->search("ALL"))[0] : $uid;
|
|
my $size = $imap->size($target);
|
|
cmp_ok($size, '>', 0, "has size $size");
|
|
|
|
my $string = $imap->message_string($target);
|
|
ok($string, "returned string");
|
|
|
|
cmp_ok($size, '==', length($string), "string has size");
|
|
|
|
{ my ($fh, $fn) = tempfile UNLINK => 1;
|
|
ok($imap->message_to_file($fn, $target), "to file $fn");
|
|
|
|
cmp_ok(-s $fn, '==', $size, "correct size");
|
|
}
|
|
|
|
my $fields = $imap->search("HEADER","Message-id","NOT_A_MESSAGE_ID");
|
|
ok(!defined $fields, '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 $h = $imap->parse_headers(1, "Subject");
|
|
ok($h, "got subject");
|
|
like($h->{Subject}[0], qr/^Testing from pid/);
|
|
|
|
$imap->select($target);
|
|
my @hits = $imap->search(SUBJECT => 'Testing');
|
|
cmp_ok(scalar @hits, '==', 1);
|
|
|
|
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);
|
|
|
|
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);
|
|
$flagflag = 0;
|
|
foreach my $v (values(%$flaghash)){
|
|
$flagflag += grep /\\Deleted/, @$v;
|
|
}
|
|
cmp_ok($flagflag, '==', scalar @hits);
|
|
|
|
$imap->select($target2);
|
|
ok( $imap->delete_message(scalar($imap->search("ALL")))
|
|
&& $imap->close
|
|
&& imap->delete($target2) , "delete $target2");
|
|
|
|
$imap->select("INBOX");
|
|
$@ = ""; # clear $@
|
|
@hits = $imap->search
|
|
(BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED");
|
|
ok(!$@, 'search undeleted');
|
|
|
|
#
|
|
# Test migrate method
|
|
#
|
|
|
|
my $im2 = Mail::IMAPClient->new
|
|
( Server => $parms{server}
|
|
, Port => $parms{port}
|
|
, User => $parms{user}
|
|
, Password=> $parms{passed}
|
|
, Authmechanism => $parms{authmechanism}
|
|
, Clear => 0,
|
|
, Timeout => 30,
|
|
, Debug => $debug
|
|
, Debug_fh => ($debug ? IO::File->new(">./imap2.debug") : undef)
|
|
, Fast_IO => $fast
|
|
, Uid => $uidplus
|
|
);
|
|
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: $@";
|
|
|
|
cmp_ok($@, 'eq', '');
|
|
|
|
#
|
|
#
|
|
#
|
|
|
|
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
|
|
}
|
|
|
|
cmp_ok($@, '==', '');
|
|
cmp_ok($total_bytes1, '==', $total_bytes2, 'size source==target');
|
|
|
|
# cleanup
|
|
$im2->select($migtarget);
|
|
$im2->delete_message(@{$im2->messages})
|
|
if $im2->message_count;
|
|
$im2->close;
|
|
$im2->delete($migtarget);
|
|
$im2->logout;
|
|
|
|
#
|
|
# Test IDLE
|
|
#
|
|
|
|
if($imap->has_capability("IDLE") )
|
|
{ eval { my $idle = $imap->idle; sleep 1; $imap->done($idle) };
|
|
cmp_ok($@, 'eq', '');
|
|
}
|
|
else
|
|
{ ok(1, "idle not supported");
|
|
}
|
|
|
|
$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) ;
|
|
}
|