view release on metacpan or  search on metacpan

lib/Net/ISC/DHCPClient.pm  view on Meta::CPAN

package Net::ISC::DHCPClient;

use 5.014;
use strict;
use warnings;


=head1 NAME

Net::ISC::DHCPClient - ISC dhclient lease reader

=head1 VERSION

Version 0.14

=cut

our $VERSION = '0.14';


use Net::ISC::DHCPClient::InetLease;
use Net::ISC::DHCPClient::Inet6Lease;
use Time::Local;


sub new {
    my ($class, %opts) = @_;

    die "Missing leases_path!" if (!defined($opts{leases_path}));

    my $self = {};

    # Incoming arguments:
    $self->{INTERFACE} = defined($opts{interface}) ? $opts{interface} : undef;
    $self->{leases_path} = $opts{leases_path};

    # Internal storage:
    $self->{leases_af_inet} = undef;
    $self->{leases_af_inet6} = undef;

    bless ($self, $class);

    return $self;
}


sub is_dhcp($$;$)
{
    my ($self, $af, $inteface_to_query) = @_;

    die "Address family is: inet or inet6!" if (!($af eq 'inet' || $af eq 'inet6'));

    if (defined($inteface_to_query) &&
        defined($self->{INTERFACE}) &&
        $self->{INTERFACE} ne $inteface_to_query) {
        die sprintf("Cannot query interface %s, has %s.", $inteface_to_query, $self->{INTERFACE});
    }
    if (defined($self->{INTERFACE})) {
        if ($af eq 'inet') {
            $self->leases_af_inet();
            return scalar(@{$self->{leases_af_inet}}) > 0;
        }
        if ($af eq 'inet6') {
            $self->leases_af_inet6();
            return scalar(@{$self->{leases_af_inet6}}) > 0;
        }

        return 0;
    }

    die "Need interface!" if (!defined($inteface_to_query));

    # Iterate all found leases and look for given interface
    my $leases_to_check;
    $leases_to_check = $self->{leases_af_inet} if ($af eq 'inet');
    $leases_to_check = $self->{leases_af_inet6} if ($af eq 'inet6');
    for my $lease (@$leases_to_check) {
        return 1 if ($lease->{INTERFACE} eq $inteface_to_query);
    }

    return 0;
}

sub leases_af_inet($)
{
    my ($self) = @_;

    return $self->{leases_af_inet} if ($self->{leases_af_inet});

    $self->{leases_af_inet} = $self->_read_lease_file($self->{leases_path},
                                                $self->{INTERFACE},
                                                'inet');

    return $self->{leases_af_inet};
}

sub leases_af_inet6($)
{
    my ($self) = @_;

    return $self->{leases_af_inet6} if ($self->{leases_af_inet6});

    $self->{leases_af_inet6} = $self->_read_lease_file($self->{leases_path},
                                                $self->{INTERFACE},
                                                'inet6');

    return $self->{leases_af_inet6};
}


