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