-#!PERL_COMMAND -WT
+#!PERL_COMMAND -T
+#
+# Copyright (c) The Exim Maintainers 2023
+# SPDX-License-Identifier: GPL-2.0-or-later
#
# 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.
#
# PROCESSED_FLAG
+# These match runtest
+use v5.10.1;
+use warnings;
+use if $^V >= v5.19.11, experimental => 'smartmatch';
+
use strict;
use File::Basename;
use Getopt::Long;
}
my $localhost_number; # An Exim config value
+my $nolocalhost_number;
my $p_name = basename $0;
-my $p_version = "20230203.0";
+my $p_version = "20230501.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.
+ 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,
"base62" => \$optbase62,
"localhost_number=s" => \$localhost_number, # cf "local"
+ "nolocalhost_number" => \$nolocalhost_number,
+ "no-localhost_number" => \$nolocalhost_number,
+ "no_localhost_number" => \$nolocalhost_number,
"unix" => \$optunix,
"u" => \$optunix,
-noperldoc => system('perldoc -V 2>/dev/null 1>&2')
);
},
+ 'version' => sub {
+ print basename($0), ": $p_version $0\n";
+ print "exim build: EXIM_RELEASE_VERSIONEXIM_VARIANT_VERSION\n";
+ print "perl(runtime): $]\n";
+ exit 0;
+ },
) or pod2usage;
# die("Error in command line arguments\n");
} else {
warn "localhost_number unset\n";
}
+ if (defined $nolocalhost_number) {
+ warn "nolocalhost_number=$nolocalhost_number\n";
+ } else {
+ warn "nolocalhost_number unset\n";
+ }
}
if (defined $localhost_number) {
if ($localhost_number eq "none") {
$localhost_number = undef;
+ $nolocalhost_number = TRUE;
+ } else {
+ if ($nolocalhost_number) {
+ die "aborting: localhost_number and nolocalhost_number both set\n ";
+ }
+ $nolocalhost_number = FALSE;
}
-} else {
+}
+
+unless (defined $nolocalhost_number) {
+ warn "Looking for config file\n" if $debug;
my $config = get_configfilename();
warn "Reading config $config to find localhost_number\n" if $debug;
warn "$config gives localhost_number $localhost_number\n"
if $debug and defined $localhost_number;
} else {
+ if ($debug) {
+ warn "cannot read config file $config\n";
+ }
# 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.
}
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 ($localhost_number =~ /\D/) {
+ die "localhost_number must be a number >=0\n";
+ } elsif ($localhost_number =~ /^\d*$/) {
+ die "localhost_number > 16\n"
+ if $localhost_number > 16;
+ die "localhost_number > 10\n"
+ if $localhost_number > 10 && ($base != 62);
+ } else {
+ warn "clearing localhost_number - was $localhost_number\n";
+ undef $localhost_number;
+ $nolocalhost_number=TRUE;
+ }
}
if ($debug) {
sub unpack_time($$) {
my ($seconds, $fractions) = @_;
- # warn "encoded: seconds: $seconds fractions: $fractions\n";
+ #warn "encoded: seconds: $seconds fractions: $fractions\n";
+
+ my ($id_resolution, $lcl_hostnum, $new_format);
+
+ $new_format = 1 if (length $fractions) == 4;
+
$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;
+ $id_resolution = defined($new_format) ? 4 : 10000;
} else {
# Standard UNIX etc.
- $id_resolution = 200;
+ $id_resolution = defined($new_format) ? 2 : 5000;
}
- $fractions -= $localhost_number * $id_resolution;
+ my $frac_divisor = 1000000 / $id_resolution;
+ $lcl_hostnum = int($fractions / $frac_divisor);
+ warn "localhost $lcl_hostnum from message-id != given number $localhost_number"
+ if ($lcl_hostnum != $localhost_number);
+
+ $fractions -= $lcl_hostnum * $frac_divisor;
} else {
if ($base != 62) {
# MacOS/Darwin and Cygwin
- $id_resolution = 1000;
+ $id_resolution = defined($new_format) ? 2 : 1000;
} else {
# Standard UNIX etc.
- $id_resolution = 2000;
+ $id_resolution = defined($new_format) ? 1 : 500;
}
}
- 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";
+ $fractions *= $id_resolution;
+ #warn "decoded: seconds: $seconds, fractions: $fractions";
+ ($fractions < 1000000) or die "bad microsecond count: $fractions\n";
- return ($seconds, $fractions / $id_resolution);
+ return ($seconds, $fractions);
} # sub unpack_time($$)
sub print_time($$$$$$)
my $decimalstring = "";
# if ($decimal>0)
{
- $decimalstring = sprintf(".%6.6d", 1000000*$decimal);
+ $decimalstring = sprintf(".%6.6d", $decimal);
}
my $secondsstring;
unless (defined $unix or defined $zulu or defined $localtm) {
my ($seconds, $pid, $fractions, $decimal);
if ($msgid =~
- /(^|[\s<])E?([a-zA-Z0-9]{6})-([a-zA-Z0-9]{6})-([a-zA-Z0-9]{2})/)
+ /(?:(?:^|[\s<])E?
+ (?<seconds>[a-zA-Z0-9]{6}) # new format
+ -(?<pid>[a-zA-Z0-9]{11})
+ -(?<fractions>[a-zA-Z0-9]{4})
+ |
+ (?<seconds>[a-zA-Z0-9]{6}) # old format
+ -(?<pid>[a-zA-Z0-9]{6})
+ -(?<fractions>[a-zA-Z0-9]{2})
+ )/x)
{
+print "saw full mesgid\n" if $debug;
+
# 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})$/) {
+ ($seconds, $decimal) = unpack_time($+{seconds}, $+{fractions});
+ $pid = decode62($+{pid});
+ #warn "$seconds, $pid, $+{fractions}\n";
+ } elsif ($msgid =~ /(?:^|[^0-9A-Za-z])
+ (?<seconds>
+ [a-zA-Z0-9]{11} # new format
+ |[a-zA-Z0-9]{6} # old format
+ )$/x) {
# ... or just the timecode section before the first '-'
- ($seconds, $pid, $decimal) = (decode62($2), undef, 0);
+print "saw just timecode\n" if $debug;
+ ($seconds, $pid, $decimal) = (decode62($+{seconds}), undef, 0);
} else {
warn "$msgid not parsed\n";
next;