d68aa392bd72e3d84ff44b75a175fff23dc78783
[exim.git] / 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 = "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