git://git.exim.org / exim.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
tidying
[exim.git] / src / src / exigrep.src
diff --git a/src/src/exigrep.src b/src/src/exigrep.src
index b678c058472b897b3b44db4a0a436e8a970b5000..2c414fd31e6e223e68952fa4546e1353932cca08 100644 (file)
--- a/src/src/exigrep.src
+++ b/src/src/exigrep.src
@@ -2,10 +2,14 @@
 
 use warnings;
 use strict;
 
 use warnings;
 use strict;
-use Pod::Usage;
 BEGIN { pop @INC if $INC[-1] eq '.' };
 
 BEGIN { pop @INC if $INC[-1] eq '.' };
 
-# Copyright (c) 2007-2015 University of Cambridge.
+use Pod::Usage;
+use Getopt::Long qw(:config no_ignore_case);
+use File::Basename;
+
+# Copyright (c) 2007-2017 University of Cambridge.
+# Copyright (c) The Exim Maintainers 2020 - 2021
 # See the file NOTICE for conditions of use and distribution.
 
 # Except when they appear in comments, the following placeholders in this
 # See the file NOTICE for conditions of use and distribution.
 
 # Except when they appear in comments, the following placeholders in this
@@ -34,7 +38,6 @@ BEGIN { pop @INC if $INC[-1] eq '.' };
 # Typical run time acceleration: 4 times
 
 
 # Typical run time acceleration: 4 times
 
 
-use Getopt::Std qw(getopts);
 use POSIX qw(mktime);
 
 
 use POSIX qw(mktime);
 
 
@@ -42,103 +45,112 @@ use POSIX qw(mktime);
 # the number of seconds since the epoch. It handles optional timezone
 # information.
 
 # the number of seconds since the epoch. It handles optional timezone
 # information.
 
-sub seconds {
-my($year,$month,$day,$hour,$min,$sec,$tzs,$tzh,$tzm) =
-  $_[0] =~ /^(\d{4})-(\d\d)-(\d\d)\s(\d\d):(\d\d):(\d\d)(?>\s([+-])(\d\d)(\d\d))?/o;
+sub seconds
+  {
+  my($year,$month,$day,$hour,$min,$sec,$tzs,$tzh,$tzm) =
+    $_[0] =~ /^(\d{4})-(\d\d)-(\d\d)\s(\d\d):(\d\d):(\d\d)(?:.\d+)?(?>\s([+-])(\d\d)(\d\d))?/o;
 
 
-my $seconds = mktime $sec, $min, $hour, $day, $month - 1, $year - 1900;
+  my $seconds = mktime $sec, $min, $hour, $day, $month - 1, $year - 1900;
 
 
-if (defined $tzs)
-  {
-  $seconds -= $tzh * 3600 + $tzm * 60 if $tzs eq "+";
-  $seconds += $tzh * 3600 + $tzm * 60 if $tzs eq "-";
-  }
+  if (defined $tzs)
+    {
+    $seconds -= $tzh * 3600 + $tzm * 60 if $tzs eq "+";
+    $seconds += $tzh * 3600 + $tzm * 60 if $tzs eq "-";
+    }
 
 
-return $seconds;
-}
+  return $seconds;
+  }
 
 
 # This subroutine processes a single line (in $_) from a log file. Program
 # defensively against short lines finding their way into the log.
 
 
 
 # This subroutine processes a single line (in $_) from a log file. Program
 # defensively against short lines finding their way into the log.
 
-my (%saved, %id_list, $pattern, $queue_time, $insensitive, $invert);
+my (%saved, %id_list, $pattern);
+
+my $queue_time  = -1;
+my $insensitive = 1;
+my $invert      = 0;
+my $related     = 0;
+my $use_pager   = 1;
+my $literal     = 0;
+
 
 # If using "related" option, have to track extra message IDs
 
 # If using "related" option, have to track extra message IDs
-my $related;
 my $related_re='';
 my @Mids = ();
 
 my $related_re='';
 my @Mids = ();
 
