ldapgraphd

#!/usr/bin/perl

# ldapgraph -- An rrdtool-based graphing tool for LDAP server statistics
# copyright (c) 2006-2011 Chris St. Pierre <chris.a.st.pierre@gmail.com>
# based on mailgraph copyright (c) 2000-2005 David Schweikert <dws@ee.ethz.ch>
# released under the GNU General Public License

use strict;
use warnings;
use RRDs;
use File::Tail;
use Getopt::Long;
use POSIX 'setsid';
use Parse::389Log;
use Parse::OpenLDAPLog;
use Pod::Usage;

my $VERSION = "1.1.3";

# config
my $rrdstep = 60;
my $xpoints = 540;
my $points_per_sample = 3;

# global variables
my $this_minute;
my %sum = ( add => 0, srch => 0, bind => 0, mod => 0, del => 0, ext => 0,
	    cmp => 0, modrdn => 0,
	    connxn => 0, ssl => 0, tls => 0, sasl => 0, unsasl => 0);
my $rrd_inited=0;

my %opt = ();
Getopt::Long::Configure('no_ignore_case');
GetOptions(\%opt,
	   'help|h', 'logfile|l=s', 'year|y=i', 'daemon|d!', 'pidfile=s',
	   'rrddir=s', 'instance|I=s', '389') or exit(1);
pod2usage(0) if $opt{'help'};

my $pidfile = $opt{'pidfile'} || '/var/run/ldapgraph.pid';
my $rrd_dir = $opt{'rrddir'}  || '/var/lib/ldapgraph';
my $ops_rrd = "$rrd_dir/fds_ops.rrd";
my $connxn_rrd = "$rrd_dir/fds_connxn.rrd";

die "ldapgraphd: can't write to $rrd_dir\n" unless -w $rrd_dir;

daemonize() if $opt{'daemon'};

my ($logfile, $logtype);
if ($opt{'logfile'}) {
    $logfile = $opt{'logfile'};
    if ($opt{'389'}) {
        $logtype = '389';
    } else {
        $logtype = 'openldap';
    }
} else { # no logfile specified -- use the instance to figure it out
    $logtype = '389';
    my ($ds_version, $instance);
    if ($opt{'instance'}) {
	$instance = $opt{'instance'};
	if (-d "/var/log/dirsrv/slapd-$instance" &&
	    -r "/var/log/dirsrv/slapd-$instance") {
	    $ds_version = "1.1";
	} elsif (-d "/opt/fedora-ds/slapd-$instance" &&
		 -r "/opt/fedora-ds/slapd-$instance") {
	    $ds_version = "1.0";
	} else {
	    die "Could not read or locate logs in either " .
		"/var/log/dirsrv/slapd-$instance or " .
		"/opt/fedora-ds/slapd-$instance\n";
	}
    } else { # no instance specified on the command line
	# try to determine the instance
	if (-d "/opt/fedora-ds" && -r "/opt/fedora-ds") {
	    $ds_version = "1.0";
	} elsif (-d "/var/log/dirsrv" && -r "/var/log/dirsrv") {
	    $ds_version = "1.1";
	} else {
	    die "No installation of 389 DS found\n";
	}
	
	my $dsroot;
	if ($ds_version eq '1.0') {
	    $dsroot = "/opt/fedora-ds";
	} elsif ($ds_version eq '1.1') {
	    $dsroot = "/var/log/dirsrv";
	}
	
	opendir(DIR, $dsroot); # made sure it was readable earlier
	my $file;
	my @instances;
	while (defined($file = readdir(DIR))) {
	    push(@instances, $file) if $file =~ /^slapd-/;
	}
	closedir(DIR);
	
	if (scalar(@instances) == 1) {
	    $instance = shift(@instances);
	    $instance =~ s/^slapd-//;
	} elsif (scalar(@instances) == 0) {
	    die "No instance ($dsroot/slapd-*) found in $dsroot\n";
	} else { # scalar(@instances) > 1
	    warn "More than one instance of 389 DS found in $dsroot\n";
	    die "You must specify an instance on the command line with -I\n";
	}
    }
    
    if ($ds_version eq '1.0') {
	$logfile = "/opt/fedora-ds/slapd-$instance/logs/access";
    } elsif ($ds_version eq '1.1') {
	$logfile = "/var/log/dirsrv/slapd-$instance/access";
    }
}

