src/src/exigrep.src

   1 #! PERL_COMMAND
   2
   3 # Copyright (c) The Exim Maintainers 2020 - 2023
   4 # Copyright (c) 2007-2017 University of Cambridge.
   5 # See the file NOTICE for conditions of use and distribution.
   6 # SPDX-License-Identifier: GPL-2.0-or-later
   7
   8 use warnings;
   9 use strict;
  10 BEGIN { pop @INC if $INC[-1] eq '.' };
  11
  12 use Pod::Usage;
  13 use Getopt::Long qw(:config no_ignore_case);
  14 use File::Basename;
  15
  16 # Except when they appear in comments, the following placeholders in this
  17 # source are replaced when it is turned into a runnable script:
  18 #
  19 # PERL_COMMAND
  20 # ZCAT_COMMAND
  21 # COMPRESS_SUFFIX
  22
  23 # PROCESSED_FLAG
  24
  25 # This is a perl script which extracts from an Exim log all entries
  26 # for all messages that have an entry that matches a given pattern.
  27 # If *any* entry for a particular message matches the pattern, *all*
  28 # entries for that message are displayed.
  29
  30 # We buffer up information on a per-message basis. It is done this way rather
  31 # than reading the input twice so that the input can be a pipe.
  32
  33 # There must be one argument, which is the pattern. Subsequent arguments
  34 # are the files to scan; if none, the standard input is read. If any file
  35 # appears to be compressed, it is passed through zcat. We can't just do this
  36 # for all files, because zcat chokes on non-compressed files.
  37
  38 # Performance optimized in 02/02/2007 by Jori Hamalainen
  39 # Typical run time acceleration: 4 times
  40
  41
  42 use POSIX qw(mktime);
  43
  44
  45 # This subroutine converts a time/date string from an Exim log line into
  46 # the number of seconds since the epoch. It handles optional timezone
  47 # information.
  48
  49 sub seconds
  50   {
  51   my($year,$month,$day,$hour,$min,$sec,$tzs,$tzh,$tzm) =
  52     $_[0] =~ /^(\d{4})-(\d\d)-(\d\d)\s(\d\d):(\d\d):(\d\d)(?:.\d+)?(?>\s([+-])(\d\d)(\d\d))?/o;
  53
  54   my $seconds = mktime $sec, $min, $hour, $day, $month - 1, $year - 1900;
  55
  56   if (defined $tzs)
  57     {
  58     $seconds -= $tzh * 3600 + $tzm * 60 if $tzs eq "+";
  59     $seconds += $tzh * 3600 + $tzm * 60 if $tzs eq "-";
  60     }
  61
  62   return $seconds;
  63   }
  64
  65
  66 # This subroutine processes a single line (in $_) from a log file. Program
  67 # defensively against short lines finding their way into the log.
  68
  69 my (%saved, %id_list, $pattern);
  70
  71 my $queue_time  = -1;
  72 my $insensitive = 1;
  73 my $invert      = 0;
  74 my $related     = 0;
  75 my $use_pager   = 1;
  76 my $literal     = 0;
  77
  78
  79 # If using "related" option, have to track extra message IDs
  80 my $related_re='';
  81 my @Mids = ();
  82
  83 sub do_line
  84   {
  85
  86   # Convert syslog lines to mainlog format, as in eximstats.
  87
  88   if (!/^\d{4}-/o) { $_ =~ s/^.*? exim\b.*?: //o; }
  89
  90   return unless
  91     my($date,$id) = /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d(?:\.\d+)? (?:[+-]\d{4} )?)(?:\[\d+\] )?(\w{6}\-\w{6}\-\w{2}|\w{6}-\w{11}-\w{4})?/o;
  92
  93   # Handle the case when the log line belongs to a specific message. We save
  94   # lines for specific messages until the message is complete. Then either print
  95   # or discard.
  96
  97   if (defined $id)
  98     {
  99     $saved{$id} = '' unless defined($saved{$id});
 100
 101     # Save up the data for this message in case it becomes interesting later.
 102
 103     $saved{$id} .= $_;
 104
 105     # Are we interested in this id ? Short circuit if we already were interested.
 106
 107     if ($invert)
 108       {
 109       $id_list{$id} = 1 if (!defined($id_list{$id}));
 110       $id_list{$id} = 0 if (($insensitive && /$pattern/io) || /$pattern/o);
 111       }
 112     else
 113       {
 114       if (defined $id_list{$id} ||
 115         ($insensitive && /$pattern/io) || /$pattern/o)
 116         {
 117         $id_list{$id} = 1;
 118         get_related_ids($id) if $related;
 119         }
 120       elsif ($related && $related_re)
 121         {
 122         grep_for_related($_, $id);
 123         }
 124       }
 125
 126     # See if this is a completion for some message. If it is interesting,
 127     # print it, but in any event, throw away what was saved.
 128
 129     if (index($_, 'Completed') != -1 ||
 130         index($_, 'SMTP data timeout') != -1 ||
 131           (index($_, 'rejected') != -1 &&
 132             /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d(?:\.\d+)? (?:[+-]\d{4} )?)(?:\[\d+\] )?(?:\w{6}\-\w{6}\-\w{2}|\w{6}-\w{11}-\w{4}) rejected/o))
 133       {
 134       if ($queue_time != -1 &&
 135           $saved{$id} =~ /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d ([+-]\d{4} )?)/o)
 136         {
 137         my $old_sec = &seconds($1);
 138         my $sec = &seconds($date);
 139         $id_list{$id} = 0 if $id_list{$id} && $sec - $old_sec <= $queue_time;
 140         }
 141
 142       print "$saved{$id}\n" if ($id_list{$id});
 143       delete $id_list{$id};
 144       delete $saved{$id};
 145       }
 146     }
 147
 148   # Handle the case where the log line does not belong to a specific message.
 149   # Print it if it is interesting.
 150
 151   elsif ( ($invert && (($insensitive && !/$pattern/io) || !/$pattern/o)) ||
 152          (!$invert && (($insensitive &&  /$pattern/io) ||  /$pattern/o)) )
 153     { print "$_\n"; }
 154   }
 155
 156 # Rotated log files are frequently compressed and there are a variety of
 157 # formats it could be compressed with. Rather than use just one that is
 158 # detected and hardcoded at Exim compile time, detect and use what the
 159 # logfile is compressed with on the fly.
 160 #
 161 # List of known compression extensions and their associated commands:
 162 my $compressors = {
 163   gz   => { cmd => 'zcat',  args => '' },
 164   bz2  => { cmd => 'bzcat', args => '' },
 165   xz   => { cmd => 'xzcat', args => '' },
 166   lzma => { cmd => 'lzma',  args => '-dc' },
 167   zst  => { cmd => 'zstdcat', args => '' },
 168 };
 169 my $csearch = 0;
 170
 171 sub detect_compressor_bin
 172   {
 173   my $ext = shift();
 174   my $c = $compressors->{$ext}->{cmd};
 175   $compressors->{$ext}->{bin} = `which $c 2>/dev/null`;
 176   chomp($compressors->{$ext}->{bin});
 177   }
 178
 179 sub detect_compressor_capable
 180   {
 181   my $filename = shift();
 182   map { &detect_compressor_bin($_) } keys %$compressors
 183     if (!$csearch);
 184   $csearch = 1;
 185   return undef
 186     unless (grep {$filename =~ /\.(?:$_)$/} keys %$compressors);
 187   # Loop through them, figure out which one it detected,
 188   # and build the commandline.
 189   my $cmdline = undef;
 190   foreach my $ext (keys %$compressors)
 191     {
 192     if ($filename =~ /\.(?:$ext)$/)
 193       {
 194       # Just die if compressor not found; if this occurs in the middle of
 195       # two valid files with a lot of matches, error could easily be missed.
 196       die("Didn't find $ext decompressor for $filename\n")
 197         if ($compressors->{$ext}->{bin} eq '');
 198       $cmdline = $compressors->{$ext}->{bin} ." ".
 199                    $compressors->{$ext}->{args};
 200       last;
 201       }
 202     }
 203   return $cmdline;
 204   }
 205
 206 sub grep_for_related
 207   {
 208   my ($line,$id) = @_;
 209   $id_list{$id} = 1 if $line =~ m/$related_re/;
 210   }
 211
 212 sub get_related_ids
 213   {
 214   my ($id) = @_;
 215   push @Mids, $id unless grep /\b$id\b/, @Mids;
 216   my $re = join '|', @Mids;
 217   $related_re = qr/$re/;
 218   }
 219
 220 # The main program. Extract the pattern and make sure any relevant characters
 221 # are quoted if the -l flag is given. The -t flag gives a time-on-queue value
 222 # which is an additional condition. The -M flag will also display "related"
 223 # loglines (msgid from matched lines is searched in following lines).
 224
 225 GetOptions(
 226     'I|sensitive' => sub { $insensitive = 0 },
 227       'l|literal' => \$literal,
 228       'M|related' => \$related,
 229       't|queue-time=i' => \$queue_time,
 230       'pager!'         => \$use_pager,
 231       'v|invert'       => \$invert,
 232       'h|help'         => sub { pod2usage(-exit => 0, -verbose => 1) },
 233       'm|man'          => sub {
 234         pod2usage(
 235             -exit      => 0,
 236             -verbose   => 2,
 237             -noperldoc => system('perldoc -V 2>/dev/null >&2')
 238         );
 239       },
 240       'version'        => sub {
 241             print basename($0) . ": $0\n",
 242                 "build: EXIM_RELEASE_VERSIONEXIM_VARIANT_VERSION\n",
 243                 "perl(runtime): $]\n";
 244             exit 0;
 245       },
 246 ) and @ARGV or pod2usage;
 247
 248 $pattern = shift @ARGV;
 249 $pattern = quotemeta $pattern if $literal;
 250
 251 # Start a pager if output goes to a terminal
 252 if (-t 1 and $use_pager)
 253   {
 254   # for perl >= v5.10.x: foreach ($ENV{PAGER}//(), 'less', 'more')
 255   foreach (defined $ENV{PAGER} ? $ENV{PAGER} : (), 'less', 'more')
 256     {
 257     local $ENV{LESS} .= ' --no-init --quit-if-one-screen';
 258     open(my $pager, '|-', $_) or next;
 259     select $pager;
 260     last;
 261     }
 262   }
 263
 264 # If file arguments are given, open each one and process according as it is
 265 # is compressed or not.
 266
 267 if (@ARGV)
 268   {
 269   foreach (@ARGV)
 270     {
 271     my $filename = $_;
 272     if (-x 'ZCAT_COMMAND' && $filename =~ /\.(?:COMPRESS_SUFFIX)$/o)
 273       {
 274       open(LOG, "ZCAT_COMMAND $filename |") ||
 275         die "Unable to zcat $filename: $!\n";
 276       }
 277     elsif (my $cmdline = &detect_compressor_capable($filename))
 278       {
 279       open(LOG, "$cmdline $filename |") ||
 280         die "Unable to decompress $filename: $!\n";
 281       }
 282     else
 283       {
 284       open(LOG, "<$filename") || die "Unable to open $filename: $!\n";
 285       }
 286     do_line() while (<LOG>);
 287     close(LOG);
 288     }
 289   }
 290
 291 # If no files are named, process STDIN only
 292
 293 else { do_line() while (<STDIN>); }
 294
 295 # At the end of processing all the input, print any uncompleted messages.
 296
 297 for (keys %id_list)
 298   {
 299   print "+++ $_ has not completed +++\n$saved{$_}\n";
 300   }
 301
 302 __END__
 303
 304 =head1 NAME
 305
 306 exigrep - search Exim's main log
 307
 308 =head1 SYNOPSIS
 309
 310 B<exigrep> [options] pattern [log] ...
 311
 312 =head1 DESCRIPTION
 313
 314 The B<exigrep> utility is a Perl script that searches one or more main log
 315 files for entries that match a given pattern.  When it finds  a  match,
 316 it  extracts  all  the  log  entries for the relevant message, not just
 317 those that match the pattern.  Thus, B<exigrep> can extract  complete  log
 318 entries  for  a  given  message, or all mail for a given user, or for a
 319 given host, for example.
 320
 321 If no file names are given on the command line, the standard input is read.
 322
 323 For known file extensions indicating compression (F<.gz>, F<.bz2>, F<.xz>,
 324 F<.lzma>, and F<.zst>) a suitable de-compressor is used, if available.
 325
 326 The output is sent through a pager if a terminal is connected to STDOUT. As
 327 pager are considered: C<$ENV{PAGER}>, C<less>, C<more>.
 328
 329 =head1 OPTIONS
 330
 331 =over
 332
 333 =item B<-l>|B<--literal>
 334
 335 This means 'literal', that is, treat all characters in the
 336 pattern  as standing for themselves.  Otherwise the pattern must be a
 337 Perl regular expression.  The pattern match is case-insensitive.
 338
 339 =item B<-t>|B<--queue-time> I<seconds>
 340
 341 Limit the output to messages that spent at least I<seconds> in the
 342 queue.
 343
 344 =item B<-I>|B<--sensitive>
 345
 346 Do a case sensitive search.
 347
 348 =item B<-v>|B<--invert>
 349
 350 Invert the meaning of the search pattern. That is, print message log
 351 entries that are not related to that pattern.
 352
 353 =item B<-M>|B<--related>
 354
 355 Search for related messages too.
 356
 357 =item B<--no-pager>
 358
 359 Do not use a pager, even if STDOUT is connected to a terminal.
 360
 361 =item B<-h>|B<--help>
 362
 363 Print a short reference help. For more detailed help try L<exigrep(8)>,
 364 or C<exigrep --man>.
 365
 366 =item B<-m>|B<--man>
 367
 368 Print this manual page of B<exigrep>.
 369
 370 =back
 371
 372 =head1 SEE ALSO
 373
 374 L<exim(8)>, L<perlre(1)>, L<Exim|http://exim.org/>
 375
 376 =head1 AUTHOR
 377
 378 This  manual  page  was stitched together from spec.txt by Andreas Metzler L<ametzler at downhill.at.eu.org>
 379 and updated by Heiko Schlittermann L<hs@schlittermann.de>.
 380
 381 =cut