-sub do_line {
+sub do_line
+  {
 
 
-# Convert syslog lines to mainlog format, as in eximstats.
+  # Convert syslog lines to mainlog format, as in eximstats.
 
 
-if (!/^\d{4}-/o) { $_ =~ s/^.*? exim\b.*?: //o; }
+  if (!/^\d{4}-/o) { $_ =~ s/^.*? exim\b.*?: //o; }
 
 
-return unless
-  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;
+  return unless
+    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;
 
 
-# Handle the case when the log line belongs to a specific message. We save
-# lines for specific messages until the message is complete. Then either print
-# or discard.
+  # Handle the case when the log line belongs to a specific message. We save
+  # lines for specific messages until the message is complete. Then either print
+  # or discard.
 
 
-if (defined $id)
-  {
-  $saved{$id} = '' unless defined($saved{$id});
+  if (defined $id)
+    {
+    $saved{$id} = '' unless defined($saved{$id});
 
 
-  # Save up the data for this message in case it becomes interesting later.
+    # Save up the data for this message in case it becomes interesting later.
 
 
-  $saved{$id} .= $_;
+    $saved{$id} .= $_;
 
 
-  # Are we interested in this id ? Short circuit if we already were interested.
+    # Are we interested in this id ? Short circuit if we already were interested.
 
 
-  if ($invert)
-    {
-    $id_list{$id} = 1 if (!defined($id_list{$id}));
-    $id_list{$id} = 0 if (($insensitive && /$pattern/io) || /$pattern/o);
-    }
-  else
-    {
-    if (defined $id_list{$id} ||
-      ($insensitive && /$pattern/io) || /$pattern/o)
+    if ($invert)
       {
       {
-      $id_list{$id} = 1;
-      get_related_ids($id) if $related;
+      $id_list{$id} = 1 if (!defined($id_list{$id}));
+      $id_list{$id} = 0 if (($insensitive && /$pattern/io) || /$pattern/o);
       }
       }
-    elsif ($related && $related_re)
+    else
       {
       {
-      grep_for_related($_, $id);
+      if (defined $id_list{$id} ||
+       ($insensitive && /$pattern/io) || /$pattern/o)
+       {
+       $id_list{$id} = 1;
+       get_related_ids($id) if $related;
+       }
+      elsif ($related && $related_re)
+       {
+       grep_for_related($_, $id);
+       }
       }
       }
-    }
 
 
-  # See if this is a completion for some message. If it is interesting,
-  # print it, but in any event, throw away what was saved.
+    # See if this is a completion for some message. If it is interesting,
+    # print it, but in any event, throw away what was saved.
 
 
-  if (index($_, 'Completed') != -1 ||
-      index($_, 'SMTP data timeout') != -1 ||
-        (index($_, 'rejected') != -1 &&
-          /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d (?:[+-]\d{4} )?)(?:\[\d+\] )?\w{6}\-\w{6}\-\w{2} rejected/o))
-    {
-    if ($queue_time != -1 &&
-        $saved{$id} =~ /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d ([+-]\d{4} )?)/o)
+    if (index($_, 'Completed') != -1 ||
+       index($_, 'SMTP data timeout') != -1 ||
+         (index($_, 'rejected') != -1 &&
+           /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d(?:\.\d+)? (?:[+-]\d{4} )?)(?:\[\d+\] )?\w{6}\-\w{6}\-\w{2} rejected/o))
       {
       {
-      my $old_sec = &seconds($1);
-      my $sec = &seconds($date);
-      $id_list{$id} = 0 if $id_list{$id} && $sec - $old_sec <= $queue_time;
+      if ($queue_time != -1 &&
+         $saved{$id} =~ /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d ([+-]\d{4} )?)/o)
+       {
+       my $old_sec = &seconds($1);
+       my $sec = &seconds($date);
+       $id_list{$id} = 0 if $id_list{$id} && $sec - $old_sec <= $queue_time;
+       }
+
+      print "$saved{$id}\n" if ($id_list{$id});
+      delete $id_list{$id};
+      delete $saved{$id};
       }
       }
-
-    print "$saved{$id}\n" if ($id_list{$id});
-    delete $id_list{$id};
-    delete $saved{$id};
     }
     }
-  }
 
 
-# Handle the case where the log line does not belong to a specific message.
-# Print it if it is interesting.
+  # Handle the case where the log line does not belong to a specific message.
+  # Print it if it is interesting.
 
 
-elsif ( ($invert && (($insensitive && !/$pattern/io) || !/$pattern/o)) ||
-       (!$invert && (($insensitive &&  /$pattern/io) ||  /$pattern/o)) )
-  { print "$_\n"; }
-}
+  elsif ( ($invert && (($insensitive && !/$pattern/io) || !/$pattern/o)) ||
+        (!$invert && (($insensitive &&  /$pattern/io) ||  /$pattern/o)) )
+    { print "$_\n"; }
+  }
 
 # Rotated log files are frequently compressed and there are a variety of
 # formats it could be compressed with. Rather than use just one that is
 
 # Rotated log files are frequently compressed and there are a variety of
 # formats it could be compressed with. Rather than use just one that is
