Fix debug_print_socket()
[exim.git] / src / src / exigrep.src
index abc6f3a31323d1e7d2e7906ee704999818b4ca10..fd07fd8f1bd46fdef5a298e858f19b5faf6f95af 100644 (file)
@@ -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
 # 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);
 
 
@@ -44,7 +47,7 @@ use POSIX qw(mktime);
 
 sub seconds {
 my($year,$month,$day,$hour,$min,$sec,$tzs,$tzh,$tzm) =
 
 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;
+  $_[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;
 
@@ -61,10 +64,17 @@ 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 = ();
 
@@ -75,7 +85,7 @@ sub do_line {
 if (!/^\d{4}-/o) { $_ =~ s/^.*? exim\b.*?: //o; }
 
 return unless
 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;
+  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
 
 # 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
@@ -116,7 +126,7 @@ if (defined $id)
   if (index($_, 'Completed') != -1 ||
       index($_, 'SMTP data timeout') != -1 ||
         (index($_, 'rejected') != -1 &&
   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))
+          /^(\d{4}-\d\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 ($queue_time != -1 &&
         $saved{$id} =~ /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d ([+-]\d{4} )?)/o)
@@ -150,7 +160,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;
 
@@ -206,30 +217,44 @@ sub get_related_ids {
 # which is an additional condition. The -M flag will also display "related"
 # loglines (msgid from matched lines is searched in following lines).
 
 # 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
 
 # Start a pager if output goes to a terminal
-if (-t 1)
+if (-t 1 and $use_pager)
   {
   {
-  foreach ($ENV{PAGER}//(), 'less', 'more')
+  # 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;
     }
     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.
@@ -290,43 +315,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>.