my $file = File::Tail->new(name => $logfile, tail => -1);
my $parser;
if ($logtype eq '389') {
    $parser = new Parse::389Log($file,
                                year     => $opt{'year'},
                                arrayref => 1);
} else {
    $parser = new Parse::OpenLDAPLog($file,
                                     year     => $opt{'year'},
                                     arrayref => 1);
}

while(my $line = $parser->nextline()) {
    process_line($line);
}

##################################################

sub daemonize {
    open STDIN, '<', '/dev/null'
	or die "ldapgraphd: can't read /dev/null: $!";
    open STDOUT, '>', '/dev/null'
	or die "ldapgraphd: can't write to /dev/null: $!";

    defined(my $pid = fork) or die "ldapgraphd: can't fork: $!";
    if ($pid) {
	# parent
	open my $PIDFILE, ">", $pidfile
	    or die "ldapgraphd: can't write to $pidfile: $!\n";
	print $PIDFILE "$pid\n";
	close($PIDFILE);
	exit;
    }
    # child
    setsid or die "ldapgraphd: can't start a new session: $!";
    open STDERR, '>', '&STDOUT' or die "ldapgraphd: can't dup stdout: $!";
    return;
}

sub init_rrd {
    my $m = shift;
    my $rows = $xpoints / $points_per_sample;
    my $realrows = int($rows * 1.1); # ensure that the full range is covered
    my $day_steps = int(3600 * 24 / ($rrdstep * $rows));
    # use multiples, otherwise rrdtool could choose the wrong RRA
    my $week_steps  = $day_steps   * 7;
    my $month_steps = $week_steps  * 5;
    my $year_steps  = $month_steps * 12;

    if(! -f $ops_rrd) {
	RRDs::create($ops_rrd, '--start', $m, '--step', $rrdstep,
		     'DS:add:GAUGE:'  . ($rrdstep * 2) . ':0:U',
		     'DS:srch:GAUGE:' . ($rrdstep * 2) . ':0:U',
		     'DS:bind:GAUGE:' . ($rrdstep * 2) . ':0:U',
		     'DS:mod:GAUGE:'  . ($rrdstep * 2) . ':0:U',
		     'DS:del:GAUGE:'  . ($rrdstep * 2) . ':0:U',
		     'DS:ext:GAUGE:'  . ($rrdstep * 2) . ':0:U',
		     "RRA:AVERAGE:0.5:$day_steps:$realrows",   # day
		     "RRA:AVERAGE:0.5:$week_steps:$realrows",  # week
		     "RRA:AVERAGE:0.5:$month_steps:$realrows", # month
		     "RRA:AVERAGE:0.5:$year_steps:$realrows",  # year
		     "RRA:MAX:0.5:$day_steps:$realrows",   # day
		     "RRA:MAX:0.5:$week_steps:$realrows",  # week
		     "RRA:MAX:0.5:$month_steps:$realrows", # month
		     "RRA:MAX:0.5:$year_steps:$realrows",  # year
	    );
	my $err = RRDs::error;
	warn "create of $ops_rrd failed: $err\n" if $err;
	$this_minute = $m;
    } elsif (-f $ops_rrd) {
	# CMP and MODRDN op tracking added in v1.0.3;
	# upgrade old DBs if necessary
	foreach my $op (qw(cmp modrdn)) {
	    chomp(my $has_op = `rrdtool info $ops_rrd | grep -F 'ds[$op]' | wc -l`);
	    if (!$has_op) {
		add_ds($ops_rrd, $op, 'GAUGE', $rrdstep * 2, 0, 'U');
	    }
	}

	$this_minute = RRDs::last($ops_rrd) + $rrdstep;
    }    

    if (!-f $connxn_rrd) {
	RRDs::create($connxn_rrd, '--start', $m, '--step', $rrdstep,
		     'DS:connxn:GAUGE:' . ($rrdstep * 2) . ':0:U',
		     'DS:ssl:GAUGE:'    . ($rrdstep * 2) . ':0:U',
		     'DS:tls:GAUGE:'    . ($rrdstep * 2) . ':0:U',
		     'DS:sasl:GAUGE:'    . ($rrdstep * 2) . ':0:U',
		     "RRA:AVERAGE:0.5:$day_steps:$realrows",   # day
		     "RRA:AVERAGE:0.5:$week_steps:$realrows",  # week
		     "RRA:AVERAGE:0.5:$month_steps:$realrows", # month
		     "RRA:AVERAGE:0.5:$year_steps:$realrows",  # year
		     "RRA:MAX:0.5:$day_steps:$realrows",   # day
		     "RRA:MAX:0.5:$week_steps:$realrows",  # week
		     "RRA:MAX:0.5:$month_steps:$realrows", # month
		     "RRA:MAX:0.5:$year_steps:$realrows",  # year
	    );
	my $err = RRDs::error;
	warn "create of $connxn_rrd failed: $err\n" if $err;
	$this_minute = $m;
    } elsif (-f $connxn_rrd) {
	# TLS tracking added in v0.3, SASL bind tracking added in v1.0.2
	# upgrade old DBs if necessary
	foreach my $conn (qw(tls sasl)) {
	    chomp(my $has_conn = `rrdtool info $connxn_rrd | grep -F 'ds[$conn]' | wc -l`);
	    if (!$has_conn) {
		add_ds($connxn_rrd, $conn, 'GAUGE', $rrdstep * 2, 0, 'U');
	    }
	}

	$this_minute = RRDs::last($connxn_rrd) + $rrdstep;
    }

    $rrd_inited = 1;
    return;
}

