#!/usr/bin/perl -w
#
# $Id: dhcpd-report,v 1.53 2003/08/01 02:10:55 jmates Exp $
#
# The author disclaims all copyrights and releases this script into the
# public domain.
#
# Run perldoc(1) on this file for additional documentation.
#
######################################################################
#
# REQUIREMENTS

require 5;

use strict;

######################################################################
#
# MODULES

use Carp;         # better error reporting
use IO::File;     # File IO, part of core
use Getopt::Std;  # command line option processing

use Fcntl qw(:DEFAULT :flock);  # for file locking

use POSIX qw(strftime);         # pretty date formatting

use Time::Local;                # to do reverse of gmtime()

# various output modules needed set below, with eval, as some don't
# come standard with perl...

######################################################################
#
# VARIABLES

my $VERSION;
($VERSION = '$Revision: 1.53 $ ') =~ s/[^0-9.]//g;

my (%opts, $lease_file, $data, $stats, $syslog_name, $conf_file, $date);
my (
  $dumper, $syslog, $logger, $logger_file, $report, $xml,
  $quiet,  $tsv,    $ranges, $netaddrip,   $files,  $pool
);

$logger_file = "/usr/bin/logger";

# what we report ourselves as in syslog output
$syslog_name = "DHCPSTATS";

# only enable certain output routines if needed modules load properly
# if there's a better way to do this, let me know...

eval { require NetAddr::IP; };  # per-range summary
unless ($@) {
  $netaddrip = 1;
  require NetAddr::IP;
}

eval { require Data::Dumper; };  # output perl data structures
unless ($@) {
  $dumper = 1;
  require Data::Dumper;
}

eval { require Sys::Syslog; };   # output to syslog(3)
unless ($@) {
  $syslog = 1;
  require Sys::Syslog;
}

if (-x $logger_file) {
  $logger = 1;
}

######################################################################
#
# MAIN

# parse command-line options
getopts('h?stdxrlfqc:p', \%opts);

help() if exists $opts{'h'} or exists $opts{'?'};

# figure out what output methods they want

$quiet = 1 if exists $opts{'q'};

$dumper = 0 unless $dumper and exists $opts{'d'};

$tsv = 1 if exists $opts{'t'};

$xml = 1 if exists $opts{'x'};

$files = 1 if exists $opts{'f'};

$pool = 1 if exists $opts{'p'};

# default to syslog over logger, if both mentioned
$syslog = 0 unless $syslog and exists $opts{'s'};
$logger = 0 unless $logger and exists $opts{'l'} and not exists $opts{'s'};

$conf_file = $opts{'c'} if exists $opts{'c'};

# pull off leases file
$lease_file = shift or help();

$date = time;  # timestamp of when we ran

# read in the optional dhcpd.conf file
if ($conf_file) {
  open CFILE, $conf_file or die "Couldn't open $conf_file: $!\n";

  unless (flock CFILE, LOCK_SH | LOCK_NB) {
    local $| = 1;
    warn "Waiting for lock on $conf_file ...\n";
    flock CFILE, LOCK_SH or die "Can't lock $conf_file: $!\n";
  }

  $ranges = parse_conf_file(*CFILE);

  flock CFILE, LOCK_UN;
  close CFILE;
}

# read in the leases...
if ($lease_file eq '-') {
  ($data, $stats) = parse_lease_file(*STDIN);
} else {

  # read from file w/ read lock
  open FILE, $lease_file or die "Couldn't open $lease_file: $!\n";

  unless (flock FILE, LOCK_SH | LOCK_NB) {
    local $| = 1;
    warn "Waiting for lock on $lease_file ...\n";
    flock FILE, LOCK_SH or die "Can't lock $lease_file: $!\n";
  }

  ($data, $stats) = parse_lease_file(*FILE);

  flock FILE, LOCK_UN;
  close FILE;
}

