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-2011 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
18sub usage {
19    die join("", @_, <<'EOM');
20Usage: 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
26Options:
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.
39All --exclude/include options are applied.  Note: --exclude/include are
40unreliable without --join/sort for connections spanning several log files.
41EOM
42}
43
44########################################################################
45
46use bytes;
47use strict;
48use Getopt::Long;
49
50# Globals
51my %conns;			# Hash (connection number -> output)
52my @loose;			# Collected output with no connection number
53
54# Command line options
55my($brief, @filters, @conditions, $no_loose);
56my($join_files, $sort_files, $trace, $getopt_ok);
57
58# Handle --include/INCLUDE/exclude/EXCLUDE options
59sub 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
69BEGIN {
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}
83usage() unless $getopt_ok;
84usage("--trace is incompatible with --join.\n") if $trace && $join_files;
85
86$join_files = 1 if !defined($join_files) && $sort_files && !$trace;
87use constant BRIEF => !!$brief;
88use constant LOOSE => defined($no_loose) && ($no_loose eq ".^" ? 2 : 1);
89
90# Build sub out(header, connection number) to output one connection's data
91my $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;
97eval <<EOM;
98sub out {
99    my \$lines = delete(\$conns{\$_[1]});
100    $out_body
101}
1021;
103EOM
104die $@ if $@;
105
106# Read and output log lines from one file
107sub 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
125sub 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
136if (!@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}
171final();
172