src/src/exim_msgdate.src

   1 #!PERL_COMMAND -T
   2 #
   3 # Copyright (c) The Exim Maintainers 2023
   4 # SPDX-License-Identifier: GPL-2.0-or-later
   5 #
   6 # Utility to convert an exim message-id to a human readable form
   7 #
   8 # https://bugs.exim.org/show_bug.cgi?id=2956
   9 # Written by Andrew C Aitchison
  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 = "20230501.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
 369     my ($id_resolution, $lcl_hostnum, $new_format);
 370
 371     $new_format = 1 if (length $fractions) == 4;
 372
 373     $seconds = decode62($seconds);
 374     $fractions = decode62($fractions) if $fractions;
 375
 376     if (defined $localhost_number && $localhost_number ne "none") {
 377         print "localhost_number $localhost_number\n" if $debug;
 378         if ($base != 62) {
 379             # MacOS/Darwin and Cygwin
 380             $id_resolution = defined($new_format) ? 4 : 10000;
 381         } else {
 382             # Standard UNIX etc.
 383             $id_resolution = defined($new_format) ? 2 : 5000;
 384         }
 385         my $frac_divisor = 1000000 / $id_resolution;
 386         $lcl_hostnum = int($fractions / $frac_divisor);
 387         warn "localhost $lcl_hostnum from message-id != given number $localhost_number"
 388           if ($lcl_hostnum != $localhost_number);
 389
 390         $fractions -= $lcl_hostnum * $frac_divisor;
 391     } else {
 392         if ($base != 62) {
 393             # MacOS/Darwin and Cygwin
 394             $id_resolution = defined($new_format) ? 2 : 1000;
 395         } else {
 396             # Standard UNIX etc.
 397             $id_resolution = defined($new_format) ? 1 : 500;
 398         }
 399     }
 400     $fractions *= $id_resolution;
 401     #warn "decoded: seconds: $seconds, fractions: $fractions";
 402     ($fractions < 1000000) or die "bad microsecond count: $fractions\n";
 403
 404     return ($seconds, $fractions);
 405 } # sub unpack_time($$)
 406
 407 sub print_time($$$$$$)
 408 {
 409     my ($seconds, $decimal, $unix, $zulu, $localtm, $pid) = @_;
 410
 411     if ($debug) {
 412         my $ounix = defined($unix) ? $unix : "undef";
 413         my $ozulu = defined($zulu) ? $zulu : "undef";
 414         my $olocal = defined($localtm) ? $localtm : "undef";
 415         my $opid = defined($pid) ? $pid : "undef";
 416         warn "print_time($seconds, $decimal, $ounix, $ozulu, $olocal, $opid)\n"
 417     }
 418
 419     my $pidstring = "";
 420     $pidstring = "\tpid $pid" if defined $pid;
 421
 422     my $decimalstring = "";
 423     # if ($decimal>0)
 424     {
 425         $decimalstring = sprintf(".%6.6d", $decimal);
 426     }
 427     my $secondsstring;
 428     unless (defined $unix or defined $zulu or defined $localtm) {
 429         warn "No time type requested. Reporting UNIX time\n";
 430         $unix = TRUE;
 431     }
 432     if (defined $unix) {
 433         $secondsstring = $seconds;
 434         print "$secondsstring$decimalstring$pidstring\n";
 435     }
 436     if (defined $zulu) {
 437         $secondsstring = strftime("%F %T", gmtime($seconds));
 438         print "$secondsstring$decimalstring$pidstring\n";
 439     }
 440     if (defined $localtm) {
 441         $secondsstring = strftime("%F %T%%s %Z%%s\n", localtime($seconds));
 442         # print "secondstring $secondsstring\n" if $debug;
 443         printf($secondsstring, $decimalstring, $pidstring);
 444     }
 445
 446 } # sub print_time($$$$$$)
 447
 448 foreach my $msgid (@ARGV) {
 449     my ($seconds, $pid, $fractions, $decimal);
 450
 451     if ($msgid =~
 452         /(?:(?:^|[\s<])E?
 453             (?<seconds>[a-zA-Z0-9]{6})                  # new format
 454             -(?<pid>[a-zA-Z0-9]{11})
 455             -(?<fractions>[a-zA-Z0-9]{4})
 456           |
 457             (?<seconds>[a-zA-Z0-9]{6})                  # old format
 458             -(?<pid>[a-zA-Z0-9]{6})
 459             -(?<fractions>[a-zA-Z0-9]{2})
 460          )/x)
 461     {
 462 print "saw full mesgid\n" if $debug;
 463
 464         # Should take either the log form of timestamp,
 465         # the Message-ID: header form with the leading 'E', ...
 466         ($seconds, $decimal) = unpack_time($+{seconds}, $+{fractions});
 467         $pid = decode62($+{pid});
 468         #warn "$seconds, $pid, $+{fractions}\n";
 469     } elsif ($msgid =~ /(?:^|[^0-9A-Za-z])
 470                         (?<seconds>
 471                         [a-zA-Z0-9]{11}                 # new format
 472                         |[a-zA-Z0-9]{6}                 # old format
 473                         )$/x) {
 474         # ... or just the timecode section before the first '-'
 475 print "saw just timecode\n" if $debug;
 476         ($seconds, $pid, $decimal) = (decode62($+{seconds}), undef, 0);
 477     } else {
 478         warn "$msgid not parsed\n";
 479         next;
 480     }
 481
 482     if ($debug) {
 483         print "msgid: $msgid\n";
 484         my $ogmt = defined($optgmt) ? $optgmt : "undef";
 485         my $ounix = defined($optunix) ? $optunix : "undef";
 486         my $olocal = defined($optlocal) ? $optlocal : "undef";
 487         my $opid = defined($optpid) ? $optpid : "undef";
 488         print "print_time($seconds, $decimal, $ounix, $ogmt, $olocal, $opid)\n";
 489     }
 490     $pid = undef unless $optpid;
 491     print_time($seconds, $decimal, $optunix, $optgmt, $optlocal, $pid);
 492 }
 493
 494 =head1 NAME
 495
 496   exim_msgdate -  Utility to convert an exim message-id to a human readable date+time
 497
 498 =head1 SYNOPSIS
 499
 500 B<exim_msgdate> [ -u|--unix | --GMT | --z|-Zulu | --UTC | -l|--local ]
 501       [ --base 36 | --base 62 | --base36 | --base62 | --b36 | --b62 ]
 502       [ --pid ] [ --debug ] [ --localhost_number ]
 503       [ -c c<full path to exim cnfig file> ]
 504       exim-message-id [ | exim-message-id ...]
 505
 506 B<exim_msgdate> --help|--man
 507
 508 =head1 DESCRIPTION
 509
 510 B<exim_msgdate> is a tool which converts an exim message-id to a human
 511 readable form, usuall just the date+time, but with the I<--pid> option
 512 the process id as well.
 513
 514 =head1 Message IDs:
 515
 516 Three exim message ID formats are recognized.
 517 In each case the 'X's are taken from the base (see below) which depends upon the platform.
 518
 519 =over 4
 520
 521 =item XXXXXX-XXXXXX-XX
 522
 523 found in the exim logfile,
 524
 525 =item EXXXXXX-XXXXXX-XX
 526
 527 found in the Message-Id header,
 528
 529 =item XXXXXX
 530
 531 just the first six characters of the message id.
 532
 533 =back
 534
 535 =head1 OPTIONS
 536
 537 =head2 Time Zones and Unix Time
 538
 539 =over 4
 540
 541 =item     B<-u | --unix>
 542
 543 Display time as seconds since 1 Jan 1970, the Unix Epoch.
 544
 545 =item     B<--GMT> B<-u|--UTC> B<-z|--zulu>
 546
 547 Display time in GMT/UTC - we assume these are the same.
 548 Zulu time is another name for GMT.
 549
 550 =item     B<-l | --local>
 551
 552 Display time in the local time-zone.
 553
 554 Do not confuse this with the L<--localhost_number|/--localhost_number-n> option.
 555
 556 =back
 557
 558 The default is the local timezone.
 559
 560 =head2 User Assistance Options
 561
 562 =over 4
 563
 564 =item     B<--help>
 565
 566 A brief list of the options
 567
 568 =item     B<--man>
 569
 570 A more detailed manual for B<exim_msgdate>
 571
 572 =item B<--debug>
 573
 574 Information about what went wrong, mostly for developers.
 575
 576 =back
 577
 578 =head2 Specialized Options
 579
 580 =over 4
 581
 582 =item B<--base> n | B<--base36> | B<--base62>
 583
 584 The message-id is usually encoded in base-62 (0-9A-Za-z),
 585 but on systems with case-insensitive file systems, such as MacOS and Cygwin,
 586 base-36 (0-9A-Z) is used instead.
 587 The installation script should have set the default appropriately,
 588 but these options allow the default base to be overridden.
 589
 590 The default matches C<exim>; in this installation it is base-BASE_62.
 591
 592 =item B<--pid>
 593
 594 Report the process id as well as the date and time in the message-id.
 595
 596 =item B<--localhost_number> n
 597
 598 If the Exim configuration option B<localhost_number> has been set,
 599 the third and final section of the message-id will include this and
 600 the timer resolution will change (see the Exim Spec. for details).
 601 C<Exim_msgdate> reads the Exim config file (see L<--C|/C-full-path-to-exim-configuration-file>) to find this value,
 602 but it can be overridden with this option.
 603
 604 The value is an integer between 0 and 16, or the value "none" which
 605 means there is no localhost_number.
 606
 607 Do not confuse this with the L<--local|/l---local> option, which displays times
 608  in the local timezone.
 609
 610 =item B<--C> B<full path to exim configuration file>
 611
 612 This overrides the usual exim search path.
 613 We set C<localhost_number> from the exim configfile.
 614
 615 =item B<-dexim_path>
 616
 617 The test test harness passes the full path of the C<exim> binary,
 618 or here the C<exim_msgdate> being tested. Not currently used.
 619
 620 =back
 621
 622 =head1 SEE ALSO:
 623
 624 L<exim(8)>
 625
 626 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>
 627
 628 =cut