Utility: exim_msgdate

4 files changed, 600 insertions, 2 deletions

diff --git a/src/ACKNOWLEDGMENTS b/src/ACKNOWLEDGMENTS
index 22e9909c0..c318d3fea 100644
--- a/src/ACKNOWLEDGMENTS
+++ b/src/ACKNOWLEDGMENTS
@@ -357,6 +357,7 @@ David Woodhouse           Dynamic modules. Security.
 Contributors
 ------------
 Andrew Aitchison          Spotted cmdline AV scanner regression with -bmalware
+                          exim_msgdate
 Simon Arlott              Code for outbound SSL-on-connect
                           Patch implementing %M datestamping in log filenames
                           Patch restoring SIGPIPE handler for child_open_uid
diff --git a/src/OS/Makefile-Base b/src/OS/Makefile-Base
index a290b90b0..29c037401 100644
--- a/src/OS/Makefile-Base
+++ b/src/OS/Makefile-Base
@@ -249,7 +249,8 @@ utils: $(EXIM_MONITOR) exicyclog exinext exiwhat \
         exigrep eximstats exipick exiqgrep exiqsumm \
         transport-filter.pl convert4r3 convert4r4 \
         exim_checkaccess \
-        exim_dbmbuild exim_dumpdb exim_fixdb exim_tidydb exim_lock
+        exim_dbmbuild exim_dumpdb exim_fixdb exim_tidydb exim_lock \
+        exim_msgdate
 
 
 # Targets for special-purpose configuration header builders
@@ -383,6 +384,23 @@ exigrep: config ../src/exigrep.src
 	@chmod a+x exigrep
 	@echo ">>> exigrep script built"
 
+exim_msgdate: config ../src/exim_msgdate.src
+	@rm -f exim_msgdate
+	@. ./version.sh && sed \
+	  -e "s?PROCESSED_FLAG?This file has been so processed.?"\
+	  -e "/^[ \t]*# /p" \
+	  -e "/^[ \t]*# /d" \
+	  -e "s?BIN_DIRECTORY?$(BIN_DIRECTORY)?" \
+	  -e "s?PERL_COMMAND?$(PERL_COMMAND)?" \
+	  -e "s?BASE_62?$${BASE_62:-62}?" \
+	  -e "s?CONFIGURE_FILE\"?$(CONFIGURE_FILE)\"?" \
+	  -e "s?EXIM_RELEASE_VERSION?$${EXIM_RELEASE_VERSION}?" \
+	  -e "s?EXIM_VARIANT_VERSION?$${EXIM_VARIANT_VERSION}?" \
+	  ../src/exim_msgdate.src > exim_msgdate-t
+	@mv exim_msgdate-t exim_msgdate
+	@chmod a+x exim_msgdate
+	@echo ">>> exim_msgdate script built"
+
 eximstats: config ../src/eximstats.src
 	@rm -f eximstats
 	@. ./version.sh && sed \
diff --git a/src/scripts/exim_install b/src/scripts/exim_install
index 827841ffc..e6857adaf 100755
--- a/src/scripts/exim_install
+++ b/src/scripts/exim_install
@@ -198,7 +198,7 @@ else
   set exim${EXE} ${exim_monitor} exim_dumpdb${EXE} exim_fixdb${EXE} \
       exim_tidydb${EXE} exinext exiwhat exim_dbmbuild${EXE} exicyclog \
       exigrep eximstats exipick exiqgrep exiqsumm exim_lock${EXE} \
-      exim_checkaccess
+      exim_checkaccess exim_msgdate
 fi
 
 echo $com ""
