On Fri, May 27, 2011 at 01:07:27PM -0500, Blake Hudson wrote:
> I'm looking to create a tool that will double check replication,
> backups, and migrations to ensure that they are working correctly and no
> corruption has crept in.
>
> The tool MUST:
> 1) Work via IMAP
> 2) Compare a single user's mailbox between 2 servers and report any
> differences between the two (this is not a one way tool)
>
> The tool SHOULD:
> 1) Perform a comparison of the folder list, subscriptions, and ACLs
> 2) Compare the message list, message sizes, and seen state of
> messages in each folder, recursively
> 3) Compare individual messages for differences (comparing a checksum
> of fetched messages is fine). Ideally, i would like to have the option
> to perform a full check of all messages or perhaps check just the inbox
> or a random selection of messages.
> 4) Anything else?
Sounds familiar.
> Before I dig in, I searched for existing tools and found none that did
> exactly what I want. imapsync is close, but it doesn't really do what
> I'm looking for, nor is its output suitable for such a task. imapdump
> (part of the imap_tools suite) could be used as a base.
>
> I know Bron had mentioned that he uses a tool internally to check the
> consistency of mailboxes across replicated servers. Is there an open
> tool that can do this or does anyone (including Bron) want to share
> theirs? Does anyone else besides Bron/Fastmail confirm that
> replication/backup schemes are not silently corrupting messages?
I'm sure I've posted it before. It's not really something we keep
secret, just something that's not portable outside our environment.
Though it must be pretty close.
The bits that are specific to our setup are the _GetConnection part
and the run_sync stuff.
Bron.
#!/usr/bin/perl -w
package ME::CheckReplication;
use strict;
use MailApp::Variables;
use Mail::IMAPTalk;
use ME::DB;
use ME::ImapStore;
use ME::ImapSlot;
use Encode;
use Data::Dumper;
use Cyrus;
use Carp;
# Hello object orientation, friend of all "need state support in
# a multi-thread safe way" code.
sub _GetConnection {
my ($Type, %Opts) = @_;
my $Slot = $Opts{$Type . 'Slot'};
my $SlotName = $Slot->Name();
my $Con;
for (1..3) {
eval {
$Con = Mail::IMAPTalk->new(
Server => $Slot->SlotIp(),
Port => 2144,
Username => $Opts{CyrusName},
Password => $Opts{Password},
Uid => 1,
);
};
last if $Con;
}
if ($Con) {
$Con->set_unicode_folders( 1 );
$Con->{SType} = $Type;
return $Con;
}
print "Failed to connect to $Type ($SlotName) as $Opts{CyrusName}\n";
return undef;
}
# Functions
sub new {
my $class = shift;
my %Opts = @_;
unless ($Opts{IMAPs1}) {
$Opts{IMAPs1} = _GetConnection('Master', %Opts);
return undef unless $Opts{IMAPs1};
}
unless ($Opts{IMAPs2}) {
$Opts{IMAPs2} = _GetConnection('Replica', %Opts);
return undef unless $Opts{IMAPs2};
}
# sensible defaults
$Opts{NumRepeats} = 3 if not exists $Opts{NumRepeats};
$Opts{SleepTime} = 2 if not exists $Opts{SleepTime};
$Opts{Messages} = [];
my $Self = bless \%Opts, ref($class) || $class;
if ($Opts{TraceImap}) {
$Self->{IMAPs1}->set_tracing(sub { $Self->do_output("IMAP_MASTER: " . shift) });
$Self->{IMAPs2}->set_tracing(sub { $Self->do_output("IMAP_REPLICA: " . shift) });
}
return $Self;
}
sub CheckUserReplication {
my ($Self, $Level) = @_;
my $IMAPs1 = $Self->{IMAPs1};
my $IMAPs2 = $Self->{IMAPs2};
my $CyrusName = $Self->{CyrusName};
my $Repeat = 0;
RepeatCheck:
# Folder list from both servers
my $IMAPs1List = $IMAPs1->list("INBOX.*", '*')
|| die "Could not list all folders: $@";
my $IMAPs2List = $IMAPs2->list("INBOX.*", '*')
|| die "Could not list all folders: $@";
$IMAPs1List = [] if !ref $IMAPs1List;
$IMAPs2List = [] if !ref $IMAPs2List;
my @s1List = ("INBOX", map { $_->[2] } @$IMAPs1List);
my @s2List = ("INBOX", map { $_->[2] } @$IMAPs2List);
my %s1Hash = map { $_ => 1 } @s1List;
my %s2Hash = map { $_ => 1 } @s2List;
my @Missings1 = grep { !$s1Hash{$_} } @s2List;
my @Missings2 = grep { !$s2Hash{$_} } @s1List;
if (@Missings1 || @Missings2) {
$Self->do_repeat($Repeat, $CyrusName, "Folders mismatch", join(', ', @Missings1), join(', ', @Missings2))
|| goto RepeatCheck;
}
# Check subscriptions
$Self->CheckUserSubs();
# Check quota
$Self->CheckUserQuota();
# only do sieve if level2
$Self->CheckUserSieve() if $Level > 1;
# Compare each folder
foreach my $Folder (@s1List) {
$Self->debug("$CyrusName checking folder $Folder");
my $MsgsExist = $Self->CheckFolderBasic($Folder);
next if $Level == 0 || !$MsgsExist;
$IMAPs1->examine($Folder);
$IMAPs2->examine($Folder);
$Self->CheckFolderFlags($Folder);
if ($IMAPs1->capability()->{'xconversations'}) {
$Self->debug("$CyrusName checking conversations $Folder");
$Self->CheckFolderConversations($Folder);
}
$Self->CheckFolderModseq($Folder);
next if $Level == 1;
$Self->CheckFolderSizes($Folder);
next if $Level == 2;
$Self->CheckFolderEnvelopes($Folder);
next if $Level == 3;
# Force recheck of all sha1's on disk. Need level = 99
next if $Level < 99;
$Self->debug("$CyrusName full sha1 check for folder $Folder");
$Self->CheckFullSHA1($Folder);
}
return $Self->{has_error};
}
sub CheckUserQuota {
my ($Self) = @_;
my $IMAPs1 = $Self->{IMAPs1};
my $IMAPs2 = $Self->{IMAPs2};
my $CyrusName = $Self->{CyrusName};
$Self->debug("$CyrusName checking quota");
my $Repeat = 0;
RepeatCheck:
my $s1Quota = $IMAPs1->getquotaroot('inbox');
if (!$s1Quota) {
$Self->do_repeat($Repeat, $CyrusName, "No quota on master")
|| goto RepeatCheck;
return;
}
my $s1QuotaRoot = $s1Quota->{quotaroot}->[1] || '';
my (undef, $s1MBUsed, $s1MBTotal) = @{$s1Quota->{$s1QuotaRoot} || []};
if (!$s1MBTotal) {
$Self->do_repeat($Repeat, $CyrusName, "No quota on master")
|| goto RepeatCheck;
return;
}
my $s2Quota = $IMAPs2->getquotaroot('inbox');
if (!$s2Quota) {
$Self->do_repeat($Repeat, $CyrusName, "No quota on replica")
|| goto RepeatCheck;
return;
}
my $s2QuotaRoot = $s2Quota->{quotaroot}->[1] || '';
my (undef, $s2MBUsed, $s2MBTotal) = @{$s2Quota->{$s2QuotaRoot} || []};
if (!$s2MBTotal) {
$Self->do_repeat($Repeat, $CyrusName, "No quota on replica")
|| goto RepeatCheck;
return;
}
if ($s1MBUsed != $s2MBUsed || $s1MBTotal != $s2MBTotal) {
$Self->do_repeat($Repeat, $CyrusName, "Quota mismatch: $s1MBUsed/$s1MBTotal vs $s2MBUsed/$s2MBTotal")
|| goto RepeatCheck;
}
}
sub CheckUserSubs {
my ($Self) = @_;
my $IMAPs1 = $Self->{IMAPs1};
my $IMAPs2 = $Self->{IMAPs2};
my $CyrusName = $Self->{CyrusName};
$Self->debug("$CyrusName checking subscriptions");
my $Repeat = 0;
RepeatCheck:
my $s1Subs = $IMAPs1->lsub('*', '*');
if (!$s1Subs) {
$Self->error("$CyrusName Couldn't subs on master: $@");
return;
}
$s1Subs = [] unless ref($s1Subs) eq 'ARRAY';
@$s1Subs = map { $_->[2] } @$s1Subs;
@$s1Subs = grep { !/^user\./ } @$s1Subs if $Self->{IgnoreSharedSubs};
my %s1data = map { $_ => 1 } @$s1Subs;
my $s2Subs = $IMAPs2->lsub('*', '*');
if (!$s2Subs) {
$Self->error("$CyrusName Couldn't subs on replica: $@");
return;
}
$s2Subs = [] unless ref($s2Subs) eq 'ARRAY';
@$s2Subs = map { $_->[2] } @$s2Subs;
@$s2Subs = grep { !/^user\./ } @$s2Subs if $Self->{IgnoreSharedSubs};
my %s2data = map { $_ => 1 } @$s2Subs;
my %ids = (%s1data, %s2data);
foreach my $id (keys %ids) {
if (!$s1data{$id} || !$s2data{$id}) {
my $On = !$s1data{$id} ? "master" : "replica";
$Self->do_repeat($Repeat, $CyrusName, "Missing subscription to $id on $On")
|| goto RepeatCheck;
}
}
}
sub CheckUserSieve {
my ($Self, $Level) = @_;
my $CyrusName = $Self->{CyrusName};
my $mAddr = $Self->{MasterSlot}->SlotIp() . ':2001';
my $rAddr = $Self->{ReplicaSlot}->SlotIp() . ':2001';
$Self->debug("$CyrusName checking sieve script");
my $Repeat = 0;
RepeatCheck:
my $SCRIPT = '/home/mod_perl/hm/scripts/fmsieve.pl';
my $s1Sieve = `$SCRIPT -s $mAddr $Self->{UserId} get`;
my $s2Sieve = `$SCRIPT -s $rAddr $Self->{UserId} get`;
unless ($s1Sieve eq $s2Sieve) {
$Self->do_repeat($Repeat, $CyrusName, "Sieve scripts differ for $CyrusName [$s1Sieve] => [$s2Sieve]")
|| goto RepeatCheck;
}
}
sub CheckFolderBasic {
my ($Self, $Folder) = @_;
my $IMAPs1 = $Self->{IMAPs1};
my $IMAPs2 = $Self->{IMAPs2};
my $CyrusName = $Self->{CyrusName};
my $Repeat = 0;
RepeatCheck:
my $s1Status = $IMAPs1->status($Folder, '(messages uidnext unseen recent uidvalidity highestmodseq)');
if (!$s1Status) {
$Self->error("$CyrusName Couldn't get status of '$Folder' on master: $@");
return;
}
my $s2Status = $IMAPs2->status($Folder, '(messages uidnext unseen recent uidvalidity highestmodseq)');
if (!$s2Status) {
$Self->error("$CyrusName Couldn't get status of '$Folder' on replica: $@");
return;
}
for (qw(messages uidnext unseen recent uidvalidity highestmodseq)) {
unless (defined $s1Status->{$_} and defined $s2Status->{$_}) {
$Self->error("$CyrusName status on $Folder undefined for $_");
next;
}
if ($s1Status->{$_} != $s2Status->{$_}) {
$Self->do_repeat($Repeat, $CyrusName, "mistmatched $Folder/$_", "master=$s1Status->{$_}, replica=$s2Status->{$_}")
|| goto RepeatCheck;
}
}
return ($s1Status->{messages} || $s2Status->{messages});
}
sub CheckFolderConversations {
my ($Self, $Folder) = @_;
my $IMAPs1 = $Self->{IMAPs1};
my $IMAPs2 = $Self->{IMAPs2};
my $CyrusName = $Self->{CyrusName};
my $Repeat = 0;
RepeatCheck:
my $s1CIDs = $Self->do_fetch($IMAPs1, $CyrusName, 'cid') || return;
my $s2CIDs = $Self->do_fetch($IMAPs2, $CyrusName, 'cid') || return;
my %ids = (%$s1CIDs, %$s2CIDs);
for (sort {$a <=> $b } keys %ids) {
my $s1c = eval { join(' ', sort map { lc $_ } @{$s1CIDs->{$_}{cid}}) } || '';
my $s2c = eval { join(' ', sort map { lc $_ } @{$s2CIDs->{$_}{cid}}) } || '';
if ($s1c ne $s2c) {
$Self->do_repeat($Repeat, $CyrusName, "mistmatched cid for $Folder/$_", "master=$s1c, replica=$s2c")
|| goto RepeatCheck;
}
}
my $s1Stat = $IMAPs1->status($Folder, "(xconvmodseq xconvexists xconvunseen)");
my $s2Stat = $IMAPs2->status($Folder, "(xconvmodseq xconvexists xconvunseen)");
foreach my $key (qw(xconvmodseq xconvexists xconvunseen)) {
if ($s1Stat->{$key} != $s2Stat->{$key}) {
$Self->do_repeat($Repeat, $CyrusName, "mistmatched $key for $Folder", "master=$s1Stat->{$key}, replica=$s2Stat->{$key}")
|| goto RepeatCheck;
}
}
}
sub CheckFolderFlags {
my ($Self, $Folder) = @_;
my $IMAPs1 = $Self->{IMAPs1};
my $IMAPs2 = $Self->{IMAPs2};
my $CyrusName = $Self->{CyrusName};
my $Repeat = 0;
RepeatCheck:
my $s1Flags = $Self->do_fetch($IMAPs1, $CyrusName, 'flags') || return;
my $s2Flags = $Self->do_fetch($IMAPs2, $CyrusName, 'flags') || return;
my %ids = (%$s1Flags, %$s2Flags);
my %SkipFlags = (); #map { $_ => 1 } qw(\Recent \Seen);
for (sort {$a <=> $b } keys %ids) {
my $s1f = eval { join(' ', sort map { lc $_ } grep { !$SkipFlags{$_} } @{$s1Flags->{$_}{flags}}) } || '';
my $s2f = eval { join(' ', sort map { lc $_ } grep { !$SkipFlags{$_} } @{$s2Flags->{$_}{flags}}) } || '';
if ($s1f ne $s2f) {
$Self->do_repeat($Repeat, $CyrusName, "mistmatched flags for $Folder/$_", "master=$s1f, replica=$s2f")
|| goto RepeatCheck;
}
}
}
sub CheckFolderEnvelopes {
my ($Self, $Folder) = @_;
my $IMAPs1 = $Self->{IMAPs1};
my $IMAPs2 = $Self->{IMAPs2};
my $CyrusName = $Self->{CyrusName};
my $Repeat = 0;
RepeatCheck:
my $s1Res = $Self->do_fetch($IMAPs1, $CyrusName, 'envelope') || return;
my $s2Res = $Self->do_fetch($IMAPs2, $CyrusName, 'envelope') || return;
my %ids = (%$s1Res, %$s2Res);
for (sort { $a <=> $b } keys %ids) {
my $s1h = eval { $s1Res->{$_}{'envelope'} } || {};
my $s2h = eval { $s2Res->{$_}{'envelope'} } || {};
my $s1e = join(' ', map { "($_: " . ($s1h->{$_}||'') . ")" } sort keys %$s1h);
my $s2e = join(' ', map { "($_: " . ($s2h->{$_}||'') . ")" } sort keys %$s2h);
if ($s1e and not $s2e) {
$Self->error("$CyrusName for '$Folder', '$_', exists only on replica");
}
elsif ($s2e and not $s1e) {
$Self->do_repeat($Repeat, $CyrusName, "only exists on master $Folder/$_", "master=$s1e")
|| goto RepeatCheck;
}
elsif ($s1e ne $s2e) {
$Self->do_repeat($Repeat, $CyrusName, "mistmatched envelopes for $Folder/$_", "master=$s1e, replica=$s2e")
|| goto RepeatCheck;
}
}
}
sub CheckFolderSizes {
my ($Self, $Folder) = @_;
my $IMAPs1 = $Self->{IMAPs1};
my $IMAPs2 = $Self->{IMAPs2};
my $CyrusName = $Self->{CyrusName};
my $Repeat = 0;
RepeatCheck:
my $s1Res = $Self->do_fetch($IMAPs1, $CyrusName, 'rfc822.size', 'digest.sha1') || return;
my $s2Res = $Self->do_fetch($IMAPs2, $CyrusName, 'rfc822.size', 'digest.sha1') || return;
my %ids = (%$s1Res, %$s2Res);
for (sort { $a <=> $b } keys %ids) {
my $s1f = eval { $s1Res->{$_}{'rfc822.size'} } || '';
my $s2f = eval { $s2Res->{$_}{'rfc822.size'} } || '';
my $s1g = eval { $s1Res->{$_}{'digest.sha1'} } || '';
my $s2g = eval { $s2Res->{$_}{'digest.sha1'} } || '';
if ($s1f and not $s2f) {
$Self->error("$CyrusName for '$Folder', '$_', exists only on replica");
}
elsif ($s2f and not $s1f) {
$Self->do_repeat($Repeat, $CyrusName, "only exists on master $Folder/$_", "master=$s1f, $s1g")
|| goto RepeatCheck;
}
elsif ($s1f ne $s2f) {
$Self->_CopyBackMaybe($Folder, $_);
$Self->do_repeat($Repeat, $CyrusName, "mistmatched sizes for $Folder/$_", "master=$s1f, replica=$s2f")
|| goto RepeatCheck;
}
elsif ($s1g ne $s2g) {
$Self->_CopyBackMaybe($Folder, $_);
$Self->do_repeat($Repeat, $CyrusName, "mistmatched guids for $Folder/$_", "master=$s1g, replica=$s2g")
|| goto RepeatCheck;
}
# every 1000th message
elsif ($s1f and $s1f < 70000 and rand(1000) >= 999) { # 70k seems a resonable limit
$Self->debug("Doing sha1 check on $CyrusName/$Folder/$_");
my $s1message = $IMAPs1->fetch($_, 'rfc822.sha1');
my $s2message = $IMAPs2->fetch($_, 'rfc822.sha1');
next unless ($s1message->{$_}{'rfc822.sha1'} and $s2message->{$_}{'rfc822.sha1'}); # deleted?
unless ($s1message->{$_}{'rfc822.sha1'} eq $s2message->{$_}{'rfc822.sha1'}) {
$Self->error("$CyrusName for '$Folder', '$_', messages do not match");
}
}
}
}
sub CheckFolderModseq {
my ($Self, $Folder) = @_;
my $IMAPs1 = $Self->{IMAPs1};
my $IMAPs2 = $Self->{IMAPs2};
my $CyrusName = $Self->{CyrusName};
my $Repeat = 0;
RepeatCheck:
my $s1ms = $Self->do_fetch($IMAPs1, $CyrusName, 'modseq') || return;
my $s2ms = $Self->do_fetch($IMAPs2, $CyrusName, 'modseq') || return;
my %ids = (%$s1ms, %$s2ms);
my %SkipFlags = (); #map { $_ => 1 } qw(\Recent \Seen);
for (sort {$a <=> $b } keys %ids) {
my $s1m = $s1ms->{$_}{modseq} || 0;
my $s2m = $s2ms->{$_}{modseq} || 0;
if ($s1m ne $s2m) {
$Self->do_repeat($Repeat, $CyrusName, "mistmatched modseq for $Folder/$_", "master=$s1m, replica=$s2m")
|| goto RepeatCheck;
}
}
}
sub CheckFullSHA1 {
my ($Self, $Folder) = @_;
my $IMAPs1 = $Self->{IMAPs1};
my $IMAPs2 = $Self->{IMAPs2};
my $CyrusName = $Self->{CyrusName};
my $Repeat = 0;
RepeatCheck:
my $s1Res = $Self->do_fetch($IMAPs1, $CyrusName, 'rfc822.sha1') || return;
my $s2Res = $Self->do_fetch($IMAPs2, $CyrusName, 'rfc822.sha1') || return;
my %ids = (%$s1Res, %$s2Res);
for (sort { $a <=> $b } keys %ids) {
my $s1s = eval { $s1Res->{$_}{'rfc822.sha1'} } || '';
my $s2s = eval { $s2Res->{$_}{'rfc822.sha1'} } || '';
if ($s1s and not $s2s) {
$Self->error("$CyrusName for '$Folder', sha1 of '$_', exists only on replica");
}
elsif ($s2s and not $s1s) {
$Self->do_repeat($Repeat, $CyrusName, "only sha1 exists on master $Folder/$_", "master=$s1s")
|| goto RepeatCheck;
}
elsif ($s1s ne $s2s) {
$Self->_CopyBackMaybe($Folder, $_);
$Self->do_repeat($Repeat, $CyrusName, "mistmatched sha1 for $Folder/$_", "master=$s1s, replica=$s2s")
|| goto RepeatCheck;
}
}
}
sub do_fetch {
my $Self = shift;
my ($IMAP, $CyrusName, @Items) = @_;
# $IMAP->fetch(...) currently returns undef if no messages because:
# . fetch 1:* flags
# . NO No matching messages (0.000 sec)
# This sub returns {} for a fetch on an empty folder
my $Uids = $IMAP->search('1:*');
if (!$Uids) {
$Self->error("$CyrusName Couldn't search '$IMAP->{CurrentFolder}' on $IMAP->{SType}: $@");
return undef;
}
my $Res = $Items[0] eq 'flags' ? $IMAP->fetch_flags('1:*') : $Items[0] eq 'envelope' ? $IMAP->fetch('1:*', @Items) : $IMAP->fetch_meta('1:*', @Items);
$Res = {} if !$Res && ref($Uids) && !@$Uids;
if (!$Res) {
$Self->error("$CyrusName Couldn't flags '$IMAP->{CurrentFolder}' on $IMAP->{SType}: $@");
return undef;
}
return $Res;
}
sub do_repeat {
my $Self = shift;
$_[0]++;
my ($Repeat, $UserName, $Msg, @Data) = @_;
if ($Repeat <= $Self->{NumRepeats}) {
$Self->debug("$UserName, $Msg @Data, try $Repeat");
sleep($Self->{SleepTime}) if $Self->{SleepTime};
return 0;
}
if ($Self->{DoSync} && $Repeat <= $Self->{NumRepeats}+2) {
$Self->run_sync($UserName, $Repeat - $Self->{NumRepeats}, $Msg =~ m/Quota mismatch/);
$Self->debug("$UserName, $Msg @Data, run sync");
sleep($Self->{SleepTime}) if $Self->{SleepTime};
return 0;
}
my $Error = join ", ", map { ref($_) ? Dumper($_) : $_ } @Data;
$Self->error("$UserName, $Msg: $Error");
# Reset repeat count
return 1;
}
sub run_sync {
my $Self = shift;
my $CyrusName = shift;
my $Time = shift;
my $IsQuota = shift;
return unless $Self->{DoSync};
my $rDbh = ME::DB->GetDbh( Name => 'mainreadonly' );
if ($Time > 1 and $Self->{ExtremeNuke}) {
my $AdminLink = Mail::IMAPTalk->new(
Server => $Self->{ReplicaSlot}->SlotIp(),
Port => 2144,
Username => 'admin',
Password => $MailApp::Variables::AdminPassword,
Uid => 1,
);
$AdminLink->set_unicode_folders( 1 );
$Self->notice("Deleting entire mailbox for $CyrusName on replica");
$AdminLink->obliterate($CyrusName);
}
elsif ((($Time > 0 and $IsQuota) or $Time > 1) and $Self->{RunReconstruct}) {
my $DbName =
Cyrus::MailboxToDbName(
Cyrus::FolderToMailbox( $CyrusName, "Inbox" ) );
foreach my $set (['Master', $Self->{MasterSlot}, $Self->{IMAPs1}],
['Replica', $Self->{ReplicaSlot}, $Self->{IMAPs2}]) {
my ($Type, $Slot, $Imap) = @$set;
my $SlotName = $Slot->Name();
if ($Time > 1 or not $IsQuota) {
$Self->debug("Running reconstruct for $CyrusName on $Type ($SlotName)");
my $ReconRes = $Slot->RunCommand('reconstruct', '-r', '-G', $DbName);
$ReconRes =~ s/\n/, /g;
$Self->notice("Ran reconstruct for $CyrusName on $Type: $ReconRes");
if ($Imap->capability()->{'xconversations'}) {
$Self->debug("Running ctl_conversationsdb for $CyrusName on $Type ($SlotName)");
my $ConvRes = $Slot->RunCommand('ctl_conversationsdb', '-v', '-R', $CyrusName);
$ConvRes =~ s/\n/, /g;
$Self->notice("Ran ctl_conversationsdb for $CyrusName on $Type: $ConvRes");
}
}
$Self->debug("Running quota -f for $CyrusName on $Type ($SlotName)");
my $QuotaRes = $Slot->RunCommand('quota', '-f', $DbName);
$QuotaRes =~ s/\n/, /g;
$Self->notice("Ran quota -f for $CyrusName on $Type: $QuotaRes");
}
}
$Self->debug("Running sync_client for $CyrusName");
my $SyncRes = $Self->{MasterSlot}->RunCommand('sync_client', '-o',
'-S' => $Self->{ReplicaSlot}->SlotIp(),
'-u' => $CyrusName
);
$SyncRes =~ s/\n/, /g;
$Self->notice("Ran sync_client for $CyrusName: $SyncRes");
}
# Logging
sub notice {
my $Self = shift;
my $Message = shift;
unless ($Self->{Quiet}) {
$Self->do_output("NOTICE: $Message");
}
}
sub debug {
my $Self = shift;
my $Message = shift;
if ($Self->{Debug}) {
$Self->do_output("DEBUG: $Message");
}
}
sub error {
my $Self = shift;
my $Message = shift;
$Self->{HasError} = 1;
$Self->do_output("ERROR: $Message");
}
sub do_output {
my $Self = shift;
my $Message = shift;
chomp($Message);
unless ($Self->{Silent}) {
if ($Self->{LogFile}) {
$Self->{LogFile}->print("$Message\n");
}
else {
print "$Message\n";
}
}
push @{$Self->{Messages}}, $Message;
}
sub GetMessages {
my $Self = shift;
$Self->{Messages} ||= [];
return wantarray ? @{$Self->{Messages}} : $Self->{Messages};
}
sub HasError {
my $Self = shift;
return $Self->{HasError};
}
sub _fname {
my $CyrusName = shift;
my $Folder = shift;
my $Domain;
if ($CyrusName =~ s{\@(.*)}{}) {
$Domain = $1;
}
$Folder =~ s{^INBOX}{user.$CyrusName};
$Folder .= '@' . $Domain if $Domain;
return $Folder;
}
sub _CopyBackMaybe() {
my $Self = shift;
if ($Self->{CopyBack}) {
my $CyrusName = $Self->{CyrusName};
my ($Folder, $Msg) = @_;
my $UTF7Folder = Encode::encode('IMAP-UTF-7', $Folder );
system("/home/mod_perl/hm/utils/ExamineCyrus.pl", '-c',
'-r', $Self->{ReplicaSlot}->Name(),
$Self->{Server}, _fname($CyrusName, $UTF7Folder), $Msg);
}
}
1;
----
Cyrus Home Page: http://www.cyrusimap.org/
List Archives/Info: http://lists.andrew.cmu.edu/pipermail/info-cyrus/
