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