src/src/exigrep.src

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