@@ -150,7 +162,8 @@ my $compressors = {
   gz   => { cmd => 'zcat',  args => '' },
   bz2  => { cmd => 'bzcat', args => '' },
   xz   => { cmd => 'xzcat', args => '' },
   gz   => { cmd => 'zcat',  args => '' },
   bz2  => { cmd => 'bzcat', args => '' },
   xz   => { cmd => 'xzcat', args => '' },
-  lzma => { cmd => 'lzma',  args => '-dc' }
+  lzma => { cmd => 'lzma',  args => '-dc' },
+  zst  => { cmd => 'zstdcat', args => '' },
 };
 my $csearch = 0;
 
 };
 my $csearch = 0;
 
@@ -189,37 +202,63 @@ sub detect_compressor_capable
   return $cmdline;
   }
 
   return $cmdline;
   }
 
-sub grep_for_related {
+sub grep_for_related
+  {
   my ($line,$id) = @_;
   $id_list{$id} = 1 if $line =~ m/$related_re/;
   my ($line,$id) = @_;
   $id_list{$id} = 1 if $line =~ m/$related_re/;
-}
+  }
 
 
-sub get_related_ids {
+sub get_related_ids
+  {
   my ($id) = @_;
   push @Mids, $id unless grep /\b$id\b/, @Mids;
   my $re = join '|', @Mids;
   $related_re = qr/$re/;
   my ($id) = @_;
   push @Mids, $id unless grep /\b$id\b/, @Mids;
   my $re = join '|', @Mids;
   $related_re = qr/$re/;
-}
+  }
 
 # The main program. Extract the pattern and make sure any relevant characters
 # are quoted if the -l flag is given. The -t flag gives a time-on-queue value
 # which is an additional condition. The -M flag will also display "related"
 # loglines (msgid from matched lines is searched in following lines).
 
 
 # The main program. Extract the pattern and make sure any relevant characters
 # are quoted if the -l flag is given. The -t flag gives a time-on-queue value
 # which is an additional condition. The -M flag will also display "related"
 # loglines (msgid from matched lines is searched in following lines).
 
-getopts('Ilvt:Mhm',\my %args);
-$queue_time  = $args{'t'}? $args{'t'} : -1;
-$insensitive = $args{'I'}? 0 : 1;
-$invert      = $args{'v'}? 1 : 0;
-$related     = $args{'M'}? 1 : 0;
-
-pod2usage(-exit => 0, -verbose => 1) if $args{'h'};
-pod2usage(-exit => 0, -verbose => 2, -noperldoc => system('perldoc -V 2>/dev/null >/dev/null'))
-    if $args{'m'};
-pod2usage if not @ARGV;
+GetOptions(
+    'I|sensitive' => sub { $insensitive = 0 },
+      'l|literal' => \$literal,
+      'M|related' => \$related,
+      't|queue-time=i' => \$queue_time,
+      'pager!'         => \$use_pager,
+      'v|invert'       => \$invert,
+      'h|help'         => sub { pod2usage(-exit => 0, -verbose => 1) },
+      'm|man'          => sub {
+        pod2usage(
+            -exit      => 0,
+            -verbose   => 2,
+            -noperldoc => system('perldoc -V 2>/dev/null >&2')
+        );
+      },
+      'version'        => sub {
+            print basename($0) . ": $0\n",
+                "build: EXIM_RELEASE_VERSIONEXIM_VARIANT_VERSION\n",
+                "perl(runtime): $]\n";
+            exit 0;
+      },
+) and @ARGV or pod2usage;
 
 $pattern = shift @ARGV;
 
 $pattern = shift @ARGV;