# much code for add_ds taken from add_ds.pl,
# Copyright (C) 2000 Selena M. Brewington, covered under the GPL
sub add_ds {
    my ($rrd, $ds, $type, $heartbeat, $llim, $ulim) = @_;
    
    if ($llim eq 'U') {
	$llim = 'NaN';
    }
    if ($ulim eq 'U') {
	$ulim = 'NaN';
    }

    # we export the RRD to XML, munge the XML, then re-import it
    
    # first, BACK UP THE RRD!
    system("cp $rrd $rrd.bak");

    my $cdp_prep_end = '</cdp_prep>';
    
    my $row_end = '</row>';
    my $name = '<name>';
    my $name_end = '</name>';
    
    my $field = '<v> NaN </v>';
    
    my $found_ds = 0;
    my $num_sources = 0;
    my $last;
    my $fields = " ";
    my $datasource;

    # export to XML
    system("rrdtool dump $rrd $rrd.xml");

    # input XML
    open(my $IN, '<', "$rrd.xml") or do {
	warn "Couldn't open $rrd.xml for read: $!\n";
	warn "Conversion of RRD was not successful\n";
	return;
    };

    # open file to write munged XML to
    open(my $OUT, '>', "$rrd-fixed.xml") or do {
	warn "Couldn't open $rrd-fixed.xml for write: $!\n";
	warn "Conversion of RRD was not successful\n";
	return;
    };

    while (<$IN>) {
	if (($_ =~ s/$row_end$/$fields$row_end/) && $found_ds) {
	    # need to hit <ds> types first, if we don't, we're screwed
	    print $OUT; 
	} elsif (/$cdp_prep_end/) {
	    print $OUT "\t\t\t<ds>\n";
	    print $OUT "\t\t\t<primary_value> NaN </primary_value>\n";
	    print $OUT "\t\t\t<secondary_value> NaN </secondary_value>\n";
	    print $OUT "\t\t\t<value> 0.0000000000e+00 </value>\n";
	    print $OUT "\t\t\t<unknown_datapoints> 0 </unknown_datapoints>\n";
	    print $OUT "\t\t\t</ds>\n";
	    print $OUT;
	} elsif (/$name_end$/) {
	    ($datasource) = /$name (\w+)/;
	    $found_ds++;
	    print $OUT;
	} elsif (/Round Robin Archives/) {
	    # print out additional datasource definitions
	    ($num_sources) = ($datasource =~ /(\d+)/);

	    for (my $x = $num_sources; $x < $num_sources + 1; $x++) {
		$fields .= $field;
		print $OUT "\n\t<ds>\n";
		print $OUT "\t\t<name> $ds <\/name>\n";
		print $OUT "\t\t<type> $type <\/type>\n";
		print $OUT "\t\t<minimal_heartbeat> $heartbeat <\/minimal_heartbeat>\n";
		print $OUT "\t\t<min> $llim <\/min>\n";
		print $OUT "\t\t<max> $ulim <\/max>\n\n";
		print $OUT "\t\t<!-- PDP Status-->\n";
		print $OUT "\t\t<last_ds> 0 <\/last_ds>\n";
		print $OUT "\t\t<value> 0.0000000000e+00 <\/value>\n";
		print $OUT "\t\t<unknown_sec> 0 <\/unknown_sec>\n"; 
		print $OUT "\t<\/ds>\n\n";
	    }
	    print $OUT;
	} else {
	    print $OUT;
	}
	
	$last = $_;
    }

    close($OUT);
    close($IN);

    # import from fixed XML
    unlink($rrd);
    system("rrdtool restore $rrd-fixed.xml $rrd");

    return;
}