sub _read_lease_file($$$$)
{
    my ($self, $path, $interface, $af) = @_;
    my @isc_lease_files;
    my @netplan_lease_files;
    my $leases = [];

    # Search for matching .lease files
    my $leasefile_re1;
    my $leasefile_re2;
    my $leasefile_re3;
    if ($af eq 'inet') {
        if ($interface) {
            $leasefile_re1 = qr/^dhclient-(.*)?-($interface)\.lease$/;
            $leasefile_re2 = qr/^dhclient\.($interface)\.leases$/;
            $leasefile_re3 = qr/^internal-(.*)?-($interface)\.lease$/;
        } else {
            $leasefile_re1 = qr/^dhclient-(.*)?-(.+)\.lease$/;
            $leasefile_re2 = qr/^dhclient\.(.+)\.leases$/;
            $leasefile_re3 = qr/^internal-(.*)?-($interface)\.lease$/;
        }
    } elsif ($af eq 'inet6') {
        if ($interface) {
            $leasefile_re1 = qr/^dhclient6-(.*)?-($interface)\.lease$/;
            $leasefile_re2 = qr/^dhclient6\.($interface)\.leases$/;
        } else {
            $leasefile_re1 = qr/^dhclient6-(.*)?-(.+)\.lease$/;
            $leasefile_re2 = qr/^dhclient6\.(.+)\.leases$/;
        }
    } else {
        die "Unknown AF! '$af'";
    }

    my @paths_to_attempt;
    if (ref($path) eq "ARRAY") {
        @paths_to_attempt = @$path;
    } else {
        @paths_to_attempt = ($path);
    }
    foreach my $lease_path (@paths_to_attempt) {
        next if (! -d $lease_path || ! -X $lease_path);
        opendir(my $dh, $lease_path) or
            die "Cannot read lease directory $lease_path. Error: $!";
        my @all_files = readdir($dh);
        @isc_lease_files = grep { /$leasefile_re1/ && -f "$lease_path/$_" } @all_files;
        @isc_lease_files = grep { /$leasefile_re2/ && -f "$lease_path/$_" } @all_files if (!@isc_lease_files);
        @netplan_lease_files = grep { /$leasefile_re3/ && -f "$lease_path/$_" } @all_files if ($leasefile_re3);
        closedir($dh);

        if (@isc_lease_files) {
            @isc_lease_files = map("$lease_path/$_", @isc_lease_files);
        }
        if (@netplan_lease_files) {
            @netplan_lease_files = map("$lease_path/$_", @netplan_lease_files);
        }
        last if (@isc_lease_files || @netplan_lease_files);
    }

    for my $leaseFile (@isc_lease_files) {
        open (LEASEFILE, $leaseFile) or
            die "Cannot open leasefile $leaseFile. Error: $!";

        my $currentLease;
        my $hasIscLeaseData = 0;
        my $ia_type = [];
        while (<LEASEFILE>) {
            chomp();
            if (/^lease? \{/) {
                $hasIscLeaseData = 1;
                $currentLease = Net::ISC::DHCPClient::InetLease->new();
                next;
            }
            if (/^lease6 \{/) {
                $hasIscLeaseData = 1;
                $currentLease = Net::ISC::DHCPClient::Inet6Lease->new();
                next;
            }
            if (/^\}/) {
                # dhclient will append lease information, newest is last.
                # unshift() will place newest first.
                unshift(@$leases, $currentLease) if ($hasIscLeaseData);
                $hasIscLeaseData = 0;
                next;
            }

            if (!$hasIscLeaseData) {
                next;
            }

            s/^\s+//;   # Eat starting whitespace
            $self->_isc_af_inet_lease_parser($currentLease, $_) if ($af eq 'inet');
            $self->_isc_af_inet6_lease_parser($currentLease, $ia_type, $_) if ($af eq 'inet6');
        } # end while (<LEASEFILE>)
        close (LEASEFILE);
    }

    for my $leaseFile (@netplan_lease_files) {
        open (LEASEFILE, $leaseFile) or
            die "Cannot open leasefile $leaseFile. Error: $!";

        my $currentLease;
        my $ia_type = [];
        while (<LEASEFILE>) {
            chomp();
            next if (!/^([^=]+)=(.*)$/);

            my $freshLease = 0;
            if (!$currentLease) {
                $currentLease = Net::ISC::DHCPClient::InetLease->new();
                $freshLease = 1;
            }
            $self->_netplan_af_inet_lease_parser($currentLease, $1, $2) if ($af eq 'inet');
            if ($freshLease) {
                # Netplan lease file doesn't have interface information in
                # the file. Parse the filename for interface.
                if ($leaseFile =~ /-([^-.]+)\.lease$/) {
                    $currentLease->{INTERFACE} = $1;
                }
            }
        } # end while (<LEASEFILE>)
        close (LEASEFILE);

        # There will be only 1 lease in the netplan lease file
        unshift(@$leases, $currentLease) if ($currentLease);
    }

    return $leases;
}

sub _isc_af_inet_lease_parser($$$)
{
    my ($self, $currentLease, $line) = @_;

    SWITCH: {
        # interface "eth1";
        /^interface\s+"(.+)";/ && do {
            $currentLease->{INTERFACE} = $1;
            last SWITCH;
        };
        # fixed-address 213.28.228.27;
        /^fixed-address\s+(.+);/ && do {
            $currentLease->{FIXED_ADDRESS} = $1;
            last SWITCH;
        };
        # option subnet-mask 255.255.255.0;
        (/^option\s+(\S+)\s*(.+);/) && do {
            $currentLease->{OPTION}{$1} = $2;
            last SWITCH;
        };
        # renew 5 2002/12/27 06:25:31;
        (m#^renew\s+(\d+)\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);#) && do {
            my $leaseTime = timegm($7, $6, $5, $4, $3-1, $2);
            $currentLease->{RENEW} = $leaseTime;
            last SWITCH;
        };
        # rebind 5 2002/12/27 06:25:31;
        (m#^rebind\s+(\d+)\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);#) && do {
            my $leaseTime = timegm($7, $6, $5, $4, $3-1, $2);
            $currentLease->{REBIND} = $leaseTime;
            last SWITCH;
        };
        # renew 5 2002/12/27 06:25:31;
        (m#^expire\s+(\d+)\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);#) && do {
            my $leaseTime = timegm($7, $6, $5, $4, $3-1, $2);
            $currentLease->{EXPIRE} = $leaseTime;
            last SWITCH;
        };
    }
}

sub _isc_af_inet6_lease_parser($$$$)
{
    my ($self, $currentLease, $ia_type, $line) = @_;

    my $context = '';
    my $addr = '';
    $context = $ia_type->[0] if (defined($ia_type->[0]));
    $addr = $ia_type->[1] if (defined($ia_type->[1]));

    SWITCH: {
        # interface "eth1";
        /^interface\s+"(.+)";/ && do {
            $currentLease->{INTERFACE} = $1;
            last SWITCH;
        };
        /^ia-na\s+(\S+)\s*\{/ && do {
            # Identity Association: Non-temporary Address
            push(@$ia_type, 'non-temporary');
            $currentLease->{IA}->{'non-temporary'} = {};
            last SWITCH;
        };
        /^ia-pd\s+(\S+)\s*\{/ && do {
            # Identity Association: Prefix Delegation
            push(@$ia_type, 'prefix');
            $currentLease->{IA}->{'prefix'} = {};
            last SWITCH;
        };
        /^\}/ && do {
            pop(@$ia_type);
            last SWITCH;
        };
        # starts 1517742816;
        # Note: either IA or address
        /^(starts)\s+(\d+);/ && do {
            if (defined($ia_type->[1])) {
                $currentLease->{IA}->{$context}->{$addr}->{$1} = $2;
            } else {
                $currentLease->{IA}->{$context}->{$1} = $2;
            }
            last SWITCH;
        };
        # renew 302400;
        /^(renew)\s+(\d+);/ && do {
            $currentLease->{IA}->{$context}->{$1} = $2;
            last SWITCH;
        };
        # rebind 483840;
        /^(rebind)\s+(\d+);/ && do {
            $currentLease->{IA}->{$context}->{$1} = $2;
            last SWITCH;
        };
        # preferred-life 604800;
        /^(preferred-life)\s+(\d+);/ && do {
            $currentLease->{IA}->{$context}->{$addr}->{$1} = $2;
            last SWITCH;
        };
        # max-life 2592000;
        /^(max-life)\s+(\d+);/ && do {
            $currentLease->{IA}->{$context}->{$addr}->{$1} = $2;
            last SWITCH;
        };