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