sub process_line {
    my $sl = shift;
    my $time = $sl->[0];
    my $op   = $sl->[1];
    my $text = $sl->[2];

    if ($op) {
	if ($op =~ /^ADD|SRCH|MOD|DEL|CMP|MODRDN$/) {
	    event($time, lc($op));
	} elsif ($op eq 'BIND') {
	    event($time, 'bind');
	    event($time, 'sasl') if $text =~ /^method=sasl/;
	} elsif ($op eq 'RESULT' && $text =~ /^err=14 tag=97/) {
	    # SASL bind in progress
	    event($time, 'unsasl');
	} elsif ($op eq 'EXT') {
	    event($time, 'ext');
	    event($time, 'tls')
		if $text =~ /oid="1\.3\.6\.1\.4\.1\.1466\.20037"/;
	} elsif ($op eq 'SSL' && $text =~ /^connection from/) {
	    event($time, 'ssl');
	} elsif ($op eq 'ACCEPT') {
            if ($text =~ /:636\)/) {
                # OpenLDAP doesn't clearly flag SSL connections, so we
                # have to guess based on port number
                event($time, 'ssl');
            } else {
                event($time, 'connxn');
            }
        }
    } elsif ($text =~ /^connection from/) {
        # 389 doesn't flag connections with an operation
        event($time, 'connxn');
    }

    return;
}

sub event {
    my ($t, $type) = @_;
    update($t) and $sum{$type}++;
    return;
}

# returns 1 if $sum should be updated
sub update {
    my $t = shift;
    my $m = $t - $t % $rrdstep;
    init_rrd($m) unless $rrd_inited;
    return 1 if $m == $this_minute;
    return 0 if $m < $this_minute;

    RRDs::update($ops_rrd,
		 $this_minute . ':' .
		 $sum{'add'} . ':' .
		 $sum{'srch'} . ':' .
		 $sum{'bind'} . ':' .
		 $sum{'mod'} . ':' .
		 $sum{'del'} . ':' .
		 $sum{'ext'} . ':' .
		 $sum{'cmp'} . ':' .
		 $sum{'modrdn'});
    my $err = RRDs::error;
    warn "update of $ops_rrd failed: $err\n" if $err;

    # since TLS connections are initialized with the StartTLS EXT operation,
    # and SASL connections are initialized at BIND time, they get counted
    # as _both_ plaintext _and_ TLS or SASL.  (E.g., one count for the initial
    # connection, which is plaintext at that time, and one count later when
    # the connection is secured.)  Although the code here counts TLS and
    # SASL connections twice -- thus inflating the 'connxn' counter -- that
    # inflation is undone when the graph is drawn.
    #
    # this should be corrected, but tuning the data in an RRD like that would
    # be difficult.  As it stands, existing 389 DS Graph users already have
    # lots of data in this format, so we're stuck with this for a while at
    # least.
    RRDs::update($connxn_rrd,
		 $this_minute . ':' .
		 $sum{'connxn'} . ':' .
		 $sum{'ssl'} . ':' .
		 $sum{'tls'} . ':' .
		 ($sum{'sasl'} - $sum{'unsasl'}));
    $err = RRDs::error;
    warn "update of $connxn_rrd failed: $err\n" if $err;

    if ($m > $this_minute + $rrdstep) {
	for (my $sm = $this_minute + $rrdstep; $sm < $m; $sm += $rrdstep) {
	    RRDs::update($ops_rrd, "$sm:0:0:0:0:0:0:0:0");
	    RRDs::update($connxn_rrd, "$sm:0:0:0:0");
	}
    }
    $this_minute = $m;
    $sum{'add'} = 0;
    $sum{'srch'} = 0;
    $sum{'bind'} = 0;
    $sum{'mod'} = 0;
    $sum{'del'} = 0;
    $sum{'ext'} = 0;
    $sum{'cmp'} = 0;
    $sum{'modrdn'} = 0;
    $sum{'connxn'} = 0;
    $sum{'sasl'} = 0;
    $sum{'unsasl'} = 0;
    $sum{'ssl'} = 0;
    $sum{'tls'} = 0;
    return 1;
}