diff --git a/src/src/exim_msgdate.src b/src/src/exim_msgdate.src
new file mode 100755
index 000000000..e5c357bca
--- /dev/null
+++ b/src/src/exim_msgdate.src
@@ -0,0 +1,579 @@
+#!PERL_COMMAND -WT
+#
+# Utility to convert an exim message-id to a human readable form
+#
+# https://bugs.exim.org/show_bug.cgi?id=2956
+# Written by Andrew C Aitchison
+#
+# Copyright (c) 2023 The Exim Maintainers 2023
+# SPDX-License-Identifier: GPL-2.0-or-later
+#
+# Portions taken from exicyclog.src, which is
+#   Copyright (c) University of Cambridge, 1995 - 2015
+#   See the file NOTICE for conditions of use and distribution.
+
+# https://bugs.exim.org/show_bug.cgi?id=2956
+# https://exim.org/exim-html-current/doc/html/spec_html/ch-how_exim_receives_and_delivers_mail.html#SECTmessiden
+
+# Except when they appear in comments, the following placeholders in this
+# source are replaced when it is turned into a runnable script:
+#
+# BASE_62
+# BIN_DIRECTORY
+# CONFIGURE_FILE
+# PERL_COMMAND
+# EXIM_RELEASE_VERSION
+# EXIM_VARIANT_VERSION
+#
+# PROCESSED_FLAG
+
+use strict;
+use File::Basename;
+use Getopt::Long;
+use Pod::Usage;
+
+use constant { TRUE => 1, FALSE => 0 };
+
+if (defined $ENV{TZ}) {
+   my $zonefile = "/usr/share/zoneinfo/$ENV{TZ}";
+   if (defined $ENV{TZDIR}) {
+       if (-d $ENV{TZDIR}) {
+	   $zonefile="$ENV{TZDIR}/$ENV{TZ}";
+       } else {
+	   warn "No directory TZDIR=$ENV{TZDIR}\n"
+       }
+   }
+   warn "Cannot read timezone file $zonefile (from TZDIR/TZ)\n\t'man tzset' may help.\n"
+       unless -r $zonefile;
+}
+
+my $localhost_number;  # An Exim config value
+
+my $p_name    = basename $0;
+my $p_version = "20230203.0";
+my $p_cp      = <<EOM;
+ Copyright (c) 2023 The Exim Maintainers 2023
+
+ Portions taken from exicyclog.src, which is
+   Copyright (c) University of Cambridge, 1995 - 2015
+   See the file NOTICE for conditions of use and distribution.
+EOM
+
+$ENV{PATH} = "/bin:/usr/bin:/usr/sbin";
+
+use POSIX qw(strftime);
+
+sub main::VERSION_MESSAGE()
+{
+    print basename($0), ": $0\n";
+    print "build: EXIM_RELEASE_VERSIONEXIM_VARIANT_VERSION\n";
+    print "perl(	      runtime): $]\n";
+}
+
+my ($debug, $nodebug,
+    $optbase, $optbase36, $optbase62,
+    $optunix, $optgmt, $optlocal,
+    $optpid,
+    $opteximpath,$optconfigfile);
+
+# Cannot use $debug here, since we haven't read ARGV yet.
+if (FALSE) {
+    warn join(" ", $0, @ARGV), "\n";
+}
+
+# Case is ignored, abbreviations are allowed.
+GetOptions (
+    # Allow windows style arguments /...
+    # "--|-|\+|\/" => \$prefix_pattern,
+    # "--|\/" => \$long_prefix_pattern,
+
+    "b=i" => \$optbase,
+    "base=i" => \$optbase,
+    "b36" => \$optbase36,
+    "base36" => \$optbase36,
+    "b62" => \$optbase62,
+    "base62" => \$optbase62,
+
+    "localhost_number=s" => \$localhost_number,  # cf "local"
+
+    "unix" => \$optunix,
+    "u" => \$optunix,
+    "GMT" => \$optgmt,
+    "UTC" => \$optgmt,
+    "zulu" => \$optgmt,
+    "local" => \$optlocal,   # cf "localhost_number"
+    "l" => \$optlocal,   # cf "localhost_number"
+
+    "pid" => \$optpid,
+
+    # exim args given by the test harness
+    "C=s" => \$optconfigfile,
+    "dexim_path=s" => \$opteximpath,
+
+    "debug" => \$debug,
+    "nodebug" => \$nodebug,
+    "no-debug" => \$nodebug,
+
+    'help' => sub { pod2usage(-exit => 0) },
+    'man'  => sub {
+        pod2usage(
+            -exit      => 0,
+            -verbose   => 2,
+            -noperldoc => system('perldoc -V 2>/dev/null 1>&2')
+       );
+    },
+) or pod2usage;
+# die("Error in command line arguments\n");
+
+$debug = undef if $nodebug;
+
+   
+if ($debug) {
+    warn "$0 ", join(" ", @ARGV), "\n";
+    warn "C=$optconfigfile\n" if defined $optconfigfile;
+    warn "dexim_path=$opteximpath\n" if defined $opteximpath;
+}
+
+unless ($optgmt || $optunix || $optlocal) {
+    $optlocal = TRUE;
+}
+
+if (defined($optbase36) && defined($optbase62)) {
+    die "cannot be base36 and base62\n";
+}
+
+if (defined $optbase36) {
+    $optbase = 36;
+}
+if (defined $optbase62) {
+    $optbase = 62;
+}
+if (defined $optbase) {
+    if ($optbase =~ 62) {
+        $optbase = 62;
+    } elsif ($optbase =~ 36) {
+        $optbase = 36;
+    } else {
+        warn "\toptbase36=$optbase36\n" if defined $optbase36;
+        warn "\toptbase62=$optbase62\n"if defined $optbase62;
+        die "unknown base option $optbase\n";
+    }
+}
+
+# Some Operating Systems have case-insensitive file systems
+# (at least by default).
+# This limits the characters available for the message-id
+# and hence the base Exim uses to encode numbers.
+#
+# We use Perl's idea of the operating system.
+# Should we instead use the script "scripts/os-type" which comes with Exim ?
+my $defaultbase;
+if ($^O =~ /darwin|cygwin/i) { # darwin aka MacOS X
+    $defaultbase = 36;
+} else {
+    $defaultbase = 62;
+}
+
+if ("BASE_62" != $defaultbase and !defined $optbase) {
+    die "base_62 mismatch: OS implies $defaultbase but config has BASE_62\n";
+}
+
+my $base=$defaultbase;
+$base = $optbase if $optbase;
+
+my $base62_chars =
+        "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
+my $base36_chars="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+my $base_chars;
+if ($base == 62) {
+    $base_chars = $base62_chars;
+} else {
+    $base_chars = $base36_chars;
+}
+
+# We use this to decode both base62 and base36
+sub decode62($) {
+    #warn "decode62(", join(",", @_), ")\n";
+    my ($text) = @_;
+    unless ($text =~ /^[$base_chars]+$/) {
+        die "$text is not base $base\n";
+    }
+    my $n=0;
+    foreach my $tt (split //, $text) {
+        $n = $n * $base + index($base_chars, $tt);
+    }
+    #warn "$text -> $n\n";
+    return $n;
+} # decode62
+
+sub get_configfilename()
+{
+    if (defined $optconfigfile) {
+        if ( -r $optconfigfile ) {
+            warn "using config $optconfigfile\n" if $debug;
+            return $optconfigfile;
+        } else {
+            die "cannot read $optconfigfile\n";
+        }
+    }
+
+    # See if this installation is using the esoteric "USE_EUID" feature of
+    # Exim, in which it uses the effective user id as a suffix for the
+    # configuration file name. In order for this to work, exim_msgdate
+    # must be run under the appropriate euid.
+    my $euid = "";
+    if ("CONFIGURE_FILE_USE_EUID" eq "yes" ) {
+        $euid=`id -u`;
+    }
+
+    # See if this installation is using the esoteric "USE_NODE"
+    # feature of Exim, in which it uses the host's name as a suffix
+    # for the configuration file name.
+    my $hostsuffix="";
+    if ("CONFIGURE_FILE_USE_NODE" eq "yes") {
+        $hostsuffix=`uname -n`;
+    }
+
+    # Now find the configuration file name.
+    # This has got complicated because the CONFIGURE_FILE value may now
+    # be a list of files. The one that is used is the first one that
+    # exists. Mimic the code in readconf.c by testing first for the
+    # suffixed file in each case.
+
+    my $config="";
+    my $baseconfig;
+    foreach $baseconfig (split /:/, "CONFIGURE_FILE") {
+        chomp $baseconfig;
+        if (-f "$baseconfig$euid$hostsuffix" ) {
+            $config="$baseconfig$euid$hostsuffix";
+        } elsif (-f "$baseconfig$euid" ) {
+            $config="$baseconfig$euid";
+        } elsif (-f "$baseconfig$hostsuffix" ) {
+            $config="$baseconfig$hostsuffix";
+        } elsif (-f "$baseconfig" ) {
+            $config="$baseconfig";
+        }
+        last if $config;
+    }
+    unless ($config) {
+            die "No config file found\n";
+    }
+
+    return $config;
+} # sub get_configfilename
+
+
+if ($debug) {
+    warn "before reading configfiles:\n";
+    if (defined $localhost_number) {
+        warn "localhost_number=$localhost_number\n";
+    } else {
+        warn "localhost_number unset\n";
+    }
+}
+
+if (defined $localhost_number) {
+    if ($localhost_number eq "none") {
+        $localhost_number = undef;
+    }
+} else {
+    my $config = get_configfilename();
+    warn "Reading config $config to find localhost_number\n" if $debug;
+
+    if (-r $config) {
+        # This does not do any expansions or lookups,
+        # so could be end up with a different value for localhost_number
+        # from the one that exim finds.
+        open(CONFIG, "<", $config) or
+        die "cannot open config $config :$!\n";
+
+        while(<CONFIG>) {
+            if (/^\s*localhost_number\s*=\s*(\d+)\s*$/) {
+                $localhost_number = $1;
+            }
+        }
+        close CONFIG or die "cannot close config $config: $!\n";
+        warn "$config gives localhost_number $localhost_number\n"
+            if $debug and defined $localhost_number;
+    } else {
+        # This way we get the expanded value for localhost_number
+        # directly from exim, but we have to guess which exim binary ...
+        # On Debian and Ubuntu, /usr/sbin/exim is a link to exim4 so is OK.
+        #
+        # Even if given on command line, we cannot use $opteximpath
+        # since it is the full path to this script,
+        # or $config since it is tainted.
+        #
+        warn "running system exim -bP localhost_number\n" if $debug;
+        my $exim_bP_localhost_number = `/usr/sbin/exim -bP localhost_number`;
+        if ($exim_bP_localhost_number =~ /^localhost_number\s*=\s*(\d*)/) {
+            $localhost_number = $1;
+        }
+        warn "exim_bP_localhost_number $exim_bP_localhost_number gives localhost_number $localhost_number\n"
+            if $debug and defined $localhost_number; 
+    }
+}
+
+if (defined $localhost_number) {
+    die "localhost_number > 16\n"
+        if $localhost_number > 16;
+    die "localhost_number > 10\n"
+        if $localhost_number > 10 && ($base != 62);
+}
+
+if ($debug) {
+    if (defined $localhost_number) {
+        warn "localhost_number=$localhost_number\n";
+    } else {
+        warn "localhost_number unset\n";
+    }
+}
+
+sub unpack_time($$) {
+    my ($seconds, $fractions) = @_;
+    # warn "encoded: seconds: $seconds fractions: $fractions\n";
+    $seconds = decode62($seconds);
+    $fractions = decode62($fractions) if $fractions;
+    my $id_resolution;
+    if (defined $localhost_number && $localhost_number ne "none") {
+        print "localhost_number $localhost_number\n" if $debug;
+        if ($base != 62) {
+            # MacOS/Darwin and Cygwin
+            $id_resolution = 100;
+        } else {
+            # Standard UNIX etc.
+            $id_resolution = 200;
+        }
+        $fractions -= $localhost_number * $id_resolution;
+    } else {
+        if ($base != 62) {
+            # MacOS/Darwin and Cygwin
+            $id_resolution = 1000;
+        } else {
+            # Standard UNIX etc.
+            $id_resolution = 2000;
+        }
+    }
+    while ($fractions > $id_resolution) {
+        $seconds++;
+        $fractions -= $id_resolution;
+    }
+    while ($fractions < -1e-7) {
+        $seconds--;
+        $fractions += $id_resolution;
+    }
+    # $seconds += $fractions / $id_resolution;
+
+    # warn "decoded: seconds: $seconds, fractions: $fractions/$id_resolution\n";
+
+    return ($seconds, $fractions / $id_resolution);
+} # sub unpack_time($$)
+
+sub print_time($$$$$$)
+{
+    my ($seconds, $decimal, $unix, $zulu, $localtm, $pid) = @_;
+
+    if ($debug) {
+        my $ounix = defined($unix) ? $unix : "undef";
+        my $ozulu = defined($zulu) ? $zulu : "undef";
+        my $olocal = defined($localtm) ? $localtm : "undef";
+        my $opid = defined($pid) ? $pid : "undef";
+        warn "print_time($seconds, $decimal, $ounix, $ozulu, $olocal, $opid)\n"
+    }
+
+    my $pidstring = "";
+    $pidstring = "\tpid $pid" if defined $pid;
+
+    my $decimalstring = "";
+    # if ($decimal>0)
+    {
+        $decimalstring = sprintf(".%6.6d", 1000000*$decimal);
+    }
+    my $secondsstring;
+    unless (defined $unix or defined $zulu or defined $localtm) {
+        warn "No time type requested. Reporting UNIX time\n";
+        $unix = TRUE;
+    }
+    if (defined $unix) {
+        $secondsstring = $seconds;
+        print "$secondsstring$decimalstring$pidstring\n";
+    }
+    if (defined $zulu) {
+        $secondsstring = strftime("%F %T", gmtime($seconds));
+        print "$secondsstring$decimalstring$pidstring\n";
+    }
+    if (defined $localtm) {
+        $secondsstring = strftime("%F %T%%s %Z%%s\n", localtime($seconds));
+        # print "secondstring $secondsstring\n" if $debug;
+        printf($secondsstring, $decimalstring, $pidstring);
+    }
+
+} # sub print_time($$$$$$)
+
+foreach my $msgid (@ARGV) {
+    my ($seconds, $pid, $fractions, $decimal);
+
+    if ($msgid =~
+        /(^|[\s<])E?([a-zA-Z0-9]{6})-([a-zA-Z0-9]{6})-([a-zA-Z0-9]{2})/)
+    {
+        # Should take either the log form of timestamp,
+        # the Message-ID: header form with the leading 'E', ...
+        ($seconds, $pid, $fractions) = ($2, $3, $4);
+        ($seconds, $decimal) = unpack_time($seconds, $fractions);
+        $pid = decode62($pid);
+        #warn "$seconds, $pid, $fractions\n";
+    } elsif ($msgid =~ /(^|[^0-9A-Za-z])([a-zA-Z0-9]{6})$/) {
+        # ... or just the timecode section before the first '-'
+        ($seconds, $pid, $decimal) = (decode62($2), undef, 0);
+    } else {
+        warn "$msgid not parsed\n";
+        next;
+    }
+
+    if ($debug) {
+        print "msgid: $msgid\n";
+        my $ogmt = defined($optgmt) ? $optgmt : "undef";
+        my $ounix = defined($optunix) ? $optunix : "undef";
+        my $olocal = defined($optlocal) ? $optlocal : "undef";
+        my $opid = defined($optpid) ? $optpid : "undef";
+        print "print_time($seconds, $decimal, $ounix, $ogmt, $olocal, $opid)\n";
+    }
+    $pid = undef unless $optpid;
+    print_time($seconds, $decimal, $optunix, $optgmt, $optlocal, $pid);
+}
+
+=head1 NAME
+
+  exim_msgdate -  Utility to convert an exim message-id to a human readable date+time
+
+=head1 SYNOPSIS
+
+B<exim_msgdate> [ -u|--unix | --GMT | --z|-Zulu | --UTC | -l|--local ]
+      [ --base 36 | --base 62 | --base36 | --base62 | --b36 | --b62 ]
+      [ --pid ] [ --debug ] [ --localhost_number ]
+      [ -c c<full path to exim cnfig file> ]
+      exim-message-id [ | exim-message-id ...]
+
+B<exim_msgdate> --help|--man
+
+=head1 DESCRIPTION
+
+B<exim_msgdate> is a tool which converts an exim message-id to a human
+readable form, usuall just the date+time, but with the I<--pid> option
+the process id as well.
+
+=head1 Message IDs:
+
+Three exim message ID formats are recognized.
+In each case the 'X's are taken from the base (see below) which depends upon the platform.
+
+=over 4
+
+=item XXXXXX-XXXXXX-XX
+
+found in the exim logfile,
+
+=item EXXXXXX-XXXXXX-XX
+
+found in the Message-Id header,
+
+=item XXXXXX
+
+just the first six characters of the message id.
+
+=back
+
+=head1 OPTIONS
+
+=head2 Time Zones and Unix Time
+
+=over 4
+
+=item     B<-u | --unix>
+
+Display time as seconds since 1 Jan 1970, the Unix Epoch.
+
+=item     B<--GMT> B<-u|--UTC> B<-z|--zulu>
+
+Display time in GMT/UTC - we assume these are the same.
+Zulu time is another name for GMT.
+
+=item     B<-l | --local>
+
+Display time in the local time-zone.
+
+Do not confuse this with the L<--localhost_number|/--localhost_number-n> option.
+
+=back
+
+The default is the local timezone.
+
+=head2 User Assistance Options
+
+=over 4
+
+=item     B<--help>
+
+A brief list of the options
+
+=item     B<--man>
+
+A more detailed manual for B<exim_msgdate>
+
+=item B<--debug>
+
+Information about what went wrong, mostly for developers.
+
+=back
+
+=head2 Specialized Options
+
+=over 4
+
+=item B<--base> n | B<--base36> | B<--base62>
+
+The message-id is usually encoded in base-62 (0-9A-Za-z),
+but on systems with case-insensitive file systems, such as MacOS and Cygwin,
+base-36 (0-9A-Z) is used instead.
+The installation script should have set the default appropriately,
+but these options allow the default base to be overridden.
+
+The default matches C<exim>; in this installation it is base-BASE_62.
+
+=item B<--pid>
+
+Report the process id as well as the date and time in the message-id.
+
+=item B<--localhost_number> n
+
+If the Exim configuration option B<localhost_number> has been set,
+the third and final section of the message-id will include this and
+the timer resolution will change (see the Exim Spec. for details).
+C<Exim_msgdate> reads the Exim config file (see L<--C|/C-full-path-to-exim-configuration-file>) to find this value,
+but it can be overridden with this option.
+
+The value is an integer between 0 and 16, or the value "none" which
+means there is no localhost_number.
+
+Do not confuse this with the L<--local|/l---local> option, which displays times
+ in the local timezone.
+
+=item B<--C> B<full path to exim configuration file>
+
+This overrides the usual exim search path.
+We set C<localhost_number> from the exim configfile.
+
+=item B<-dexim_path>
+
+The test test harness passes the full path of the C<exim> binary,
+or here the C<exim_msgdate> being tested. Not currently used.
+
+=back
+
+=head1 SEE ALSO:
+
+L<exim(8)>
+
+L<Exim spec.txt chapter 4|https://exim.org/exim-html-current/doc/html/spec_html/ch-how_exim_receives_and_delivers_mail.html#SECTmessiden>
+
+=cut