git.sur5r.net Git - openldap/blob - contrib/slapd-tools/statslog

   1 #!/usr/bin/perl -w
   2 # statslog - Rearrange and output selected parts of slapd's statslog output.
   3 # $OpenLDAP$
   4 # This work is part of OpenLDAP Software <http://www.openldap.org/>.
   5 #
   6 # Copyright 1998-2018 The OpenLDAP Foundation.
   7 # Portions Copyright 2004 Hallvard B. Furuseth.
   8 # All rights reserved.
   9 #
  10 # Redistribution and use in source and binary forms, with or without
  11 # modification, are permitted only as authorized by the OpenLDAP
  12 # Public License.
  13 #
  14 # A copy of this license is available in the file LICENSE in the
  15 # top-level directory of the distribution or, alternatively, at
  16 # <http://www.OpenLDAP.org/license.html>.
  17
  18 sub usage {
  19     die join("", @_, <<'EOM');
  20 Usage: statslog [options] [logfiles; may be .gz or .bz2 files]
  21
  22   Output selected parts of slapd's statslog output (LDAP request/response
  23   log to syslog or stderr; loglevel 256), grouping log lines by LDAP
  24   connection.  Lines with no connection are excluded by default.
  25
  26 Options:
  27   --brief       -b      Brief output (omit time, host/process name/ID).
  28   --exclude=RE  -e RE   Exclude connections whose output matches REgexp.
  29   --include=RE  -i RE   Only include connections matching REgexp.
  30   --EXCLUDE=RE  -E RE   Case-sensitive '--exclude'.
  31   --INCLUDE=RE  -I RE   Case-sensitive '--include'.
  32   --loose       -l      Include "loose" lines (lines with no connection).
  33   --no-loose    -L RE   Only exclude the "loose" lines that match RE.
  34   --join        -j      Join the inputs as if they were one big log file.
  35                         Each file must start where the previous left off.
  36   --no-join     -J      Do not --join.  (Can be useful with --sort.)
  37   --sort        -s      Sort input files by age.     Implies --join.
  38   --trace       -t      Print file names when read.  Implies --no-join.
  39 All --exclude/include options are applied.  Note: --exclude/include are
  40 unreliable without --join/sort for connections spanning several log files.
  41 EOM
  42 }
  43
  44 ########################################################################
  45
  46 use bytes;
  47 use strict;
  48 use Getopt::Long;
  49
  50 # Globals
  51 my %conns;                      # Hash (connection number -> output)
  52 my @loose;                      # Collected output with no connection number
  53
  54 # Command line options
  55 my($brief, @filters, @conditions, $no_loose);
  56 my($join_files, $sort_files, $trace, $getopt_ok);
  57
  58 # Handle --include/INCLUDE/exclude/EXCLUDE options
  59 sub filter_opt {
  60     my($opt, $regexp) = @_;
  61     push(@conditions, sprintf('$lines %s /$filters[%d]/om%s',
  62                               (lc($opt) eq 'include' ? "=~" : "!~"),
  63                               scalar(@filters),
  64                               ($opt eq lc($opt) ? "i" : "")));
  65     push(@filters, $regexp);
  66 }
  67
  68 # Parse options at compile time so some can become constants to optimize away
  69 BEGIN {
  70     &Getopt::Long::Configure(qw(bundling no_ignore_case));
  71     $getopt_ok = GetOptions("brief|b"           => \$brief,
  72                             "include|i=s"       => \&filter_opt,
  73                             "exclude|e=s"       => \&filter_opt,
  74                             "INCLUDE|I=s"       => \&filter_opt,
  75                             "EXCLUDE|E=s"       => \&filter_opt,
  76                             "join|j"            => \$join_files,
  77                             "no-join|J"         => sub { $join_files = 0; },
  78                             "sort|s"            => \$sort_files,
  79                             "loose|l"           => sub { $no_loose = ".^"; },
  80                             "no-loose|L=s"      => \$no_loose,
  81                             "trace|t"           => \$trace);
  82 }
  83 usage() unless $getopt_ok;
  84 usage("--trace is incompatible with --join.\n") if $trace && $join_files;
  85
  86 $join_files = 1 if !defined($join_files) && $sort_files && !$trace;
  87 use constant BRIEF => !!$brief;
  88 use constant LOOSE => defined($no_loose) && ($no_loose eq ".^" ? 2 : 1);
  89
  90 # Build sub out(header, connection number) to output one connection's data
  91 my $out_body = (LOOSE
  92                 ? ' if (@loose) { print "\n", @loose; @loose = (); } '
  93                 : '');
  94 $out_body .= ' print "\n", $_[0], $lines; ';
  95 $out_body = " if (" . join("\n && ", @conditions) . ") {\n$out_body\n}"
  96     if @conditions;
  97 eval <<EOM;
  98 sub out {
  99     my \$lines = delete(\$conns{\$_[1]});
 100     $out_body
 101 }
 102 1;
 103 EOM
 104 die $@ if $@;
 105
 106 # Read and output log lines from one file
 107 sub do_file {
 108     local(@ARGV) = @_;
 109     my($conn, $line, $act);
 110     while (<>) {
 111         if (BRIEF
 112             ? (($conn, $line, $act) = /\bconn=(\d+) (\S+ (\S+).*\n)/)
 113             : (($conn,        $act) = /\bconn=(\d+) \S+ (\S+)/      )) {
 114             $conns{$conn} .= (BRIEF ? $line : $_);
 115             out("", $conn) if $act eq 'closed';
 116         } elsif (LOOSE && (LOOSE > 1 || !/$no_loose/omi)) {
 117             s/^\w{3} [ \d]+:\d\d:\d\d [^:]*: // if BRIEF;
 118             push(@loose, $_);
 119         }
 120     }
 121     final() unless $join_files;
 122 }
 123
 124 # Output log lines for unfinished connections
 125 sub final {
 126     if (%conns) {
 127         for my $conn (sort keys %conns) {
 128             out("UNFINISHED:\n", $conn);
 129         }
 130         die if %conns;
 131     }
 132     if (LOOSE && @loose) { print "\n", @loose; @loose = (); }
 133 }
 134
 135 # Main program
 136 if (!@ARGV) {
 137     # Read from stdin
 138     do_file();
 139 } else {
 140     if ($sort_files && @ARGV > 1) {
 141         # Sort files by last modified time; oldest first
 142         my @fileinfo;
 143         for my $file (@ARGV) {
 144             my $age = -M $file;
 145             if (defined($age)) {
 146                 push(@fileinfo, [$age, $file]);
 147             } else {
 148                 print STDERR "File not found: $file\n";
 149             }
 150         }
 151         exit(1) unless @fileinfo;
 152         @ARGV = map { $_->[1] } sort { $b->[0] <=> $a->[0] } @fileinfo;
 153     }
 154
 155     # Prepare to pipe .gz, .bz2 and .bz files through gunzip or bunzip2
 156     my %type2prog = ("gz" => "gunzip", "bz2" => "bunzip2", "bz" => "bunzip2");
 157     for (@ARGV) {
 158         if (/\.(gz|bz2?)$/) {
 159             my $type = $1;
 160             die "Bad filename: $_\n" if /^[+-]|[^\w\/.,:%=+-]|^$/;
 161             $_ = "$type2prog{$type} -c $_ |";
 162         }
 163     }
 164
 165     # Process the files
 166     for my $file (@ARGV) {
 167         print "\n$file:\n" if $trace;
 168         do_file($file);
 169     }
 170 }
 171 final();