__END__

=head1 NAME

ldapgraphd - Graphing and statistics for 389 Directory Server

=head1 SYNOPSIS

B<ldapgraphd> [--logfile=</path/to/logfile>] [--year=<year>] [--daemon]
   [--pidfile=<pidfile>] [--rrddir=<rrddir>] [--instance=<instance_name>]

B<ldapgraphd> -h

=head1 DESCRIPTION

B<ldapgraphd> is a Perl daemon that reads access logs from 389
Directory Server and creates graphs of the data with RRDtool.  It
works with 389 DS, RHDS, Sun DS, and earlier Fedora DS versions,
including Fedora DS 1.0.x.  OpenLDAP support is forthcoming.

=head1 LOG FILE SELECTION

B<ldapgraphd> provides several options for selecting the log file to
read from:

=over

=item For 389 DS or Fedora DS logs, you can supply the B<< -I
<instance> >> flag to specify the instance whose log you wish to
follow.

=item For OpenLDAP logs, you must supply the B<< -l <logfile> >> flag
to specify the full path to the log to follow.

=item For 389 DS, Fedora DS, RHDS, or Sun DS logs, you may supply both
the B<< -l <logfile> >> flag to specify the full path to the log, and
the B<< --389 >> flag to inform ldapgraphd that the log is a 389-style
log.  By default, a log file specified with B<< -l <logfile> >> is
assumed to be an OpenLDAP log.

=item If you have only a single 389 DS or Fedora DS instance, you can
specify no log selection options at all to use the access log for the
single instance.

=back

=head1 OPTIONS

=over

=item B<< --logfile=<logfile> >>, B<< -l <logfile> >>

=over

Full path to the OpenLDAP log file.  To use B<-l> with 389 DS, Fedora
DS, RHDS, or Sun DS, you must also pass the B<--389> flag.

=back

=item B<--389>

=over

Use the 389 DS-style parser for a log file specified with the B<-l>
option.

=back

=item B<< instance=<instance_name> >>, B<< -I <instance_name> >>

=over

Track data for the specified 389 DS or Fedora DS instance.  If you
specify an instance name with this option, do not include C<slapd->.

=back

=item B<< --year=<year> >>, B<< -y <year> >>

=over

The log files parsed by ldapgraphd are from the specified year.
Default is the current year.

=back

=item B<--daemon>, B<-d>

=over

Daemonize ldapgraphd

=back

=item B<< --pidfile=<pidfile> >>

=over

Write ldapgraphd's PID to the specified file instead of
C</var/run/ldapgraph.pid>

=back

=item B<< --rrddir=<rrddir> >>

=over

Write the RRDs to the specified directory instead of
C</var/lib/ldapgraph>.

=back

=item B<-h>

=over

Display usage information

=back

=back

=head1 SEE ALSO

L<rrdtool(1)>, L<RRDs(3)>

=head1 AUTHOR

Chris St. Pierre <chris.a.st.pierre@gmail.com>