6 BEGIN { pop @INC if $INC[-1] eq '.' };
8 # Copyright (c) 2007-2015 University of Cambridge.
9 # See the file NOTICE for conditions of use and distribution.
11 # Except when they appear in comments, the following placeholders in this
12 # source are replaced when it is turned into a runnable script:
20 # This is a perl script which extracts from an Exim log all entries
21 # for all messages that have an entry that matches a given pattern.
22 # If *any* entry for a particular message matches the pattern, *all*
23 # entries for that message are displayed.
25 # We buffer up information on a per-message basis. It is done this way rather
26 # than reading the input twice so that the input can be a pipe.
28 # There must be one argument, which is the pattern. Subsequent arguments
29 # are the files to scan; if none, the standard input is read. If any file
30 # appears to be compressed, it is passed through zcat. We can't just do this
31 # for all files, because zcat chokes on non-compressed files.
33 # Performance optimized in 02/02/2007 by Jori Hamalainen
34 # Typical run time acceleration: 4 times
37 use Getopt::Std qw(getopts);
41 # This subroutine converts a time/date string from an Exim log line into
42 # the number of seconds since the epoch. It handles optional timezone
46 my($year,$month,$day,$hour,$min,$sec,$tzs,$tzh,$tzm) =
47 $_[0] =~ /^(\d{4})-(\d\d)-(\d\d)\s(\d\d):(\d\d):(\d\d)(?>\s([+-])(\d\d)(\d\d))?/o;
49 my $seconds = mktime $sec, $min, $hour, $day, $month - 1, $year - 1900;
53 $seconds -= $tzh * 3600 + $tzm * 60 if $tzs eq "+";
54 $seconds += $tzh * 3600 + $tzm * 60 if $tzs eq "-";
61 # This subroutine processes a single line (in $_) from a log file. Program
62 # defensively against short lines finding their way into the log.
64 my (%saved, %id_list, $pattern, $queue_time, $insensitive, $invert);
66 # If using "related" option, have to track extra message IDs
73 # Convert syslog lines to mainlog format, as in eximstats.
75 if (!/^\d{4}-/o) { $_ =~ s/^.*? exim\b.*?: //o; }
78 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;
80 # Handle the case when the log line belongs to a specific message. We save
81 # lines for specific messages until the message is complete. Then either print
86 $saved{$id} = '' unless defined($saved{$id});
88 # Save up the data for this message in case it becomes interesting later.
92 # Are we interested in this id ? Short circuit if we already were interested.
96 $id_list{$id} = 1 if (!defined($id_list{$id}));
97 $id_list{$id} = 0 if (($insensitive && /$pattern/io) || /$pattern/o);
101 if (defined $id_list{$id} ||
102 ($insensitive && /$pattern/io) || /$pattern/o)
105 get_related_ids($id) if $related;
107 elsif ($related && $related_re)
109 grep_for_related($_, $id);
113 # See if this is a completion for some message. If it is interesting,
114 # print it, but in any event, throw away what was saved.
116 if (index($_, 'Completed') != -1 ||
117 index($_, 'SMTP data timeout') != -1 ||
118 (index($_, 'rejected') != -1 &&
119 /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d (?:[+-]\d{4} )?)(?:\[\d+\] )?\w{6}\-\w{6}\-\w{2} rejected/o))
121 if ($queue_time != -1 &&
122 $saved{$id} =~ /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d ([+-]\d{4} )?)/o)
124 my $old_sec = &seconds($1);
125 my $sec = &seconds($date);
126 $id_list{$id} = 0 if $id_list{$id} && $sec - $old_sec <= $queue_time;
129 print "$saved{$id}\n" if ($id_list{$id});
130 delete $id_list{$id};
135 # Handle the case where the log line does not belong to a specific message.
136 # Print it if it is interesting.
138 elsif ( ($invert && (($insensitive && !/$pattern/io) || !/$pattern/o)) ||
139 (!$invert && (($insensitive && /$pattern/io) || /$pattern/o)) )
143 # Rotated log files are frequently compressed and there are a variety of
144 # formats it could be compressed with. Rather than use just one that is
145 # detected and hardcoded at Exim compile time, detect and use what the
146 # logfile is compressed with on the fly.
148 # List of known compression extensions and their associated commands:
150 gz => { cmd => 'zcat', args => '' },
151 bz2 => { cmd => 'bzcat', args => '' },
152 xz => { cmd => 'xzcat', args => '' },
153 lzma => { cmd => 'lzma', args => '-dc' }
157 sub detect_compressor_bin
160 my $c = $compressors->{$ext}->{cmd};
161 $compressors->{$ext}->{bin} = `which $c 2>/dev/null`;
162 chomp($compressors->{$ext}->{bin});
165 sub detect_compressor_capable
167 my $filename = shift();
168 map { &detect_compressor_bin($_) } keys %$compressors
172 unless (grep {$filename =~ /\.(?:$_)$/} keys %$compressors);
173 # Loop through them, figure out which one it detected,
174 # and build the commandline.
176 foreach my $ext (keys %$compressors)
178 if ($filename =~ /\.(?:$ext)$/)
180 # Just die if compressor not found; if this occurs in the middle of
181 # two valid files with a lot of matches, error could easily be missed.
182 die("Didn't find $ext decompressor for $filename\n")
183 if ($compressors->{$ext}->{bin} eq '');
184 $cmdline = $compressors->{$ext}->{bin} ." ".
185 $compressors->{$ext}->{args};
192 sub grep_for_related {
194 $id_list{$id} = 1 if $line =~ m/$related_re/;
197 sub get_related_ids {
199 push @Mids, $id unless grep /\b$id\b/, @Mids;
200 my $re = join '|', @Mids;
201 $related_re = qr/$re/;
204 # The main program. Extract the pattern and make sure any relevant characters
205 # are quoted if the -l flag is given. The -t flag gives a time-on-queue value
206 # which is an additional condition. The -M flag will also display "related"
207 # loglines (msgid from matched lines is searched in following lines).
209 getopts('Ilvt:Mhm',\my %args);
210 $queue_time = $args{'t'}? $args{'t'} : -1;
211 $insensitive = $args{'I'}? 0 : 1;
212 $invert = $args{'v'}? 1 : 0;
213 $related = $args{'M'}? 1 : 0;
215 pod2usage(-exit => 0, -verbose => 1) if $args{'h'};
216 pod2usage(-exit => 0, -verbose => 2, -noperldoc => system('perldoc -V 2>/dev/null >/dev/null'))
218 pod2usage if not @ARGV;
220 $pattern = shift @ARGV;
221 $pattern = quotemeta $pattern if $args{l};
223 # Start a pager if output goes to a terminal
226 foreach ($ENV{PAGER}//(), 'less', 'more')
228 open(my $pager, '|-', $_) or next;
234 # If file arguments are given, open each one and process according as it is
235 # is compressed or not.
242 if (-x 'ZCAT_COMMAND' && $filename =~ /\.(?:COMPRESS_SUFFIX)$/o)
244 open(LOG, "ZCAT_COMMAND $filename |") ||
245 die "Unable to zcat $filename: $!\n";
247 elsif (my $cmdline = &detect_compressor_capable($filename))
249 open(LOG, "$cmdline $filename |") ||
250 die "Unable to decompress $filename: $!\n";
254 open(LOG, "<$filename") || die "Unable to open $filename: $!\n";
256 do_line() while (<LOG>);
261 # If no files are named, process STDIN only
263 else { do_line() while (<STDIN>); }
265 # At the end of processing all the input, print any uncompleted messages.
269 print "+++ $_ has not completed +++\n$saved{$_}\n";
276 exigrep - search Exim's main log
280 B<exigrep> [options] pattern [log] ...
284 The B<exigrep> utility is a Perl script that searches one or more main log
285 files for entries that match a given pattern. When it finds a match,
286 it extracts all the log entries for the relevant message, not just
287 those that match the pattern. Thus, B<exigrep> can extract complete log
288 entries for a given message, or all mail for a given user, or for a
289 given host, for example.
291 If no file names are given on the command line, the standard input is read.
293 For known file extensions indicating compression (F<.gz>, F<.bz2>, F<.xz>, and F<.lzma>)
294 a suitable de-compressor is used, if available.
302 This means 'literal', that is, treat all characters in the
303 pattern as standing for themselves. Otherwise the pattern must be a
304 Perl regular expression. The pattern match is case-insensitive.
306 =item B<-t> I<seconds>
308 Limit the output to messages that spent at least I<seconds> in the
313 Do a case sensitive search.
317 Invert the meaning of the search pattern. That is, print message log
318 entries that are not related to that pattern.
322 Search for related messages too.
326 Print a short reference help. For more detailed help try L<exigrep(8)>,
331 Print this manual page of B<exigrep>.
337 L<exim(8)>, L<perlre(1)>, L<Exim|http://exim.org/>
341 This manual page was stitched together from spec.txt by Andreas Metzler L<ametzler at downhill.at.eu.org>
342 and updated by Heiko Schlittermann L<hs@schlittermann.de>.