# sanity checking before output stage...
unless ($data) {
  $lease_file = 'STDIN' if $lease_file eq '-';
  die "No data gained from $lease_file, quitting!\n";
}

# do the various output stuff, as required
unless ($quiet) {
  if ($files) {
    do_files($data, $stats);
  } elsif ($dumper) {
    print Data::Dumper->Dump([$date, $stats, $data], [qw(date stats data)]);
  } elsif ($tsv) {
    do_tsv($data, $stats);

  } elsif ($xml) {
    do_xml($data, $stats);
  } else {
    do_report($data, $stats);
  }
}

if ($syslog) {
  Sys::Syslog::openlog($syslog_name, 'cons', 'daemon');
  Sys::Syslog::syslog('info',
    'active: '
     . $stats->{'active'}
     . ', leases: '
     . $stats->{'leases'}
     . ', inactive: '
     . $stats->{'inactive'}
     . ', renewed: '
     . $stats->{'renewed'}
     . ', abandoned: '
     . $stats->{'abandoned'});
  Sys::Syslog::closelog();
} elsif ($logger) {
  system($logger_file, '-p', "daemon.info", '-t', $syslog_name,
    'active: '
     . $stats->{'active'}
     . ', leases: '
     . $stats->{'leases'}
     . ', inactive: '
     . $stats->{'inactive'}
     . ', renewed: '
     . $stats->{'renewed'}
     . ', abandoned: '
     . $stats->{'abandoned'});
}

exit;

######################################################################
#
# SUBROUTINES

