src/src/exim_msgdate.src

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