From a4a371234215a7705f304875cc8af067bf3142af Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 7 Nov 2019 16:42:52 +0100 Subject: Refactor logging logic. Also, introduce new option 'logger-prefix' to determine the prefix of each log line. Closes: #942725. --- interimap | 109 +++++++++++++++++++++++++++++++------------------------------- 1 file changed, 54 insertions(+), 55 deletions(-) (limited to 'interimap') diff --git a/interimap b/interimap index afe18e9..87c3a64 100755 --- a/interimap +++ b/interimap @@ -79,13 +79,14 @@ my $CONF = do { , [qw/_ local remote/] , database => qr/\A(\P{Control}+)\z/ , logfile => qr/\A(\/\P{Control}+)\z/ + , 'log-prefix' => qr/\A(\P{Control}*)\z/ , 'list-reference' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]*)\z/ , 'list-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ , 'list-select-opts' => qr/\A([\x20\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]*)\z/ , 'ignore-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/ ); }; -my ($DBFILE, $LOGGER_FD, %LIST); +my ($DBFILE, %LOGGER_CONF, %LIST); { $CONF->{_} //= {}; @@ -95,16 +96,15 @@ my ($DBFILE, $LOGGER_FD, %LIST); die "Missing option database" unless defined $DBFILE; $DBFILE = xdg_basedir( XDG_DATA_HOME => ".local/share", $NAME, $DBFILE ); + $LOGGER_CONF{'logger-prefix'} = $CONF->{_}->{'log-prefix'} // "%?n?%?m?%n(%m)&%n?: ?"; if (defined (my $l = $CONF->{_}->{logfile})) { require 'POSIX.pm'; require 'Time/HiRes.pm'; - open $LOGGER_FD, '>>', $l or die "Can't open $l: $!\n"; - $LOGGER_FD->autoflush(1); - my $flags = fcntl($LOGGER_FD, F_GETFD, 0) or die "fcntl F_GETFD: $!"; - fcntl($LOGGER_FD, F_SETFD, $flags | FD_CLOEXEC) or die "fcntl F_SETFD: $!"; - } - elsif ($CONFIG{debug}) { - $LOGGER_FD = \*STDERR; + open my $fd, '>>', $l or die "Can't open $l: $!\n"; + $fd->autoflush(1); + my $flags = fcntl($fd, F_GETFD, 0) or die "fcntl F_GETFD: $!"; + fcntl($fd, F_SETFD, $flags | FD_CLOEXEC) or die "fcntl F_SETFD: $!"; + $LOGGER_CONF{'logger-fd'} = $fd; } $LIST{mailbox} = [@ARGV]; @@ -149,8 +149,7 @@ my ($IMAP, $lIMAP, $rIMAP); sub cleanup() { undef $_ foreach grep defined, ($IMAP, $lIMAP, $rIMAP); logger(undef, "Cleaning up...") if $CONFIG{debug}; - $LOGGER_FD->close() if defined $LOGGER_FD and defined $LOGGER_FD->fileno - and $LOGGER_FD->fileno != fileno STDERR; + $LOGGER_CONF{'logger-fd'}->close() if defined $LOGGER_CONF{'logger-fd'}; $DBH->disconnect() if defined $DBH; } $SIG{INT} = sub { msg(undef, $!); cleanup(); exit 1; }; @@ -181,31 +180,25 @@ $SIG{TERM} = sub { cleanup(); exit 0; }; } sub msg($@) { + my %h = ( %LOGGER_CONF, name => shift ); + return Net::IMAP::InterIMAP::log(\%h, @_); +} +sub msg2($$@) { my $name = shift; - return unless @_; - logger($name, @_) if defined $LOGGER_FD and defined $LOGGER_FD->fileno - and $LOGGER_FD->fileno != fileno STDERR; - my $prefix = defined $name ? "$name: " : ''; - print STDERR $prefix, @_, "\n"; + my $mailbox = mbx_name($name => shift); + my %h = ( %LOGGER_CONF, name => $name, mailbox => $mailbox ); + return Net::IMAP::InterIMAP::log(\%h, @_); } sub logger($@) { - my $name = shift; - return unless @_ and defined $LOGGER_FD; - my $prefix = ''; - if (defined $LOGGER_FD and defined $LOGGER_FD->fileno - and $LOGGER_FD->fileno != fileno STDERR) { - my ($s, $us) = Time::HiRes::gettimeofday(); - $prefix = POSIX::strftime("%b %e %H:%M:%S", localtime($s)).".$us "; - } - $prefix .= "$name: " if defined $name; - $LOGGER_FD->say($prefix, @_); + my %h = ( %LOGGER_CONF, name => shift ); + return Net::IMAP::InterIMAP::logger(\%h, @_); } sub fail($@) { my $name = shift; msg($name, "ERROR: ", @_); exit 1; } -logger(undef, ">>> $NAME $VERSION"); +logger(undef, ">>> $NAME $VERSION") if $CONFIG{debug}; ############################################################################# @@ -216,7 +209,7 @@ foreach my $name (qw/local remote/) { $config{$_} = $CONFIG{$_} foreach grep {defined $CONFIG{$_}} qw/quiet debug/; $config{enable} = 'QRESYNC'; $config{name} = $name; - $config{'logger-fd'} = $LOGGER_FD if defined $LOGGER_FD; + $config{$_} = $LOGGER_CONF{$_} foreach keys %LOGGER_CONF; $config{'compress'} //= ($name eq 'local' ? 0 : 1); $config{keepalive} = 1 if $CONFIG{watch} and $config{type} ne 'tunnel'; @@ -447,7 +440,7 @@ sub db_create_mailbox($$) { $sth->bind_param(1, $mailbox, SQL_BLOB); $sth->bind_param(2, $subscribed, SQL_BOOLEAN); my $r = $sth->execute(); - msg("database", fmt("Created mailbox %d", $mailbox)); + msg("database", "Created mailbox ", mbx_pretty($mailbox)); return $r; } @@ -474,6 +467,7 @@ sub mbx_name($$) { } return defined $name ? ($CONF->{$name}->{"list-reference"} . $mailbox) : $mailbox; } +sub mbx_pretty($) { return mbx_name(undef, $_[0]); } # Transform mailbox name from local/remote IMAP server to the internal representation # (with \0 as hierarchy delimiters and without reference prefix). Return undef if @@ -553,7 +547,7 @@ if (defined $COMMAND and $COMMAND eq 'delete') { $sth->execute(); } $DBH->commit(); - msg("database", fmt("Removed mailbox %d", $mailbox)); + msg("database", "Removed mailbox ", mbx_pretty($mailbox)); } } exit 0; @@ -579,11 +573,14 @@ elsif (defined $COMMAND and $COMMAND eq 'rename') { foreach my $name (qw/local remote/) { my $mbx = mbx_name($name, $to); next unless $CONFIG{target}->{$name} and mbx_exists($name, $mbx); - fail($name, fmt("Mailbox %s exists. Run `$NAME --target=$name --delete %d` to delete.", $mbx, $to)); + fail($name, "Mailbox $mbx exists. Run `$NAME --target=$name --delete ", + mbx_pretty($to), "` to delete."); } # ensure the target name doesn't already exist in the database - fail("database", fmt("Mailbox %d exists. Run `$NAME --target=database --delete %d` to delete.", $to, $to)) + my $to_pretty = mbx_pretty($to); + fail("database", "Mailbox $to_pretty exists. Run `$NAME --target=database ", + "--delete $to_pretty` to delete.") if $CONFIG{target}->{database} and defined db_get_mailbox_idx($to); @@ -624,7 +621,8 @@ elsif (defined $COMMAND and $COMMAND eq 'rename') { $r += $sth_rename_children->execute(); $DBH->commit(); - msg("database", fmt("Renamed mailbox %d to %d", $from, $to)) if $r > 0; + msg("database", "Renamed mailbox ", mbx_pretty($from), " to ", + mbx_pretty($to)) if $r > 0; } exit 0; } @@ -703,7 +701,8 @@ sub sync_mailbox_list() { } elsif ($lExists or $rExists) { # $mailbox is on one server only - fail("database", fmt("Mailbox %d exists. Run `$NAME --target=database --delete %d` to delete.", $mailbox, $mailbox)) + my $str = mbx_pretty($mailbox); + fail("database", "Mailbox $str exists. Run `$NAME --target=database --delete $str` to delete.") if defined $idx; my ($name1, $name2, $mbx1, $mbx2) = $lExists ? ("local", "remote", $lMailbox, $rMailbox) : ("remote", "local", $rMailbox, $lMailbox); @@ -733,8 +732,7 @@ sub download_missing($$$@) { my @set = @_; my @uids; - my ($target, $f) = $source eq 'local' ? ('remote', '%l') : ('local', '%r'); - my $prefix = fmt("%s($f)", $source, $mailbox) unless $CONFIG{quiet}; + my $target = $source eq 'local' ? 'remote' : 'local'; my ($buff, $bufflen) = ([], 0); undef $buff if ($target eq 'local' ? $lIMAP : $rIMAP)->incapable('MULTIAPPEND'); @@ -747,7 +745,7 @@ sub download_missing($$$@) { my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4]; $from = (defined $from and defined $from->[0]->[2] and defined $from->[0]->[3]) ? $from->[0]->[2].'@'.$from->[0]->[3] : ''; - msg($prefix, "UID $mail->{UID} from <$from> ($mail->{INTERNALDATE})"); + msg2($source => $mailbox, "UID $mail->{UID} from <$from> ($mail->{INTERNALDATE})"); } callback_new_message($idx, $mailbox, $source, $mail, \@uids, $buff, \$bufflen) }); @@ -762,9 +760,9 @@ sub flag_conflict($$$$$) { my %flags = map {$_ => 1} (split(/ /, $lFlags), split(/ /, $rFlags)); my $flags = join ' ', sort(keys %flags); - msg(undef, fmt("WARNING: Conflicting flag update in %d for local UID $lUID (%s) ". - "and remote UID $rUID (%s). Setting both to the union (%s).", - $mailbox, $lFlags, $rFlags, $flags)); + msg(undef, "WARNING: Conflicting flag update in ", mbx_pretty($mailbox), + " for local UID $lUID ($lFlags) and remote UID $rUID ($rFlags).", + " Setting both to the union ($flags)."); return $flags } @@ -914,7 +912,8 @@ sub repair($) { } else { # conflict - msg(undef, fmt("WARNING: Missed flag update in %d for (lUID,rUID) = ($lUID,$rUID). Repairing.", $mailbox)) + msg(undef, "WARNING: Missed flag update in ", mbx_pretty($mailbox), + " for (lUID,rUID) = ($lUID,$rUID). Repairing.") if $lModSeq <= $cache->{lHIGHESTMODSEQ} and $rModSeq <= $cache->{rHIGHESTMODSEQ}; # set both $lUID and $rUID to the union of $lFlags and $rFlags my $flags = flag_conflict($mailbox, $lUID => $lFlags, $rUID => $rFlags); @@ -926,7 +925,8 @@ sub repair($) { } elsif (!defined $lModified->{$lUID} and !defined $rModified->{$rUID}) { push @delete_mapping, $lUID; - msg(undef, fmt("WARNING: Pair (lUID,rUID) = ($lUID,$rUID) vanished from %d. Repairing.", $mailbox)) + msg(undef, "WARNING: Pair (lUID,rUID) = ($lUID,$rUID) vanished from ", + mbx_pretty($mailbox), ". Repairing.") unless $lVanished{$lUID} and $rVanished{$rUID}; } elsif (!defined $lModified->{$lUID}) { @@ -934,7 +934,7 @@ sub repair($) { if ($lVanished{$lUID}) { push @rToRemove, $rUID; } else { - msg(fmt("local(%l)", $mailbox), "WARNING: UID $lUID disappeared. Downloading remote UID $rUID again."); + msg2(local => $mailbox, "WARNING: UID $lUID disappeared. Redownloading remote UID $rUID."); push @rMissing, $rUID; } } @@ -943,7 +943,7 @@ sub repair($) { if ($rVanished{$rUID}) { push @lToRemove, $lUID; } else { - msg(fmt("remote(%r)",$mailbox), "WARNING: UID $rUID disappeared. Downloading local UID $lUID again."); + msg2(remote => $mailbox, "WARNING: UID $rUID disappeared. Redownloading local UID $lUID."); push @lMissing, $lUID; } } @@ -973,17 +973,17 @@ sub repair($) { # Process UID found in IMAP but not in the mapping table. my @lDunno = keys %lVanished; my @rDunno = keys %rVanished; - msg(fmt("remote(%r)",$mailbox), "WARNING: No match for ".($#lDunno+1)." vanished local UID(s) " + msg2(remote => $mailbox, "WARNING: No match for ".($#lDunno+1)." vanished local UID(s) " .compact_set(@lDunno).". Ignoring.") if @lDunno; - msg(fmt("local(%l)",$mailbox), "WARNING: No match for ".($#rDunno+1)." vanished remote UID(s) " + msg2(local => $mailbox, "WARNING: No match for ".($#rDunno+1)." vanished remote UID(s) " .compact_set(@rDunno).". Ignoring.") if @rDunno; foreach my $lUID (keys %$lModified) { - msg(fmt("remote(%r)",$mailbox), "WARNING: No match for modified local UID $lUID. Downloading again."); + msg2(remote => $mailbox, "WARNING: No match for modified local UID $lUID. Redownloading."); push @lMissing, $lUID; } foreach my $rUID (keys %$rModified) { - msg(fmt("local(%l)",$mailbox), "WARNING: No match for modified remote UID $rUID. Downloading again."); + msg2(local => $mailbox, "WARNING: No match for modified remote UID $rUID. Redownloading."); push @rMissing, $rUID; } @@ -1063,9 +1063,9 @@ sub sync_known_messages($$) { } } - msg(fmt("remote(%r)",$mailbox), "WARNING: No match for ".($#lDunno+1)." vanished local UID(s) " + msg2(remote => $mailbox, "WARNING: No match for ".($#lDunno+1)." vanished local UID(s) " .compact_set(@lDunno).". Ignoring.") if @lDunno; - msg(fmt("local(%l)",$mailbox), "WARNING: No match for ".($#rDunno+1)." vanished remote UID(s) " + msg2(local => $mailbox, "WARNING: No match for ".($#rDunno+1)." vanished remote UID(s) " .compact_set(@rDunno).". Ignoring.") if @rDunno; $lIMAP->remove_message(@lToRemove) if @lToRemove; @@ -1098,7 +1098,7 @@ sub sync_known_messages($$) { my ($rUID) = $sth_get_remote_uid->fetchrow_array(); die if defined $sth_get_remote_uid->fetch(); # safety check if (!defined $rUID) { - msg(fmt("remote(%r)",$mailbox), "WARNING: No match for modified local UID $lUID. Try '--repair'."); + msg2(remote => $mailbox, "WARNING: No match for modified local UID $lUID. Try '--repair'."); } elsif (defined (my $rFlags = $rModified->{$rUID})) { unless ($lFlags eq $rFlags) { my $flags = flag_conflict($mailbox, $lUID => $lFlags, $rUID => $rFlags); @@ -1119,7 +1119,7 @@ sub sync_known_messages($$) { my ($lUID) = $sth_get_local_uid->fetchrow_array(); die if defined $sth_get_local_uid->fetch(); # safety check if (!defined $lUID) { - msg(fmt("local(%l)",$mailbox), "WARNING: No match for modified remote UID $rUID. Try '--repair'."); + msg2(local => $mailbox, "WARNING: No match for modified remote UID $rUID. Try '--repair'."); } elsif (!exists $lModified->{$lUID}) { # conflicts are taken care of above $lToUpdate{$rFlags} //= []; @@ -1151,8 +1151,7 @@ sub callback_new_message($$$$;$$$) { my $length = length ${$mail->{RFC822}}; if ($length == 0) { - my $prefix = $name eq "local" ? "local(%l)" : "remote(%r)"; - msg(fmt($prefix, $mailbox), "WARNING: Ignoring new 0-length message (UID $mail->{UID})"); + msg2($name => $mailbox, "WARNING: Ignoring new 0-length message (UID $mail->{UID})"); return; } @@ -1192,7 +1191,7 @@ sub callback_new_message_flush($$$@) { }); my ($lUIDs, $rUIDs) = $name eq 'local' ? (\@sUID,\@tUID) : (\@tUID,\@sUID); for (my $k=0; $k<=$#messages; $k++) { - logger(undef, fmt("Adding mapping (lUID,rUID) = ($lUIDs->[$k],$rUIDs->[$k]) for %d", $mailbox)) + logger(undef, "Adding mapping (lUID,rUID) = ($lUIDs->[$k],$rUIDs->[$k]) for ", mbx_pretty($mailbox)) if $CONFIG{debug}; $sth->bind_param(1, $idx, SQL_INTEGER); $sth->bind_param(2, $lUIDs->[$k], SQL_INTEGER); @@ -1322,7 +1321,7 @@ sub db_get_cache_by_idx($) { next unless grep { $_ eq $row->[1] } @MAILBOXES; # skip ignored mailboxes ($IDX, $MAILBOX) = @$row; - msg(undef, fmt("Resuming interrupted sync for %d", $MAILBOX)); + msg(undef, "Resuming interrupted sync for ", mbx_pretty($MAILBOX)); my $cache = db_get_cache_by_idx($IDX) // die; # safety check my ($lMailbox, $rMailbox) = map {mbx_name($_, $MAILBOX)} qw/local remote/; -- cgit v1.2.3