# accepts filehandle typeglob, loops over it, populates a custom data
# structure, then passes back a ref to said hash of anon hashes.
#
# returns undef if nothing was gained from the file
sub parse_lease_file {
  my $fh = shift;

  my ($cur_ip, $data, $stats);

  # initialize some values...
  $stats->{'renewed'}   = 0;
  $stats->{'abandoned'} = 0;
  $stats->{'inactive'}  = 0;
  $stats->{'leases'}    = 0;

  while (<$fh>) {
    next if /^(\#|\})/;  # skip irrelevant lines

    # set active lease IP if match a lease line
    if (
      /^lease\s+(?!0)((?:(?:[01]?\d\d?|2[0-4]\d|25[0-5])\.){3}
			    (?:[01]?\d\d?|2[0-4]\d|25[0-5]))\s+\{/x
     ) {
      $cur_ip = $1;

      $stats->{'leases'}++;

      # this is why the zero is important
      if (exists $data->{$cur_ip}) {
        $data->{$cur_ip}->[0]->{'status'} = 'renewed';
        unshift @{$data->{$cur_ip}}, {};
        $stats->{'renewed'}++;
      }

      next;
    }

    # only extract lease-specific info if we have a current ip!
    if ($cur_ip) {
      my ($key, $value) =
       $_ =~ /^\s+([a-z -]+[a-z-]+)    # match keys like "starts"
		    \s*\"?(.+?)?\"?\;     # pull out key's value
	    /x;

      # change 'hardware ethernet' for XML compatibility
      $key = 'mac' if $key eq 'hardware ethernet';

      # convert their wacky GMT date into epoch format
      if ($key eq 'starts' || $key eq 'ends') {
        my ($year, $mon, $day, $hh, $mm, $ss) =
         $value =~ m!(\d{4})/(\d\d)/(\d\d)\s(\d\d):(\d\d):(\d\d)!;

        $mon--;  # months need to be 0 .. 11

        $value = timegm($ss, $mm, $hh, $day, $mon, $year);
      }

      # check for abandoned leases
      if ($key eq 'abandoned') {

        if ($netaddrip) {

          my $ip = NetAddr::IP->new($cur_ip)
           or warn "Failed to make an IP address out of $cur_ip";

          if ($ip) {
            for my $i (0 .. $#$ranges) {
              if (  $ip ge $ranges->[$i]->[0]
                and $ip le $ranges->[$i]->[1]) {
                $ranges->[$i]->[4]++;
                last;
              }
            }
          }
        }

        $data->{$cur_ip}->[0]->{'status'} = 'abandoned';
        $stats->{'abandoned'}++;

        next;
      }

      # the zero is important
      $data->{$cur_ip}->[0]->{$key} = $value;
    }
  }

  # skip out early if nothing to summarize on...
  return unless keys %$data;

  # find inactive leases among the first order entries and record
  # their IP in stats.  Inactive are those whose end date is in
  # the past, but are not abandoned.
  for (keys %$data) {
    unless (defined $data->{$_}->[0]->{'status'}) {
      if ($data->{$_}->[0]->{'ends'} < $date) {

        if ($netaddrip) {
          my $ip = NetAddr::IP->new($_)
           or warn "Failed to make an IP address out of $_";

          if ($ip) {
            for my $i (0 .. $#$ranges) {
              if (  $ip ge $ranges->[$i]->[0]
                and $ip le $ranges->[$i]->[1]) {
                $ranges->[$i]->[3]++;
                last;
              }
            }
          }
        }

        $data->{$_}->[0]->{'status'} = 'inactive';
        $stats->{'inactive'}++;

      } else {

        if ($netaddrip) {
          my $ip = NetAddr::IP->new($_)
           or warn "Failed to make an IP address out of $_";

          if ($ip) {
            for my $i (0 .. $#$ranges) {
              if (  $ip ge $ranges->[$i]->[0]
                and $ip le $ranges->[$i]->[1]) {
                $ranges->[$i]->[2]++;
                last;
              }
            }
          }
        }

        $data->{$_}->[0]->{'status'} = 'active';
        $stats->{'active'}++;
      }
    }
  }

  return $data, $stats;
}

# for gleaning information from dhcpd.conf
sub parse_conf_file {
  my $fh = shift;

  my @ranges = ();

  return \@ranges unless $netaddrip;

  while (my $line = <$fh>) {
    if ($pool and $line =~ /range\s+([\d\.]+)\s+([\d\.]+)\s*;/) {
      chomp $line;

      my $sip = NetAddr::IP->new($1);
      my $eip = NetAddr::IP->new($2);

      unless ($sip and $eip) {
        warn "Did not understand range '$line'\n";
        next;
      }

      push @ranges, [$sip, $eip, 0, 0, 0];

    } elsif (not $pool
      and $line =~ /subnet\s+([\d\.]+)\s+netmask\s+([\d\.]+)/) {

      chomp $line;

      my $ip = NetAddr::IP->new($1, $2);

      unless ($ip) {
        warn "Did not understand subnet '$line'\n";
        next;
      }

      push @ranges, [$ip->network, $ip->broadcast, 0, 0, 0];
    }

  }

  return \@ranges;
}

# for a simple easy-to-read human output to STDOUT
sub do_report {
  my ($data, $stats) = @_;

  print "DHCP usage stats from $lease_file at "
   . strftime("%a, %d %b %Y %H:%M:%S %Z", localtime($date)) . ":\n\n";

  print "Active leases: "
   . $stats->{'active'}
   . " of the "
   . $stats->{'leases'}
   . " leases on record.\n\n";

  print "Also have "
   . $stats->{'inactive'}
   . " inactive, "
   . $stats->{'renewed'}
   . " renewed leases, and "
   . $stats->{'abandoned'}
   . " abandoned.\n\n";

  if ($netaddrip) {
    for my $r (@$ranges) {
      my $size = $r->[1]->numeric - $r->[0]->numeric + 1;
      print(
        ($pool ? "Range " : "Subnet "),
        $r->[0]->addr,
        " - ",
        $r->[1]->addr,
        " ($size available): $r->[2] active, ",
        "$r->[3] inactive, $r->[4] abandoned\n"
      );
    }
  }

}

# File - per - subnet - or - range report useful for feeding snmp servers
sub do_files {
  my ($data, $stats) = @_;

  push @$ranges,
   [
    NetAddr::IP->new('default')->network,
    NetAddr::IP->new('default')->broadcast,
    $stats->{active},
    $stats->{inactive},
    $stats->{abandoned}
   ];

  my @name = ('active', 'inactive', 'abandoned');

  for my $r (@$ranges) {
    for my $i (0 .. 2) {
      my $name = $r->[0]->addr . '.' . $name[$i];
      my $fh   = IO::File->new(">$name");
      unless ($fh) {
        warn "Failed to create output file $name: $!\n";
        next;
      }
      print $fh $r->[$i + 2], "\n";
      $fh->close;
    }
  }

}

# line-per-lease output format easy to sic other command utilities at
sub do_tsv {
  my ($data, $stats) = @_;

  for my $ip (sort keys %$data) {
    for my $entry (@{$data->{$ip}}) {
      print 'IP=', $ip;

      for (sort keys %$entry) {
        print "\t", $_;

        print '=', $entry->{$_} if defined $entry->{$_};
      }
      print "\n";
    }
  }
}

# XML output (probably not valid XML, but hey, it's my first stab! :)
sub do_xml {
  my ($data, $stats) = @_;

  print '<?xml version="1.0" standalone="no"?>',    "\n";
  print '<!DOCTYPE isc-dhcpd-lease-report SYSTEM ', "\n";
  print
   '  "http://sial.org/schema/dtd/network/isc-dhcpd-lease-report.dtd">',
   "\n\n";

  print '<isc-dhcpd-lease-report>', "\n";
  print '  <date>', strftime("%a, %d %b %Y %H:%M:%S %Z", localtime($date)),
   "</date>\n\n";

  print "  <statistics>\n";
  print "    <$_>", $stats->{$_}, "</$_>\n" for keys %$stats;
  print "  </statistics>\n\n";

  for my $ip (sort keys %$data) {
    for my $entry (@{$data->{$ip}}) {
      print '  <lease ip="', $ip, '" status="', $entry->{'status'}, "\">\n";

      for (keys %$entry) {
        next if $_ eq 'status';

        # convert epoch to redable date...
        if ($_ eq 'starts' || $_ eq 'ends') {
          $entry->{$_} =
           strftime("%a, %d %b %Y %H:%M:%S %Z", localtime($entry->{$_}));
        }

        if (defined $entry->{$_}) {
          print "    <$_>", $entry->{$_}, "</$_>\n";
        } else {
          print "    <$_/>\n";
        }
      }
      print "  </lease>\n\n";
    }
  }

  print '</isc-dhcpd-lease-report>', "\n";
}

# a generic help blarb
sub help {
  print <<"HELP";
Usage: $0 [opts] /path/to/dhcpd.leases

A dhcpd.leases file information gleaner.

Options for version $VERSION:
  -h/-?  Display this message.

  -c xx  Read dhcpd.conf information from file xx.

  Output formats possibly available are:
  -r     Output a brief, human readable report (default).
  -d     Data::Dumper to dump perl structures, if available.
  -t     TSV output of results.
  -x     XML output of results.
  -f     Output a set of files per range or subnet
  -q     Quiet, turns off above output methods.

  -s     Sys::Syslog to summarize to syslog, if available.
  -p	 Use the 'pool' declaration instead of the 'subnet' declaration
  -l     Use logger(1) to summarize to syslog, if available.

Run perldoc(1) on this script for additional documentation.

HELP
  exit;
}

######################################################################
#
# DOCUMENTATION

=head1 NAME

dhcpd_report.pl - informative data from dhcpd.leases

=head1 SYNOPSIS

For a quick report on the current status in human-readable output:

  $ dhcpd_report.pl /etc/dhcpd.leases

See L<"EXAMPLES"> for more uses.

=head1 DESCRIPTION

This script aims to extract the data contained in the ISC DHCPD
dhcpd.leases(5) file into a more workable/readable format.  Brief
summary notes can be sent to syslog, or XML snapshots made to
facilitate translation to a webpage.  If supplied with the
dhcpd.conf(5) file for the server, data can be additionally broken
down by either subnet or range definitions.

The ISC DHCP suite is currently available from:

http://www.isc.org/products/DHCP/

=head2 Normal Usage

  $ dhcpd_report.pl [options] (dhcpd.leases|-)

See L<"OPTIONS"> for details on the command line switches supported.

You can replace the path to the leases file with a - character to have
the script pull the leases information from STDIN.

Without arguments, a brief help blarb is printed out.

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

=item B<-h>, B<-?>

Prints a brief usage note about the script.

=item B<-c> I<dhcpd.conf>

Read in dhcpd.conf(5) information from the specified file location.

=back

=head2 Output formats

Note that some of the output formats may not be available, as they
could rely on a perl module or application not present on your system:

=over 4

=item B<-r>

Output a brief, human readable report.  This option will be used if no
other output options are specified, otherwise, the precedence
currently favors -f over -d over -x over -r.

=item B<-d>

Use L<Data::Dumper|Data::Dumper> to output the internal perl data
structures, if available.

=item B<-t>

TSV output of results, subkeyed on key=value parameters.

=item B<-x>

XML output of results.

=item B<-f>

When used with -c, send output to a set of files suitable for use as
data sources in SNMP or other applications.

=item B<-q>

Turn off above output methods that use STDOUT.  Ideal for getting just
syslog information, using -s or -l, below.

=item B<-s>

Use L<Sys::Syslog|Sys::Syslog> to summarize to syslog, if available.
See L<"BUGS"> for why there is also a -l option.

=item B<-l>

Use logger(1) to summarize to syslog, if available.  See the VARIABLES
section of the script for the default location logger is looked for.

=item B<-p>

When analyzing the config file (using -c) to generate usage reports on
individual segments of the managed pool, provide information for each
range instead of each subnet which is the default.

=back

If both -s and -l options are specified, -s will be used.  Use of
either is possible in conjunction with one of the other options that
send results to STDOUT.  See L<"EXAMPLES"> for more details.

=head1 EXAMPLES

To both echo to syslog and output a XML report to a file:

 $ dhcpd_report.pl -xs /etc/dhcpd.leases > /var/log/dhcp/current.xml

From crontab(5), to place hourly reports into syslog using logger
without generating anything to STDOUT:

 0 * * * * /usr/local/bin/dhcpd_report.pl -lq /etc/dhcpd.leases

=head1 FILES

This script depends on a dhcpd.leases file being available for
parsing.  Common locations include /etc or /var/lib/dhcpd, depending
on your system.  The dhcpd(8) binary should show you the location, if
all else fails:

  # strings /usr/sbin/dhcpd | grep dhcpd.leases

Optionally, the script also needs access to the dhcpd.conf file, which
is typically found under /etc.

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

On certain systems, L<Sys::Syslog|Sys::Syslog> does not work, e.g.
RedHat Linux distributions where there is no syslog.ph header file
generated by h2ph.  For that reason, there is also a -l option that
makes a system call to logger(1).

=head1 SEE ALSO

crontab(5), dhcpd.conf(5), dhcpd.leases(5), logger(1), perl(1)

=head1 AUTHOR

Jeremy Mates, http://sial.org/contact/

Luis Muñoz <lem at cantv.net> contributed code for configuration file
parsing, subnet/range support and SNMP file output.

=head1 COPYRIGHT

The author disclaims all copyrights and releases this script into the
public domain.

=head1 VERSION

$Id: dhcpd-report,v 1.53 2003/08/01 02:10:55 jmates Exp $

=head1 SCRIPT CATEGORIES

Networking

=cut