#!/usr/bin/perl

=head1 NAME

repair-leases-too-large.pl - repair lease files that get way too big

=head1 SYNOPSIS

Sometimes the ISC DHCPd lease files get way too big because of bugs in startup
or ISC DHCPd or whatever.  It's never clear how to proceed.  On the one hand,
you don't want to delete that important information.  On the other hand, the
server won't start up with the file so damned big.

If your ISC DHCPd logs have this:

    bash$ tail -1 /var/log/dhcpd.log
    Apr 14 08:39:11 mah-server dhcpd: /var/lib/dhcp/dhcpd.leases: file is too long to buffer.

The solution might be to: maybe run this script, carefully consider the
implications of using the generated file, and then possibly use the new file

NO WARRANTY!  Backup those leases before you run this!

=head1 INSTALL

    bash# cpan List::Util Data::Dump Time::HiRes Getopt::Long common::sense
    bash# wget http://www.cpan.org/authors/id/J/JE/JETTERO/repair-leases-too-large.pl
    bash# chmod 755 repair-leases-too-large.pl
    bash# ./repair-leases-too-large.pl --help

=head1 AUTHOR

Paul Miller C<< <jettero@cpan.org> >>

=head1 COPYRIGHT

Copyright 2015 Paul Miller no rights reserved (public domain)

NO WARRANTY!  Backup those leases before you run this!

=head1 README

Your ISC DHCPd C<dhcpd.leases> file got to big?  Maybe run this script and see
if the generated file will help.

    Apr 14 08:39:11 mah-server dhcpd: /var/lib/dhcp/dhcpd.leases: file is too long to buffer.

=cut

use common::sense;
use List::Util;
use Getopt::Long qw(:config bundling);
use Time::HiRes qw(time);
use Data::Dump qw(dump);

our $VERSION = 1.0;
our $DEFAULT_LEASES = "/var/lib/dhcp/dhcpd.leases";

my %o; my %ol = (
    "help|h"    => "this help",
    "file|f=s"  => "input lease file location (default: $DEFAULT_LEASES)",
    "debug|d"   => "print leases and hosts and things as they're found (can get spammy with big files)",
    "dump|D"    => "dump memory structures to /tmp/memory-dhcpd.pl (prevents actual lease file write)",
    "limit|l=i" => "give up processing after this many records (mainly for testing, useful with -D)",
);

if( not GetOptions(\%o, keys %ol) or $o{help} ) {
    my $ml = List::Util::max(map {length} keys %ol);
    print sprintf('%*s  %s', $ml, $_, $ol{$_}), "\n" for sort keys %ol;
    exit 0;
}

$o{file} //= $DEFAULT_LEASES;

my %LEASES;
my %HOSTS;

# hide cursor, show cursor
print "\e[?25l"; END { print "\e[?25h" }
$SIG{INT} = sub {
    say "\nexiting within 5 seconds (starting now) … trying to preserve memory structures first";
    $o{limit} = $o{dump} = 1;
    alarm 5;
};

say "reading leases file $o{file}"; # XXX: should be an option
open my $in, $o{file} or die $!;

my $start = time;
my ($count, $hcount, $lcount) = (0,0,0);
my $rate  = 20_000; # just a guess

$| = 1;

my $current;
while(<$in>) {
    if( m/^}/s ) {
        $current .= $_;

        if( my ($mac) = $current =~ m/hardware ethernet (\p{IsXDigit}{1,2}(?::\p{IsXDigit}{1,2}){5})/ ) {

            $current =~ s/^\s+//;
            $current =~ s/\s+\z//;
            $current .= "\n";

            given($current) {
                when( m/^lease/ ) { $LEASES{$mac} = $current; $lcount ++; $count ++ }
                when( m/^host/  ) {  $HOSTS{$mac} = $current; $hcount ++; $count ++ }
                default { warn "ERROR: unparsable block «$current»"; sleep 1; }
            }

            if( $o{debug} ) { print $current }
            elsif( not $count % ($rate > 1000 ? $rate : 20_000) ) {
                my $dt = time - $start;
                my $r  = $count / $dt;

                $rate = int( 0.5 * $r ) + ( 0.5 * $rate );

                printf "\e[2K\rprocessing rate: %d records / second ($hcount hosts, $lcount leases)", $rate;

                last if $o{limit} and $count >= $o{limit};
            }
        }
    }

    if( m/^\s+.+/s ) { $current .= $_ }
    else             { $current  = $_ }
}

print "\n";

if( $o{dump} ) {
    say "writing memory structures to /tmp/memory-dhcpd.pl";
    open my $out, ">", "/tmp/memory-dhcpd.pl" or die $!;

    print $out dump({leases=>\%LEASES, hosts=>\%HOSTS});
}

else {
    say "writing new leases file to /tmp/dhcpd.leases";
    open my $out, ">", "/tmp/dhcpd.leases" or die $!;

    while( my (undef, $v) = each %HOSTS  ) { print $out $v }
    while( my (undef, $v) = each %LEASES ) { print $out $v }
}

say "\n∎";