isync/src/run-tests.pl

739 lines
18 KiB
Perl
Raw Normal View History

2005-12-22 18:06:25 +00:00
#! /usr/bin/perl -w
2006-02-11 19:48:44 +00:00
#
# Copyright (C) 2006,2013 Oswald Buddenhagen <ossi@users.sf.net>
2006-02-11 19:48:44 +00:00
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# 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 the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
2006-02-11 19:48:44 +00:00
#
2005-12-22 18:06:25 +00:00
2017-03-14 10:10:35 +00:00
use warnings;
2005-12-22 18:06:25 +00:00
use strict;
use Cwd;
2005-12-22 18:06:25 +00:00
use File::Path;
use File::Temp 'tempdir';
2005-12-22 18:06:25 +00:00
my $use_vg = $ENV{USE_VALGRIND};
my $mbsync = getcwd()."/mbsync";
if (!-d "tmp") {
unlink "tmp";
my $tdir = tempdir();
symlink $tdir, "tmp" or die "Cannot symlink temp directory: $!\n";
}
2005-12-22 18:06:25 +00:00
chdir "tmp" or die "Cannot enter temp direcory.\n";
sub show($$$);
sub test($$$@);
2005-12-22 18:06:25 +00:00
################################################################################
2017-03-30 17:39:14 +00:00
# Format of the test defs: [ master, slave, state ]
# master/slave: [ maxuid, { seq, uid, flags }... ]
# state: [ MaxPulledUid, MaxExpiredMasterUid, MaxPushedUid, { muid, suid, flags }... ]
2005-12-26 16:01:42 +00:00
# generic syncing tests
2005-12-22 18:06:25 +00:00
my @x01 = (
[ 9,
1, 1, "F", 2, 2, "", 3, 3, "FS", 4, 4, "", 5, 5, "T", 6, 6, "F", 7, 7, "FT", 9, 9, "" ],
[ 9,
1, 1, "", 2, 2, "F", 3, 3, "F", 4, 4, "", 5, 5, "", 7, 7, "", 8, 8, "", 10, 9, "" ],
2005-12-22 18:06:25 +00:00
[ 8, 0, 0,
1, 1, "", 2, 2, "", 3, 3, "", 4, 4, "", 5, 5, "", 6, 6, "", 7, 7, "", 8, 8, "" ],
);
my @O01 = ("", "", "");
#show("01", "01", "01");
2005-12-22 18:06:25 +00:00
my @X01 = (
[ 10,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 5, 5, "T", 6, 6, "FT", 7, 7, "FT", 9, 9, "", 10, 10, "" ],
[ 10,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 5, 5, "T", 7, 7, "FT", 8, 8, "T", 9, 10, "", 10, 9, "" ],
[ 9, 0, 9,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 5, 5, "T", 6, 0, "", 7, 7, "FT", 0, 8, "", 10, 9, "", 9, 10, "" ],
);
test("full", \@x01, \@X01, @O01);
2005-12-22 18:06:25 +00:00
my @O02 = ("", "", "Expunge Both\n");
#show("01", "02", "02");
2005-12-22 18:06:25 +00:00
my @X02 = (
[ 10,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 9, 9, "", 10, 10, "" ],
[ 10,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 9, 10, "", 10, 9, "" ],
[ 9, 0, 9,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 10, 9, "", 9, 10, "" ],
);
test("full + expunge both", \@x01, \@X02, @O02);
2005-12-22 18:06:25 +00:00
my @O03 = ("", "", "Expunge Slave\n");
#show("01", "03", "03");
2005-12-22 18:06:25 +00:00
my @X03 = (
[ 10,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 5, 5, "T", 6, 6, "FT", 7, 7, "FT", 9, 9, "", 10, 10, "" ],
[ 10,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 9, 10, "", 10, 9, "" ],
[ 9, 0, 9,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 5, 0, "T", 6, 0, "", 7, 0, "T", 10, 9, "", 9, 10, "" ],
2005-12-22 18:06:25 +00:00
);
test("full + expunge slave", \@x01, \@X03, @O03);
2005-12-22 18:06:25 +00:00
my @O04 = ("", "", "Sync Pull\n");
#show("01", "04", "04");
2005-12-22 18:06:25 +00:00
my @X04 = (
[ 9,
1, 1, "F", 2, 2, "", 3, 3, "FS", 4, 4, "", 5, 5, "T", 6, 6, "F", 7, 7, "FT", 9, 9, "" ],
[ 10,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 5, 5, "T", 7, 7, "FT", 8, 8, "T", 9, 10, "", 10, 9, "" ],
2005-12-22 18:06:25 +00:00
[ 9, 0, 0,
1, 1, "F", 2, 2, "", 3, 3, "FS", 4, 4, "", 5, 5, "T", 6, 6, "", 7, 7, "FT", 0, 8, "", 9, 10, "" ],
2005-12-22 18:06:25 +00:00
);
test("pull", \@x01, \@X04, @O04);
2005-12-22 18:06:25 +00:00
my @O05 = ("", "", "Sync Flags\n");
#show("01", "05", "05");
2005-12-22 18:06:25 +00:00
my @X05 = (
[ 9,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 5, 5, "T", 6, 6, "F", 7, 7, "FT", 9, 9, "" ],
[ 9,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 5, 5, "T", 7, 7, "FT", 8, 8, "", 10, 9, "" ],
2005-12-22 18:06:25 +00:00
[ 8, 0, 0,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 5, 5, "T", 6, 6, "", 7, 7, "FT", 8, 8, "" ],
);
test("flags", \@x01, \@X05, @O05);
2005-12-22 18:06:25 +00:00
my @O06 = ("", "", "Sync Delete\n");
#show("01", "06", "06");
2005-12-22 18:06:25 +00:00
my @X06 = (
[ 9,
1, 1, "F", 2, 2, "", 3, 3, "FS", 4, 4, "", 5, 5, "T", 6, 6, "FT", 7, 7, "FT", 9, 9, "" ],
[ 9,
1, 1, "", 2, 2, "F", 3, 3, "F", 4, 4, "", 5, 5, "", 7, 7, "", 8, 8, "T", 10, 9, "" ],
2005-12-22 18:06:25 +00:00
[ 8, 0, 0,
1, 1, "", 2, 2, "", 3, 3, "", 4, 4, "", 5, 5, "", 6, 0, "", 7, 7, "", 0, 8, "" ],
);
test("deletions", \@x01, \@X06, @O06);
2005-12-22 18:06:25 +00:00
my @O07 = ("", "", "Sync New\n");
#show("01", "07", "07");
2005-12-22 18:06:25 +00:00
my @X07 = (
[ 10,
1, 1, "F", 2, 2, "", 3, 3, "FS", 4, 4, "", 5, 5, "T", 6, 6, "F", 7, 7, "FT", 9, 9, "", 10, 10, "" ],
[ 10,
1, 1, "", 2, 2, "F", 3, 3, "F", 4, 4, "", 5, 5, "", 7, 7, "", 8, 8, "", 9, 10, "", 10, 9, "" ],
[ 9, 0, 9,
1, 1, "", 2, 2, "", 3, 3, "", 4, 4, "", 5, 5, "", 6, 6, "", 7, 7, "", 8, 8, "", 10, 9, "", 9, 10, "" ],
);
test("new", \@x01, \@X07, @O07);
2005-12-22 18:06:25 +00:00
my @O08 = ("", "", "Sync PushFlags PullDelete\n");
#show("01", "08", "08");
2005-12-22 18:06:25 +00:00
my @X08 = (
[ 9,
1, 1, "F", 2, 2, "F", 3, 3, "FS", 4, 4, "", 5, 5, "T", 6, 6, "F", 7, 7, "FT", 9, 9, "" ],
[ 9,
1, 1, "", 2, 2, "F", 3, 3, "F", 4, 4, "", 5, 5, "", 7, 7, "", 8, 8, "T", 10, 9, "" ],
2005-12-22 18:06:25 +00:00
[ 8, 0, 0,
1, 1, "", 2, 2, "F", 3, 3, "F", 4, 4, "", 5, 5, "", 6, 6, "", 7, 7, "", 0, 8, "" ],
);
test("push flags + pull deletions", \@x01, \@X08, @O08);
2005-12-22 18:06:25 +00:00
2005-12-26 16:01:42 +00:00
# size restriction tests
my @x10 = (
[ 2,
1, 1, "", 2, 2, "*" ],
[ 1,
3, 1, "*" ],
2005-12-26 16:01:42 +00:00
[ 0, 0, 0,
],
);
my @O11 = ("MaxSize 1k\n", "MaxSize 1k\n", "");
#show("10", "11", "11");
2005-12-26 16:01:42 +00:00
my @X11 = (
[ 2,
1, 1, "", 2, 2, "*" ],
[ 2,
3, 1, "*", 1, 2, "" ],
[ 2, 0, 1,
0, 1, "^", 1, 2, "", 2, 0, "^" ],
2005-12-26 16:01:42 +00:00
);
test("max size", \@x10, \@X11, @O11);
2005-12-26 16:01:42 +00:00
my @O22 = ("", "MaxSize 1k\n", "");
#show("11", "22", "22");
2005-12-26 16:01:42 +00:00
my @X22 = (
[ 3,
1, 1, "", 2, 2, "*", 3, 3, "*" ],
[ 2,
3, 1, "*", 1, 2, "" ],
[ 2, 0, 1,
3, 1, "", 1, 2, "", 2, 0, "^" ],
2005-12-26 16:01:42 +00:00
);
test("slave max size", \@X11, \@X22, @O22);
2005-12-26 16:01:42 +00:00
2005-12-26 16:02:08 +00:00
# expiration tests
my @x30 = (
[ 6,
1, 1, "F", 2, 2, "", 3, 3, "S", 4, 4, "", 5, 5, "S", 6, 6, "" ],
2005-12-26 16:02:08 +00:00
[ 0,
],
[ 0, 0, 0,
],
);
my @O31 = ("", "", "MaxMessages 3\n");
#show("30", "31", "31");
2005-12-26 16:02:08 +00:00
my @X31 = (
[ 6,
1, 1, "F", 2, 2, "", 3, 3, "S", 4, 4, "", 5, 5, "S", 6, 6, "" ],
2005-12-26 16:02:08 +00:00
[ 5,
1, 1, "F", 2, 2, "", 4, 3, "", 5, 4, "S", 6, 5, "" ],
[ 6, 3, 0,
1, 1, "F", 2, 2, "", 4, 3, "", 5, 4, "S", 6, 5, "" ],
2005-12-26 16:02:08 +00:00
);
test("max messages", \@x30, \@X31, @O31);
2005-12-26 16:02:08 +00:00
2013-11-24 19:26:33 +00:00
my @O32 = ("", "", "MaxMessages 3\nExpireUnread yes\n");
#show("30", "32", "32");
my @X32 = (
[ 6,
1, 1, "F", 2, 2, "", 3, 3, "S", 4, 4, "", 5, 5, "S", 6, 6, "" ],
[ 4,
1, 1, "F", 4, 2, "", 5, 3, "S", 6, 4, "" ],
[ 6, 3, 0,
2013-11-24 19:26:33 +00:00
1, 1, "F", 4, 2, "", 5, 3, "S", 6, 4, "" ],
);
test("max messages vs. unread", \@x30, \@X32, @O32);
2005-12-26 16:02:08 +00:00
my @x50 = (
[ 6,
1, 1, "FS", 2, 2, "FS", 3, 3, "S", 4, 4, "", 5, 5, "", 6, 6, "" ],
[ 6,
1, 1, "S", 2, 2, "ST", 4, 4, "", 5, 5, "", 6, 6, "" ],
[ 6, 3, 0,
1, 1, "FS", 2, 2, "~S", 3, 3, "~S", 4, 4, "", 5, 5, "", 6, 6, "" ],
2005-12-26 16:02:08 +00:00
);
my @O51 = ("", "", "MaxMessages 3\nExpunge Both\n");
#show("50", "51", "51");
2005-12-26 16:02:08 +00:00
my @X51 = (
[ 6,
1, 1, "S", 2, 2, "FS", 3, 3, "S", 4, 4, "", 5, 5, "", 6, 6, "" ],
[ 6,
2, 2, "FS", 4, 4, "", 5, 5, "", 6, 6, "" ],
[ 6, 3, 0,
2, 2, "FS", 4, 4, "", 5, 5, "", 6, 6, "" ],
2005-12-26 16:02:08 +00:00
);
2017-02-15 10:45:52 +00:00
test("max messages + expunge", \@x50, \@X51, @O51);
2005-12-26 16:02:08 +00:00
2005-12-22 18:06:25 +00:00
################################################################################
print "OK.\n";
exit 0;
sub qm($)
{
shift;
s/\\/\\\\/g;
s/\"/\\"/g;
s/\"/\\"/g;
s/\n/\\n/g;
return $_;
}
# $master, $slave, $channel
sub writecfg($$$)
2005-12-22 18:06:25 +00:00
{
open(FILE, ">", ".mbsyncrc") or
die "Cannot open .mbsyncrc.\n";
print FILE
"FSync no
MaildirStore master
2005-12-22 18:06:25 +00:00
Path ./
Inbox ./master
".shift()."
MaildirStore slave
Path ./
Inbox ./slave
".shift()."
Channel test
Master :master:
Slave :slave:
SyncState *
".shift();
close FILE;
}
sub killcfg()
{
unlink $_ for (glob("*.log"));
2005-12-22 18:06:25 +00:00
unlink ".mbsyncrc";
}
# $options
sub runsync($$)
{
my ($flags, $file) = @_;
my $cmd;
if ($use_vg) {
$cmd = "valgrind -q --error-exitcode=1 ";
} else {
$flags .= " -D";
}
$cmd .= "$mbsync -Z $flags -c .mbsyncrc test";
open FILE, "$cmd 2>&1 |";
my @out = <FILE>;
close FILE or push(@out, $! ? "*** error closing mbsync: $!\n" : "*** mbsync exited with signal ".($?&127).", code ".($?>>8)."\n");
if ($file) {
open FILE, ">$file" or die("Cannot create $file: $!\n");
print FILE @out;
close FILE;
}
return $?, @out;
2005-12-22 18:06:25 +00:00
}
2005-12-22 18:06:25 +00:00
# $path
sub readbox($)
{
my $bn = shift;
(-d $bn) or
die "No mailbox '$bn'.\n";
(-d $bn."/tmp" and -d $bn."/new" and -d $bn."/cur") or
die "Invalid mailbox '$bn'.\n";
open(FILE, "<", $bn."/.uidvalidity") or die "Cannot read UID validity of mailbox '$bn'.\n";
my $dummy = <FILE>;
chomp(my $mu = <FILE>);
close FILE;
my %ms = ();
for my $d ("cur", "new") {
opendir(DIR, $bn."/".$d) or next;
for my $f (grep(!/^\.\.?$/, readdir(DIR))) {
my ($uid, $flg, $num);
if ($f =~ /^\d+\.\d+_\d+\.[-[:alnum:]]+,U=(\d+):2,(.*)$/) {
($uid, $flg) = ($1, $2);
} else {
print STDERR "unrecognided file name '$f' in '$bn'.\n";
exit 1;
}
open(FILE, "<", $bn."/".$d."/".$f) or die "Cannot read message '$f' in '$bn'.\n";
2005-12-26 16:01:42 +00:00
my $sz = 0;
2005-12-22 18:06:25 +00:00
while (<FILE>) {
/^Subject: (\d+)$/ && ($num = $1);
2005-12-26 16:01:42 +00:00
$sz += length($_);
2005-12-22 18:06:25 +00:00
}
close FILE;
if (!defined($num)) {
print STDERR "message '$f' in '$bn' has no identifier.\n";
exit 1;
}
@{ $ms{$uid} } = ($num, $flg.($sz>1000?"*":""));
2005-12-22 18:06:25 +00:00
}
}
return ($mu, %ms);
}
# $boxname
# Output:
# [ maxuid,
# serial, uid, "flags", ... ],
sub showbox($)
{
my ($bn) = @_;
my ($mu, %ms) = readbox($bn);
my @MS = ($mu);
for my $uid (sort { $ms{$a}[0] <=> $ms{$b}[0] } keys %ms) {
push @MS, $ms{$uid}[0], $uid, $ms{$uid}[1];
}
printbox($bn, @MS);
}
# $filename
# Output:
# [ maxuid[M], mmaxxuid, maxuid[S],
# uid[M], uid[S], "flags", ... ],
sub showstate($)
{
my ($fn) = @_;
if (!open(FILE, "<", $fn)) {
print STDERR " Cannot read sync state $fn: $!\n";
return;
}
chomp(my @ls = <FILE>);
close FILE;
my %hdr;
OUTER: while (1) {
while (@ls) {
$_ = shift(@ls);
last OUTER if (!length($_));
if (!/^([^ ]+) (\d+)$/) {
print STDERR "Malformed sync state header entry: $_\n";
close FILE;
return;
}
$hdr{$1} = $2;
}
print STDERR "Unterminated sync state header.\n";
close FILE;
return;
}
my @T = ($hdr{'MaxPulledUid'} // "missing",
$hdr{'MaxExpiredMasterUid'} // "0",
$hdr{'MaxPushedUid'} // "missing");
for (@ls) {
/^(\d+) (\d+) (.*)$/;
push @T, $1, $2, $3;
}
printstate(@T);
}
# $filename
sub showchan($)
{
my ($fn) = @_;
showbox("master");
showbox("slave");
showstate($fn);
}
# $source_state_name, $target_state_name, $configs_name
sub show($$$)
{
my ($sx, $tx, $sfxn) = @_;
my (@sp, @sfx);
eval "\@sp = \@x$sx";
eval "\@sfx = \@O$sfxn";
mkchan($sp[0], $sp[1], @{ $sp[2] });
print "my \@x$sx = (\n";
showchan("slave/.mbsyncstate");
print ");\n";
&writecfg(@sfx);
runsync("", "");
killcfg();
print "my \@X$tx = (\n";
showchan("slave/.mbsyncstate");
print ");\n";
print "test(\"\", \\\@x$sx, \\\@X$tx, \@O$sfxn);\n\n";
rmtree "slave";
rmtree "master";
}
2005-12-22 18:06:25 +00:00
# $boxname, $maxuid, @msgs
sub mkbox($$@)
{
my ($bn, $mu, @ms) = @_;
rmtree($bn);
(mkdir($bn) and mkdir($bn."/tmp") and mkdir($bn."/new") and mkdir($bn."/cur")) or
die "Cannot create mailbox $bn.\n";
open(FILE, ">", $bn."/.uidvalidity") or die "Cannot create UID validity for mailbox $bn.\n";
print FILE "1\n$mu\n";
close FILE;
while (@ms) {
my ($num, $uid, $flg) = (shift @ms, shift @ms, shift @ms);
2005-12-26 16:01:42 +00:00
my $big = $flg =~ s/\*//;
open(FILE, ">", $bn."/".($flg =~ /S/ ? "cur" : "new")."/0.1_".$num.".local,U=".$uid.":2,".$flg) or
2005-12-22 18:06:25 +00:00
die "Cannot create message $num in mailbox $bn.\n";
2005-12-26 16:01:42 +00:00
print FILE "From: foo\nTo: bar\nDate: Thu, 1 Jan 1970 00:00:00 +0000\nSubject: $num\n\n".(("A"x50)."\n")x($big*30);
2005-12-22 18:06:25 +00:00
close FILE;
}
}
# \@master, \@slave, @syncstate
sub mkchan($$@)
{
my ($m, $s, @t) = @_;
&mkbox("master", @{ $m });
&mkbox("slave", @{ $s });
open(FILE, ">", "slave/.mbsyncstate") or
die "Cannot create sync state.\n";
print FILE "MasterUidValidity 1\nMaxPulledUid ".shift(@t)."\n".
"SlaveUidValidity 1\nMaxExpiredMasterUid ".shift(@t)."\nMaxPushedUid ".shift(@t)."\n\n";
2005-12-22 18:06:25 +00:00
while (@t) {
print FILE shift(@t)." ".shift(@t)." ".shift(@t)."\n";
}
close FILE;
}
2019-12-29 10:59:47 +00:00
# $boxname, $maxuid, @msgs
sub ckbox($$@)
2005-12-22 18:06:25 +00:00
{
my ($bn, $MU, @MS) = @_;
2005-12-22 18:06:25 +00:00
my ($mu, %ms) = readbox($bn);
if ($mu != $MU) {
2013-11-16 12:41:27 +00:00
print STDERR "MAXUID mismatch for '$bn' (got $mu, wanted $MU).\n";
return 1;
2005-12-22 18:06:25 +00:00
}
while (@MS) {
my ($num, $uid, $flg) = (shift @MS, shift @MS, shift @MS);
my $m = delete $ms{$uid};
if (!defined $m) {
print STDERR "No message $bn:$uid.\n";
return 1;
2005-12-22 18:06:25 +00:00
}
if ($$m[0] ne $num) {
print STDERR "Subject mismatch for $bn:$uid.\n";
return 1;
2005-12-22 18:06:25 +00:00
}
if ($$m[1] ne $flg) {
print STDERR "Flag mismatch for $bn:$uid.\n";
return 1;
2005-12-22 18:06:25 +00:00
}
2005-12-26 15:58:12 +00:00
}
if (%ms) {
print STDERR "Excess messages in '$bn': ".join(", ", sort({$a <=> $b } keys(%ms))).".\n";
return 1;
2005-12-22 18:06:25 +00:00
}
return 0;
2005-12-22 18:06:25 +00:00
}
# $filename, @syncstate
sub ckstate($@)
2005-12-22 18:06:25 +00:00
{
my ($fn, $mmaxuid, $mmaxxuid, $smaxuid, @T) = @_;
my %hdr;
$hdr{'MasterUidValidity'} = "1";
$hdr{'SlaveUidValidity'} = "1";
$hdr{'MaxPulledUid'} = $mmaxuid;
$hdr{'MaxPushedUid'} = $smaxuid;
$hdr{'MaxExpiredMasterUid'} = $mmaxxuid if ($mmaxxuid ne 0);
open(FILE, "<", $fn) or die "Cannot read sync state $fn.\n";
chomp(my @ls = <FILE>);
2005-12-22 18:06:25 +00:00
close FILE;
OUTER: while (1) {
while (@ls) {
my $l = shift(@ls);
last OUTER if (!length($l));
if ($l !~ /^([^ ]+) (\d+)$/) {
print STDERR "Malformed sync state header entry: $l\n";
return 1;
}
my $want = delete $hdr{$1};
if (!defined($want)) {
print STDERR "Unexpected sync state header entry: $1\n";
2013-11-16 12:41:27 +00:00
return 1;
}
if ($2 != $want) {
print STDERR "Sync state header entry $1 mismatch: got $2, wanted $want\n";
return 1;
}
2005-12-22 18:06:25 +00:00
}
print STDERR "Unterminated sync state header.\n";
return 1;
}
my @ky = keys %hdr;
if (@ky) {
print STDERR "Keys missing from sync state header: @ky\n";
return 1;
}
for my $l (@ls) {
if (!@T) {
print STDERR "Excess sync state entry: '$l'.\n";
2013-11-16 12:41:27 +00:00
return 1;
}
my $xl = shift(@T)." ".shift(@T)." ".shift(@T);
if ($l ne $xl) {
print STDERR "Sync state entry mismatch: '$l' instead of '$xl'.\n";
return 1;
}
}
if (@T) {
print STDERR "Missing sync state entry: '".shift(@T)." ".shift(@T)." ".shift(@T)."'.\n";
return 1;
2005-12-22 18:06:25 +00:00
}
return 0;
}
# $statefile, \@chan_state
sub ckchan($$)
{
my ($F, $cs) = @_;
my $rslt = ckstate($F, @{ $$cs[2] });
$rslt |= &ckbox("master", @{ $$cs[0] });
$rslt |= &ckbox("slave", @{ $$cs[1] });
return $rslt;
2005-12-22 18:06:25 +00:00
}
sub printbox($$@)
2005-12-22 18:06:25 +00:00
{
my ($bn, $mu, @ms) = @_;
2005-12-22 18:06:25 +00:00
print " [ $mu,\n ";
2005-12-22 18:06:25 +00:00
my $frst = 1;
while (@ms) {
2005-12-22 18:06:25 +00:00
if ($frst) {
$frst = 0;
} else {
print ", ";
}
print shift(@ms).", ".shift(@ms).", \"".shift(@ms)."\"";
2005-12-22 18:06:25 +00:00
}
print " ],\n";
}
# @syncstate
sub printstate(@)
2005-12-22 18:06:25 +00:00
{
my (@t) = @_;
print " [ ".shift(@t).", ".shift(@t).", ".shift(@t).",\n ";
2005-12-22 18:06:25 +00:00
my $frst = 1;
while (@t) {
2005-12-22 18:06:25 +00:00
if ($frst) {
$frst = 0;
} else {
print ", ";
}
print((shift(@t) // "??").", ".(shift(@t) // "??").", \"".(shift(@t) // "??")."\"");
2005-12-22 18:06:25 +00:00
}
print " ],\n";
}
# \@chan_state
sub printchan($)
{
my ($cs) = @_;
&printbox("master", @{ $$cs[0] });
&printbox("slave", @{ $$cs[1] });
printstate(@{ $$cs[2] });
}
sub readfile($)
{
my ($file) = @_;
open(FILE, $file) or return;
my @nj = <FILE>;
close FILE;
return @nj;
}
# $title, \@source_state, \@target_state, @channel_configs
sub test($$$@)
2005-12-22 18:06:25 +00:00
{
my ($ttl, $sx, $tx, @sfx) = @_;
return 0 if (scalar(@ARGV) && !grep { $_ eq $ttl } @ARGV);
2013-11-03 11:59:50 +00:00
print "Testing: ".$ttl." ...\n";
&writecfg(@sfx);
mkchan($$sx[0], $$sx[1], @{ $$sx[2] });
my ($xc, @ret) = runsync("-J", "1-initial.log");
if ($xc || ckchan("slave/.mbsyncstate.new", $tx)) {
print "Input:\n";
printchan($sx);
print "Options:\n";
print " [ ".join(", ", map('"'.qm($_).'"', @sfx))." ]\n";
if (!$xc) {
print "Expected result:\n";
printchan($tx);
print "Actual result:\n";
showchan("slave/.mbsyncstate.new");
}
print "Debug output:\n";
print @ret;
exit 1;
}
my @nj = readfile("slave/.mbsyncstate.journal");
my ($jxc, @jret) = runsync("-0 --no-expunge", "2-replay.log");
if ($jxc || ckstate("slave/.mbsyncstate", @{ $$tx[2] })) {
print "Journal replay failed.\n";
print "Options:\n";
print " [ ".join(", ", map('"'.qm($_).'"', @sfx))." ], [ \"-0\", \"--no-expunge\" ]\n";
print "Old State:\n";
printstate(@{ $$sx[2] });
print "Journal:\n".join("", @nj)."\n";
if (!$jxc) {
print "Expected New State:\n";
printstate(@{ $$tx[2] });
print "New State:\n";
showstate("slave/.mbsyncstate");
}
2005-12-27 17:44:31 +00:00
print "Debug output:\n";
print @jret;
exit 1;
}
my ($ixc, @iret) = runsync("", "3-verify.log");
if ($ixc || ckchan("slave/.mbsyncstate", $tx)) {
print "Idempotence verification run failed.\n";
print "Input == Expected result:\n";
printchan($tx);
print "Options:\n";
print " [ ".join(", ", map('"'.qm($_).'"', @sfx))." ]\n";
if (!$ixc) {
print "Actual result:\n";
showchan("slave/.mbsyncstate");
}
print "Debug output:\n";
print @iret;
exit 1;
}
2005-12-22 18:06:25 +00:00
rmtree "slave";
rmtree "master";
my $njl = (@nj - 1) * 2;
for (my $l = 2; $l < $njl; $l++) {
mkchan($$sx[0], $$sx[1], @{ $$sx[2] });
my ($nxc, @nret) = runsync("-J$l", "4-interrupt.log");
if ($nxc != (100 + ($l & 1)) << 8) {
print "Interrupting at step $l/$njl failed.\n";
print "Debug output:\n";
print @nret;
exit 1;
}
($nxc, @nret) = runsync("-J", "5-resume.log");
if ($nxc || ckchan("slave/.mbsyncstate.new", $tx)) {
print "Resuming from step $l/$njl failed.\n";
print "Input:\n";
printchan($sx);
print "Options:\n";
print " [ ".join(", ", map('"'.qm($_).'"', @sfx))." ]\n";
my @nnj = readfile("slave/.mbsyncstate.journal");
print "Journal:\n".join("", @nnj[0..($l / 2 - 1)])."-------\n".join("", @nnj[($l / 2)..$#nnj])."\n";
print "Full journal:\n".join("", @nj)."\n";
if (!$nxc) {
print "Expected result:\n";
printchan($tx);
print "Actual result:\n";
showchan("slave/.mbsyncstate.new");
}
print "Debug output:\n";
print @nret;
exit 1;
}
rmtree "slave";
rmtree "master";
}
killcfg();
2005-12-22 18:06:25 +00:00
}