src/src/exim_msgdate.src

   1 #!PERL_COMMAND -WT
   2 #
   3 # Utility to convert an exim message-id to a human readable form
   4 #
   5 # https://bugs.exim.org/show_bug.cgi?id=2956
   6 # Written by Andrew C Aitchison
   7 #
   8 # Copyright (c) 2023 The Exim Maintainers 2023
   9 # SPDX-License-Identifier: GPL-2.0-or-later
  10 #
  11 # Portions taken from exicyclog.src, which is
  12 #   Copyright (c) University of Cambridge, 1995 - 2015
  13 #   See the file NOTICE for conditions of use and distribution.
  14
  15 # https://bugs.exim.org/show_bug.cgi?id=2956
  16 # https://exim.org/exim-html-current/doc/html/spec_html/ch-how_exim_receives_and_delivers_mail.html#SECTmessiden
  17
  18 # Except when they appear in comments, the following placeholders in this
  19 # source are replaced when it is turned into a runnable script:
  20 #
  21 # BASE_62
  22 # BIN_DIRECTORY
  23 # CONFIGURE_FILE
  24 # PERL_COMMAND
  25 # EXIM_RELEASE_VERSION
  26 # EXIM_VARIANT_VERSION
  27 #
  28 # PROCESSED_FLAG
  29
  30 use strict;
  31 use File::Basename;
  32 use Getopt::Long;
  33 use Pod::Usage;
  34
  35 use constant { TRUE => 1, FALSE => 0 };
  36
  37 if (defined $ENV{TZ}) {
  38    my $zonefile = "/usr/share/zoneinfo/$ENV{TZ}";
  39    if (defined $ENV{TZDIR}) {
  40        if (-d $ENV{TZDIR}) {
  41            $zonefile="$ENV{TZDIR}/$ENV{TZ}";
  42        } else {
  43            warn "No directory TZDIR=$ENV{TZDIR}\n"
  44        }
  45    }
  46    warn "Cannot read timezone file $zonefile (from TZDIR/TZ)\n\t'man tzset' may help.\n"
  47        unless -r $zonefile;
  48 }
  49
  50 my $localhost_number;  # An Exim config value
  51
  52 my $p_name    = basename $0;
  53 my $p_version = "20230203.0";
  54 my $p_cp      = <<EOM;
  55  Copyright (c) 2023 The Exim Maintainers 2023
  56
  57  Portions taken from exicyclog.src, which is
  58    Copyright (c) University of Cambridge, 1995 - 2015
  59    See the file NOTICE for conditions of use and distribution.
  60 EOM
  61
  62 $ENV{PATH} = "/bin:/usr/bin:/usr/sbin";
  63
  64 use POSIX qw(strftime);
  65
  66 sub main::VERSION_MESSAGE()
  67 {
  68     print basename($0), ": $0\n";
  69     print "build: EXIM_RELEASE_VERSIONEXIM_VARIANT_VERSION\n";
  70     print "perl(              runtime): $]\n";
  71 }
  72
  73 my ($debug, $nodebug,
  74     $optbase, $optbase36, $optbase62,
  75     $optunix, $optgmt, $optlocal,
  76     $optpid,
  77     $opteximpath,$optconfigfile);
  78
  79 # Cannot use $debug here, since we haven't read ARGV yet.
  80 if (FALSE) {
  81     warn join(" ", $0, @ARGV), "\n";
  82 }
  83
  84 # Case is ignored, abbreviations are allowed.
  85 GetOptions (
  86     # Allow windows style arguments /...
  87     # "--|-|\+|\/" => \$prefix_pattern,
  88     # "--|\/" => \$long_prefix_pattern,
  89
  90     "b=i" => \$optbase,
  91     "base=i" => \$optbase,
  92     "b36" => \$optbase36,
  93     "base36" => \$optbase36,
  94     "b62" => \$optbase62,
  95     "base62" => \$optbase62,
  96
  97     "localhost_number=s" => \$localhost_number,  # cf "local"
  98
  99     "unix" => \$optunix,
 100     "u" => \$optunix,
 101     "GMT" => \$optgmt,
 102     "UTC" => \$optgmt,
 103     "zulu" => \$optgmt,
 104     "local" => \$optlocal,   # cf "localhost_number"
 105     "l" => \$optlocal,   # cf "localhost_number"
 106
 107     "pid" => \$optpid,
 108
 109     # exim args given by the test harness
 110     "C=s" => \$optconfigfile,
 111     "dexim_path=s" => \$opteximpath,
 112
 113     "debug" => \$debug,
 114     "nodebug" => \$nodebug,
 115     "no-debug" => \$nodebug,
 116
 117     'help' => sub { pod2usage(-exit => 0) },
 118     'man'  => sub {
 119         pod2usage(
 120             -exit      => 0,
 121             -verbose   => 2,
 122             -noperldoc => system('perldoc -V 2>/dev/null 1>&2')
 123        );
 124     },
 125 ) or pod2usage;
 126 # die("Error in command line arguments\n");
 127
 128 $debug = undef if $nodebug;
 129
 130
 131 if ($debug) {
 132     warn "$0 ", join(" ", @ARGV), "\n";
 133     warn "C=$optconfigfile\n" if defined $optconfigfile;
 134     warn "dexim_path=$opteximpath\n" if defined $opteximpath;
 135 }
 136
 137 unless ($optgmt || $optunix || $optlocal) {
 138     $optlocal = TRUE;
 139 }
 140
 141 if (defined($optbase36) && defined($optbase62)) {
 142     die "cannot be base36 and base62\n";
 143 }
 144
 145 if (defined $optbase36) {
 146     $optbase = 36;
 147 }
 148 if (defined $optbase62) {
 149     $optbase = 62;
 150 }
 151 if (defined $optbase) {
 152     if ($optbase =~ 62) {
 153         $optbase = 62;
 154     } elsif ($optbase =~ 36) {
 155         $optbase = 36;
 156     } else {
 157         warn "\toptbase36=$optbase36\n" if defined $optbase36;
 158         warn "\toptbase62=$optbase62\n"if defined $optbase62;
 159         die "unknown base option $optbase\n";
 160     }
 161 }
 162
 163 # Some Operating Systems have case-insensitive file systems
 164 # (at least by default).
 165 # This limits the characters available for the message-id
 166 # and hence the base Exim uses to encode numbers.
 167 #
 168 # We use Perl's idea of the operating system.
 169 # Should we instead use the script "scripts/os-type" which comes with Exim ?
 170 my $defaultbase;
 171 if ($^O =~ /darwin|cygwin/i) { # darwin aka MacOS X
 172     $defaultbase = 36;
 173 } else {
 174     $defaultbase = 62;
 175 }
 176
 177 if ("BASE_62" != $defaultbase and !defined $optbase) {
 178     die "base_62 mismatch: OS implies $defaultbase but config has BASE_62\n";
 179 }
 180
 181 my $base=$defaultbase;
 182 $base = $optbase if $optbase;
 183
 184 my $base62_chars =
 185         "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
 186 my $base36_chars="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
 187 my $base_chars;
 188 if ($base == 62) {
 189     $base_chars = $base62_chars;
 190 } else {
 191     $base_chars = $base36_chars;
 192 }
 193
 194 # We use this to decode both base62 and base36
 195 sub decode62($) {
 196     #warn "decode62(", join(",", @_), ")\n";
 197     my ($text) = @_;
 198     unless ($text =~ /^[$base_chars]+$/) {
 199         die "$text is not base $base\n";
 200     }
 201     my $n=0;
 202     foreach my $tt (split //, $text) {
 203         $n = $n * $base + index($base_chars, $tt);
 204     }
 205     #warn "$text -> $n\n";
 206     return $n;
 207 } # decode62
 208
 209 sub get_configfilename()
 210 {
 211     if (defined $optconfigfile) {
 212         if ( -r $optconfigfile ) {
 213             warn "using config $optconfigfile\n" if $debug;
 214             return $optconfigfile;
 215         } else {
 216             die "cannot read $optconfigfile\n";
 217         }
 218     }
 219
 220     # See if this installation is using the esoteric "USE_EUID" feature of
 221     # Exim, in which it uses the effective user id as a suffix for the
 222     # configuration file name. In order for this to work, exim_msgdate
 223     # must be run under the appropriate euid.
 224     my $euid = "";
 225     if ("CONFIGURE_FILE_USE_EUID" eq "yes" ) {
 226         $euid=`id -u`;
 227     }
 228
 229     # See if this installation is using the esoteric "USE_NODE"
 230     # feature of Exim, in which it uses the host's name as a suffix
 231     # for the configuration file name.
 232     my $hostsuffix="";
 233     if ("CONFIGURE_FILE_USE_NODE" eq "yes") {
 234         $hostsuffix=`uname -n`;
 235     }
 236
 237     # Now find the configuration file name.
 238     # This has got complicated because the CONFIGURE_FILE value may now
 239     # be a list of files. The one that is used is the first one that
 240     # exists. Mimic the code in readconf.c by testing first for the
 241     # suffixed file in each case.
 242
 243     my $config="";
 244     my $baseconfig;
 245     foreach $baseconfig (split /:/, "CONFIGURE_FILE") {
 246         chomp $baseconfig;
 247         if (-f "$baseconfig$euid$hostsuffix" ) {
 248             $config="$baseconfig$euid$hostsuffix";
 249         } elsif (-f "$baseconfig$euid" ) {
 250             $config="$baseconfig$euid";
 251         } elsif (-f "$baseconfig$hostsuffix" ) {
 252             $config="$baseconfig$hostsuffix";
 253         } elsif (-f "$baseconfig" ) {
 254             $config="$baseconfig";
 255         }
 256         last if $config;
 257     }
 258     unless ($config) {
 259             die "No config file found\n";
 260     }
 261
 262     return $config;
 263 } # sub get_configfilename
 264
 265
 266 if ($debug) {
 267     warn "before reading configfiles:\n";
 268     if (defined $localhost_number) {
 269         warn "localhost_number=$localhost_number\n";
 270     } else {
 271         warn "localhost_number unset\n";
 272     }
 273 }
 274
 275 if (defined $localhost_number) {
 276     if ($localhost_number eq "none") {
 277         $localhost_number = undef;
 278     }
 279 } else {
 280     my $config = get_configfilename();
 281     warn "Reading config $config to find localhost_number\n" if $debug;
 282
 283     if (-r $config) {
 284         # This does not do any expansions or lookups,
 285         # so could be end up with a different value for localhost_number
 286         # from the one that exim finds.
 287         open(CONFIG, "<", $config) or
 288         die "cannot open config $config :$!\n";
 289
 290         while(<CONFIG>) {
 291             if (/^\s*localhost_number\s*=\s*(\d+)\s*$/) {
 292                 $localhost_number = $1;
 293             }
 294         }
 295         close CONFIG or die "cannot close config $config: $!\n";
 296         warn "$config gives localhost_number $localhost_number\n"
 297             if $debug and defined $localhost_number;
 298     } else {
 299         # This way we get the expanded value for localhost_number
 300         # directly from exim, but we have to guess which exim binary ...
 301         # On Debian and Ubuntu, /usr/sbin/exim is a link to exim4 so is OK.
 302         #
 303         # Even if given on command line, we cannot use $opteximpath
 304         # since it is the full path to this script,
 305         # or $config since it is tainted.
 306         #
 307         warn "running system exim -bP localhost_number\n" if $debug;
 308         my $exim_bP_localhost_number = `/usr/sbin/exim -bP localhost_number`;
 309         if ($exim_bP_localhost_number =~ /^localhost_number\s*=\s*(\d*)/) {
 310             $localhost_number = $1;
 311         }
 312         warn "exim_bP_localhost_number $exim_bP_localhost_number gives localhost_number $localhost_number\n"
 313             if $debug and defined $localhost_number;
 314     }
 315 }
 316
 317 if (defined $localhost_number) {
 318     die "localhost_number > 16\n"
 319         if $localhost_number > 16;
 320     die "localhost_number > 10\n"
 321         if $localhost_number > 10 && ($base != 62);
 322 }
 323
 324 if ($debug) {
 325     if (defined $localhost_number) {
 326         warn "localhost_number=$localhost_number\n";
 327     } else {
 328         warn "localhost_number unset\n";
 329     }
 330 }
 331
 332 sub unpack_time($$) {
 333     my ($seconds, $fractions) = @_;
 334     # warn "encoded: seconds: $seconds fractions: $fractions\n";
 335     $seconds = decode62($seconds);
 336     $fractions = decode62($fractions) if $fractions;
 337     my $id_resolution;
 338     if (defined $localhost_number && $localhost_number ne "none") {
 339         print "localhost_number $localhost_number\n" if $debug;
 340         if ($base != 62) {
 341             # MacOS/Darwin and Cygwin
 342             $id_resolution = 100;
 343         } else {
 344             # Standard UNIX etc.
 345             $id_resolution = 200;
 346         }
 347         $fractions -= $localhost_number * $id_resolution;
 348     } else {
 349         if ($base != 62) {
 350             # MacOS/Darwin and Cygwin
 351             $id_resolution = 1000;
 352         } else {
 353             # Standard UNIX etc.
 354             $id_resolution = 2000;
 355         }
 356     }
 357     while ($fractions > $id_resolution) {
 358         $seconds++;
 359         $fractions -= $id_resolution;
 360     }
 361     while ($fractions < -1e-7) {
 362         $seconds--;
 363         $fractions += $id_resolution;
 364     }
 365     # $seconds += $fractions / $id_resolution;
 366
 367     # warn "decoded: seconds: $seconds, fractions: $fractions/$id_resolution\n";
 368
 369     return ($seconds, $fractions / $id_resolution);
 370 } # sub unpack_time($$)
 371
 372 sub print_time($$$$$$)
 373 {
 374     my ($seconds, $decimal, $unix, $zulu, $localtm, $pid) = @_;
 375
 376     if ($debug) {
 377         my $ounix = defined($unix) ? $unix : "undef";
 378         my $ozulu = defined($zulu) ? $zulu : "undef";
 379         my $olocal = defined($localtm) ? $localtm : "undef";
 380         my $opid = defined($pid) ? $pid : "undef";
 381         warn "print_time($seconds, $decimal, $ounix, $ozulu, $olocal, $opid)\n"
 382     }
 383
 384     my $pidstring = "";
 385     $pidstring = "\tpid $pid" if defined $pid;
 386
 387     my $decimalstring = "";
 388     # if ($decimal>0)
 389     {
 390         $decimalstring = sprintf(".%6.6d", 1000000*$decimal);
 391     }
 392     my $secondsstring;
 393     unless (defined $unix or defined $zulu or defined $localtm) {
 394         warn "No time type requested. Reporting UNIX time\n";
 395         $unix = TRUE;
 396     }
 397     if (defined $unix) {
 398         $secondsstring = $seconds;
 399         print "$secondsstring$decimalstring$pidstring\n";
 400     }
 401     if (defined $zulu) {
 402         $secondsstring = strftime("%F %T", gmtime($seconds));
 403         print "$secondsstring$decimalstring$pidstring\n";
 404     }
 405     if (defined $localtm) {
 406         $secondsstring = strftime("%F %T%%s %Z%%s\n", localtime($seconds));
 407         # print "secondstring $secondsstring\n" if $debug;
 408         printf($secondsstring, $decimalstring, $pidstring);
 409     }
 410
 411 } # sub print_time($$$$$$)
 412
 413 foreach my $msgid (@ARGV) {
 414     my ($seconds, $pid, $fractions, $decimal);
 415
 416     if ($msgid =~
 417         /(^|[\s<])E?([a-zA-Z0-9]{6})-([a-zA-Z0-9]{6})-([a-zA-Z0-9]{2})/)
 418     {
 419         # Should take either the log form of timestamp,
 420         # the Message-ID: header form with the leading 'E', ...
 421         ($seconds, $pid, $fractions) = ($2, $3, $4);
 422         ($seconds, $decimal) = unpack_time($seconds, $fractions);
 423         $pid = decode62($pid);
 424         #warn "$seconds, $pid, $fractions\n";
 425     } elsif ($msgid =~ /(^|[^0-9A-Za-z])([a-zA-Z0-9]{6})$/) {
 426         # ... or just the timecode section before the first '-'
 427         ($seconds, $pid, $decimal) = (decode62($2), undef, 0);
 428     } else {
 429         warn "$msgid not parsed\n";
 430         next;
 431     }
 432
 433     if ($debug) {
 434         print "msgid: $msgid\n";
 435         my $ogmt = defined($optgmt) ? $optgmt : "undef";
 436         my $ounix = defined($optunix) ? $optunix : "undef";
 437         my $olocal = defined($optlocal) ? $optlocal : "undef";
 438         my $opid = defined($optpid) ? $optpid : "undef";
 439         print "print_time($seconds, $decimal, $ounix, $ogmt, $olocal, $opid)\n";
 440     }
 441     $pid = undef unless $optpid;
 442     print_time($seconds, $decimal, $optunix, $optgmt, $optlocal, $pid);
 443 }
 444
 445 =head1 NAME
 446
 447   exim_msgdate -  Utility to convert an exim message-id to a human readable date+time
 448
 449 =head1 SYNOPSIS
 450
 451 B<exim_msgdate> [ -u|--unix | --GMT | --z|-Zulu | --UTC | -l|--local ]
 452       [ --base 36 | --base 62 | --base36 | --base62 | --b36 | --b62 ]
 453       [ --pid ] [ --debug ] [ --localhost_number ]
 454       [ -c c<full path to exim cnfig file> ]
 455       exim-message-id [ | exim-message-id ...]
 456
 457 B<exim_msgdate> --help|--man
 458
 459 =head1 DESCRIPTION
 460
 461 B<exim_msgdate> is a tool which converts an exim message-id to a human
 462 readable form, usuall just the date+time, but with the I<--pid> option
 463 the process id as well.
 464
 465 =head1 Message IDs:
 466
 467 Three exim message ID formats are recognized.
 468 In each case the 'X's are taken from the base (see below) which depends upon the platform.
 469
 470 =over 4
 471
 472 =item XXXXXX-XXXXXX-XX
 473
 474 found in the exim logfile,
 475
 476 =item EXXXXXX-XXXXXX-XX
 477
 478 found in the Message-Id header,
 479
 480 =item XXXXXX
 481
 482 just the first six characters of the message id.
 483
 484 =back
 485
 486 =head1 OPTIONS
 487
 488 =head2 Time Zones and Unix Time
 489
 490 =over 4
 491
 492 =item     B<-u | --unix>
 493
 494 Display time as seconds since 1 Jan 1970, the Unix Epoch.
 495
 496 =item     B<--GMT> B<-u|--UTC> B<-z|--zulu>
 497
 498 Display time in GMT/UTC - we assume these are the same.
 499 Zulu time is another name for GMT.
 500
 501 =item     B<-l | --local>
 502
 503 Display time in the local time-zone.
 504
 505 Do not confuse this with the L<--localhost_number|/--localhost_number-n> option.
 506
 507 =back
 508
 509 The default is the local timezone.
 510
 511 =head2 User Assistance Options
 512
 513 =over 4
 514
 515 =item     B<--help>
 516
 517 A brief list of the options
 518
 519 =item     B<--man>
 520
 521 A more detailed manual for B<exim_msgdate>
 522
 523 =item B<--debug>
 524
 525 Information about what went wrong, mostly for developers.
 526
 527 =back
 528
 529 =head2 Specialized Options
 530
 531 =over 4
 532
 533 =item B<--base> n | B<--base36> | B<--base62>
 534
 535 The message-id is usually encoded in base-62 (0-9A-Za-z),
 536 but on systems with case-insensitive file systems, such as MacOS and Cygwin,
 537 base-36 (0-9A-Z) is used instead.
 538 The installation script should have set the default appropriately,
 539 but these options allow the default base to be overridden.
 540
 541 The default matches C<exim>; in this installation it is base-BASE_62.
 542
 543 =item B<--pid>
 544
 545 Report the process id as well as the date and time in the message-id.
 546
 547 =item B<--localhost_number> n
 548
 549 If the Exim configuration option B<localhost_number> has been set,
 550 the third and final section of the message-id will include this and
 551 the timer resolution will change (see the Exim Spec. for details).
 552 C<Exim_msgdate> reads the Exim config file (see L<--C|/C-full-path-to-exim-configuration-file>) to find this value,
 553 but it can be overridden with this option.
 554
 555 The value is an integer between 0 and 16, or the value "none" which
 556 means there is no localhost_number.
 557
 558 Do not confuse this with the L<--local|/l---local> option, which displays times
 559  in the local timezone.
 560
 561 =item B<--C> B<full path to exim configuration file>
 562
 563 This overrides the usual exim search path.
 564 We set C<localhost_number> from the exim configfile.
 565
 566 =item B<-dexim_path>
 567
 568 The test test harness passes the full path of the C<exim> binary,
 569 or here the C<exim_msgdate> being tested. Not currently used.
 570
 571 =back
 572
 573 =head1 SEE ALSO:
 574
 575 L<exim(8)>
 576
 577 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>
 578
 579 =cut