-$pattern = quotemeta $pattern if $args{l};
+$pattern = quotemeta $pattern if $literal;
 
 
+# Start a pager if output goes to a terminal
+if (-t 1 and $use_pager)
+  {
+  # for perl >= v5.10.x: foreach ($ENV{PAGER}//(), 'less', 'more')
+  foreach (defined $ENV{PAGER} ? $ENV{PAGER} : (), 'less', 'more')
+    {
+    local $ENV{LESS} .= ' --no-init --quit-if-one-screen';
+    open(my $pager, '|-', $_) or next;
+    select $pager;
+    last;
+    }
+  }
 
 # If file arguments are given, open each one and process according as it is
 # is compressed or not.
 
 # If file arguments are given, open each one and process according as it is
 # is compressed or not.
@@ -280,43 +319,50 @@ given host, for example.
 
 If no file names are given on the command line, the standard input is read.
 
 
 If no file names are given on the command line, the standard input is read.
 
-For known file extensions indicating compression (F<.gz>, F<.bz2>, F<.xz>, and F<.lzma>)
-a suitable de-compressor is used, if available.
+For known file extensions indicating compression (F<.gz>, F<.bz2>, F<.xz>,
+F<.lzma>, and F<.zst>) a suitable de-compressor is used, if available.
+
+The output is sent through a pager if a terminal is connected to STDOUT. As
+pager are considered: C<$ENV{PAGER}>, C<less>, C<more>.
 
 =head1 OPTIONS
 
 =over
 
 
 =head1 OPTIONS
 
 =over
 
-=item B<-l>
+=item B<-l>|B<--literal>
 
 This means 'literal', that is, treat all characters in the
 pattern  as standing for themselves.  Otherwise the pattern must be a
 Perl regular expression.  The pattern match is case-insensitive.
 
 
 This means 'literal', that is, treat all characters in the
 pattern  as standing for themselves.  Otherwise the pattern must be a
 Perl regular expression.  The pattern match is case-insensitive.
 
-=item B<-t> I<seconds>
+=item B<-t>|B<--queue-time> I<seconds>
 
 Limit the output to messages that spent at least I<seconds> in the
 queue.
 
 
 Limit the output to messages that spent at least I<seconds> in the
 queue.
 
-=item B<-I>
+=item B<-I>|B<--sensitive>
 
 Do a case sensitive search.
 
 
 Do a case sensitive search.
 
-=item B<-v>
+=item B<-v>|B<--invert>
 
 Invert the meaning of the search pattern. That is, print message log
 entries that are not related to that pattern.
 
 
 Invert the meaning of the search pattern. That is, print message log
 entries that are not related to that pattern.
 
-=item B<-M>
+=item B<-M>|B<--related>
 
 Search for related messages too.
 
 
 Search for related messages too.
 
-=item B<-h>
+=item B<--no-pager>
+
+Do not use a pager, even if STDOUT is connected to a terminal.
+
+=item B<-h>|B<--help>
 
 Print a short reference help. For more detailed help try L<exigrep(8)>,
 
 Print a short reference help. For more detailed help try L<exigrep(8)>,
-or C<exigrep -m>.
+or C<exigrep --man>.
 
 
-=item B<-m>
+=item B<-m>|B<--man>
 
 Print this manual page of B<exigrep>.
 
 
 Print this manual page of B<exigrep>.
 
Master Exim source repository