#!/usr/bin/perl

# $Id: udhcpc_handler.pl 22 2012-03-11 22:34:45Z isely $

use IO::File;
use POSIX;
use strict;

# -------------------------------------------------------------------------

# Bits and pieces to store / retrieve Perl data structures to / from
# text files...

# This transforms the string such that it can be safely printed
# between double-quotes and then eval'ed back in at a later time to
# produce the original string value:
#  - Escape double quotes
#  - Escape dollar sign
#  - Escape '@' sign
#  - Escape newline
#  - Escape backslash
#  - Hexify any non-printing character
sub perlQuoteStr {
    my $str = shift;

    $str =~ s/([\$\@"\\])/\\$1/g;
    $str =~ s/([\n])/\\n/g;
    $str =~ s{([\x00-\x1f\x80-\xff])}{sprintf('\\x%02x',ord($1))}ge;

    return $str;
}

# Return string quoted or bare if it's safe to represent the string as
# a bareword.
sub perlSafeEmitBareStr {
    my $str = shift;
    # Two tests here: First only strings composed entirely of letters,
    # digits and the underscore - with the first character being a
    # letter - passes.  Then fail any string which might be mistaken
    # for a "v-string" (yuck).  If we fail, we quote the whole thing.
    # Otherwise we'll just return the bareword.
    if (($str =~ /^[a-zA-Z]\w+$/) && !($str =~ /^v\d+$/)) {
        return $str;
    }
    return '"' . perlQuoteStr($str) . '"';
}

# Return string quoted or bare if it is just a single digit.
sub perlSafeEmitStr {
    my $str = shift;
    if ($str =~ /^\d$/) {
        # Single-digit case - easily handled
        return $str;
    }
    return '"' . perlQuoteStr($str) . '"';
}

sub structureWriteToHandle2 {
    my $fh = shift;
    my $var = shift;
    my $prefix = shift;
    my ($v1,$v2);

    if (! defined $var) {
        print $fh 'undef';
        return;
    }
    $v2 = ref $var;
    if ($v2 eq "") {
        print $fh perlSafeEmitStr($var);
        return;
    }
    if ($v2 eq 'ARRAY') {
        my $oldPrefix = $prefix;
        $prefix = $prefix . "  ";
	if (!scalar(@$var)) {
	    print $fh "[ ]";
	    return;
	}
        print $fh "[\n";
        for ($v1 = 0; $v1 < scalar(@$var); $v1++) {
            if ($v1) {
                print $fh ",\n";
            }
            print $fh $prefix;
            structureWriteToHandle2($fh,$var->[$v1],$prefix);
        }
        print $fh "\n";
        print $fh $oldPrefix;
        print $fh "]";
        return;
    }
    if ($v2 eq 'HASH') {
        my $key;
        my $oldPrefix = $prefix;
        $prefix = $prefix . "  ";
	if (!scalar(keys %$var)) {
	    print $fh "{ }";
	    return;
	}
        print $fh "{\n";
        $v1 = 0;
        foreach $key (sort keys %$var) {
            if ($v1) {
                print $fh ",\n";
            }
            print $fh $prefix;
            print $fh perlSafeEmitBareStr($key) . ' => ';
            structureWriteToHandle2($fh,$var->{$key},$prefix);
            $v1++;
        }
        print $fh "\n";
        print $fh $oldPrefix;
        print $fh "}";
        return;
    }

    return;
}

sub structureWriteToHandle {
    my $fh = shift;
    my $var = shift;
    my $prefix = shift;

    print $fh $prefix if (defined $prefix);
    structureWriteToHandle2($fh,$var,$prefix);
    print $fh "\n";
}

sub structureWriteToFile {
    my $fileName = shift;
    my $var = shift;
    my $prefix = shift;
    my $fh;

    $fh = new IO::File;
    return undef unless ($fh->open(">$fileName"));
    structureWriteToHandle($fh,$var,$prefix);
    return 1;
}

sub safeEvalStr {
    my $str = shift;
    my $argv = shift;
    my $warnText = undef;
    my $evalResult;
    my $result = { };
    {
        local $SIG{__WARN__} = sub {$warnText = shift};
        local @ARGV;
        if ($argv) {
            @ARGV = @$argv;
        }
        $evalResult = eval($str);
    }
    if ($@) {
        $result->{exception} = $@;
    }
    if (defined $warnText) {
        $result->{warning} = $warnText;
    }
    if (defined $evalResult) {
        $result->{result} = $evalResult;
    }
    return $result;
}

sub safeEvalHandle {
    my $fh = shift;
    my $argv = shift;
    my ($v1,$v2);
    my $result;

    # Suck in the entire file
    $v2 = '';
    while ($fh->read($v2,16384,length $v2)) { }

    $result = safeEvalStr($v2,$argv);

    return $result;
}

sub safeEvalFile {
    my $fileName = shift;
    my $argv = shift;
    my $result;
    my $fh;

    $fh = new IO::File;
    if (! $fh->open($fileName)) {
        return {fileResult => $!};
    }

    return safeEvalHandle($fh,$argv);
}

sub structureReadFromHandle {
    my $inputHandleRef = shift;
    my $argv = shift;
    my $result = safeEvalHandle($inputHandleRef,$argv);

    return $result->{result};
}

sub structureReadFromFile {
    my $fileName = shift;
    my $argv = shift;
    my $result;

    $result = safeEvalFile($fileName,$argv);

    return $result->{result};
}

# -------------------------------------------------------------------------

my $stateDir = '/var/lib/udhcpc';
my $confDir = '/etc/network';
my $leaseFile = 'lease_info';
my $confFile = 'udhcpc.conf';

sub calcLeaseFileName {
    return $stateDir . '/' . $leaseFile;
}


sub writeLeaseFile {
    my $attr = shift;
    structureWriteToFile(calcLeaseFileName(),$attr);
}


sub readLeaseFile {
    return structureReadFromFile(calcLeaseFileName());
}

sub readConf {
    my $fh = new IO::File("< " . $confDir . '/' . $confFile);
    my $line;
    my ($v1,$v2,$v3,$v4);
    my ($key,$val);
    my $h;
    my $conf = { };
    my @fields;
    return if (! $fh);

    while ($line = <$fh>) {
	chomp $line;
	next if ($line =~ /^\s*\#/);
	$line = $v1 if (($v1) = $line =~ /^(.*)\#/);
	next if (!(($key,$val) = $line =~ /^\s*(.+)\s*=\s*(.*)$/));
	if ($key eq 'INTERFACES') {
	    @fields = split(" ",$val);
	    foreach $v2 (@fields) {
		$conf->{ifc}->{$v2} = undef;
	    }
	    next;
	}
	if (($v1) = $key =~ /^INTERFACE_(.+)$/) {
	    @fields = split(" ",$val);
	    $h = { };
	    foreach $v2 (@fields) {
		if (($v3,$v4) = $v2 =~ /^(.+)=(.*)$/) {
		    $h->{$v3} = $v4;
		} else {
		    $h->{$v2} = 1;
		}
	    }
	    $conf->{ifc}->{$v1} = $h;
	}
    }

    return $conf;
}

sub gatherState {
    my $attr = shift;
    my $envName;
    my $attrName;
    my $attrVal;
    my $fields;
    my $v1;

    my %attr_map = (
		    ip => 'ip_addr',
		    hostname => 'client_name',
		    domain => 'domain_name',
		    siaddr => 'boot_server_addr',
		    sname => 'boot_server_name',
		    boot_file => 'boot_file',
		    subnet => 'ip_net',
		    broadcast => 'ip_broadcast',
		    timezone => 'time_offset',
		    router => 'ip_route',
		    ntpsrv => 'time_server',
		    dns => 'dns_server',
		    wins => 'wins_server',
		    rootpath => 'root_path',
		    );

    $attr = { } if (! defined $attr);

    foreach $envName (keys %attr_map) {
	next if (! exists $ENV{$envName});
	$attrName = $attr_map{$envName};
	$v1 = $ENV{$envName};
	# Knock out leading and trailing whitespace - udhdpc 0.9.8 can
	# leave behind trailing whitespace which screws us up.
	$v1 =~ s/^\s+//;
	$v1 =~ s/\s+$//;
	if ($v1 eq '') {
	    $attr->{$attrName} = undef;
	    next;
	}

	$fields = [];
	@$fields = split(" ",$v1);
	if (scalar(@$fields) == 1) {
	    $attr->{$attrName} = $v1;
	} else {
	    $attr->{$attrName} = $fields;
	}
    }
    return $attr;
}


sub getSubState {
    my $state = shift;
    my $id = shift;
    my $sst;

    if (exists $state->{service}->{$id}) {
	$sst = $state->{service}->{$id};
    } else {
	$sst = { };
	$state->{service}->{$id} = $sst;
    }

    return $sst;
}


sub getIfcKey {
    my $state = shift;
    my $ifc = shift;
    my $id = shift;

    return $state->{ifc_info}->{$ifc}->{$id};
}


sub getArrIfcKey {
    my $state = shift;
    my $ifc = shift;
    my $id = shift;
    my $v = $state->{ifc_info}->{$ifc}->{$id};
    return [] if (! defined $v);
    return $v if (ref $v eq 'ARRAY');
    return [$v];
}


sub update_service_ntp {
    my $state = shift;
    my $ifc = shift;
    my $sst = getSubState($state,'ntp');
    my $nlist = getArrIfcKey($state,$ifc,'time_server');
    my (%m1list,%m2list);
    my ($v1,$v2,$v3);
    my $cmd;
    my (@k1,@k2);

    foreach $v1 (keys %{$sst->{ifc}}) {
	$v3 = $sst->{ifc}->{$v1};
	foreach $v2 (@$v3) {
	    $m1list{$v2} = 1;
	}
    }

    if (scalar(@$nlist)) {
	$sst->{ifc}->{$ifc} = $nlist;
    } else {
	delete $sst->{ifc}->{$ifc};
    }

    foreach $v1 (keys %{$sst->{ifc}}) {
	$v3 = $sst->{ifc}->{$v1};
	foreach $v2 (@$v3) {
	    $m2list{$v2} = 1;
	}
    }

    @k1 = sort keys %m1list;
    @k2 = sort keys %m2list;
    # Get out if nothing has actually changed
    if (scalar(@k1) == scalar(@k2)) {
	$v2 = scalar(@k1);
	for ($v1 = 0; $v1 < $v2; $v1++) {
	    last if ($k1[$v1] ne $k2[$v1]);
	}
	return if ($v1 >= $v2);
    }


    # Write new conf file
    {
	my $fh1 = new IO::File("< /etc/ntp.conf");
	my $fh2 = new IO::File("> /var/lib/ntp/ntp.conf.dhcp");
	if (defined $fh1) {
	    while ($v1 = <$fh1>) {
		print $fh2 $v1;
	    }
	}
	foreach $v1 (@k2) {
	    print $fh2 "server $v1\n";
	}
    }

    if (-r "/var/run/ntpd.pid") {
	system("/etc/init.d/ntp restart");
    }

#    foreach $v1 (keys %m1list) {
#	next if ($m2list{$v1});
#	system("ntpdc -c 'keyid 1' -c 'unconfig $v1'");
#    }
#
#    foreach $v1 (keys %m2list) {
#	next if ($m1list{$v1});
#	system("ntpdc -c 'keyid 1' -c 'passwd 1' -c 'addpeer $v1'");
#    }

}


sub resolver_compare {
    my $k1 = shift;
    my $k2 = shift;
    my ($d1,$d2);
    my ($idx,$cnt);

    if ((defined $k1) && (defined $k2)) {
	if ((defined $k1->{domain}) && (defined $k2->{domain})) {
	    return undef if ($k1->{domain} ne $k2->{domain});
	}
	return undef if ((defined $k1->{domain}) || (defined $k2->{domain}));
	if ((defined $k1->{dns}) && (defined $k2->{dns})) {
	    $d1 = $k1->{dns};
	    $d2 = $k2->{dns};
	    $cnt = scalar(@$d1);
	    return undef if ($cnt != scalar(@$d2));
	    for ($idx = 0; $idx < $cnt; $idx++) {
		return undef if ($d1->[$idx] ne $d2->[$idx]);
	    }
	    return 1;
	}
	return undef if ((defined $k1->{dns}) || (defined $k2->{dns}));
	return 1;
    }
    return undef if ((defined $k1) || (defined $k2));
    return 1;
}


sub update_service_resolver {
    my $state = shift;
    my $ifc = shift;
    my $sifc;
    my $rname = $ifc . '.udhcpc';
    my ($v1,$v2,$chgFl);
    my $str;
    my $sst = getSubState($state,'dns');
    my $tifc = {
	dns => getArrIfcKey($state,$ifc,'dns_server'),
	domain => getIfcKey($state,$ifc,'domain_name'),
    };
    my $sifc = $sst->{ifc}->{$ifc};

    if (!((defined $tifc->{dns}) && (defined $tifc->{domain}))) {
	$tifc = undef;
    }

    if (defined $tifc) {
	$sst->{ifc}->{$ifc} = $tifc;
    } else {
	delete $sst->{ifc}->{$ifc};
    }

    return if resolver_compare($sifc,$tifc);

    if (defined $sifc) {
	system("resolvconf -d $rname");
    }

    if (defined $tifc) {
	my $fh;
	if (defined $tifc->{dns}) {
	    foreach $v2 (@{$tifc->{dns}}) {
		$str .= "\n" if (defined $str);
		$str .= "nameserver $v2";
	    }
	}
	if (defined $tifc->{domain} && (length($tifc->{domain}) > 0)) {
	    $str .= "\n" if (defined $str);
	    $str .= "search $tifc->{domain}";
	}
	$fh = new IO::File("| resolvconf -a $rname");
	print $fh $str;
    }
}


sub update_service_hostname {
    my $state = shift;
    my $ifc = shift;
    my $conf = shift;
    my ($iname,$hname,$sname,$pname);
    my $sst = getSubState($state,'hostname');
    my $v1;

    $hname = `hostname`;
    $hname =~ s/^\s+//;
    $hname =~ s/\s+$//;

    $iname = getIfcKey($state,$ifc,'client_name');

    if (defined $iname) {
	$sst->{ifc}->{$ifc} = $iname;
    } else {
	delete $sst->{ifc}->{$ifc};
    }

    foreach $v1 (keys %{$sst->{ifc}}) {
	next if (! $conf->{ifc}->{$v1}->{primary});
	$pname = $sst->{ifc}->{$v1};
	return if ($hname eq $pname);
	system("hostname $pname");
	return;
    }

    if (length($hname) > 0) {
	foreach $v1 (keys %{$sst->{ifc}}) {
	    $sname = $sst->{ifc}->{$v1};
	    $iname = $sname if (! defined $iname);
	    return if ($sname eq $hname);
	}
    }

    return if (! defined $iname);

    system("hostname $iname");
}


sub get_routes {
    my $fh = new IO::File("netstat -nr |");
    my @routes;
    my $line;
    my $item;

    while ($line = <$fh>) {
	next if (!(($item) = $line =~ /^0.0.0.0\s+(\d+\.\d+\.\d+\.\d+)\s+/));
	push @routes,$item;
    }

    return \@routes;
}


sub fix_routes {
    my $r1 = shift;
    my $r2 = shift;
    my %h1;
    my %h2;
    my $item;
    my $cmd;

    foreach $item (@$r1) {
	$h1{$item} = 1;
    }
    foreach $item (@$r2) {
	$h2{$item} = 1;
    }

    foreach $item (@$r1) {
	next if (defined $h2{$item});
	$cmd = "route del -net default gw $item";
	system $cmd;
    }

    foreach $item (@$r2) {
	next if (defined $h1{$item});
	$cmd = "route add -net default gw $item";
	system $cmd;
    }
}


sub route_match {
    my $r1 = shift;
    my $r2 = shift;
    my $cnt = scalar(@$r1);
    my $idx;
    return undef if (scalar(@$r2) != $cnt);
    for ($idx = 0; $idx < $cnt; $idx++) {
	return undef if ($r1->[$idx] ne $r2->[$idx]);
    }
    return 1;
}


sub update_service_route {
    my $state = shift;
    my $ifc = shift;
    my $conf = shift;
    my ($iroute,$hroute,$sroute,$proute);
    my $sst = getSubState($state,'route');
    my $v1;

    $hroute = get_routes();
    $iroute = getArrIfcKey($state,$ifc,'ip_route');

    if (scalar(@$iroute) > 0) {
	$sst->{ifc}->{$ifc} = $iroute;
    } else {
	delete $sst->{ifc}->{$ifc};
    }

    foreach $v1 (keys %{$sst->{ifc}}) {
	next if (! $conf->{ifc}->{$v1}->{primary});
	$proute = $sst->{ifc}->{$v1};
	fix_routes($hroute,$proute);
	return;
    }

    if (scalar(@$hroute) > 0) {
	foreach $v1 (keys %{$sst->{ifc}}) {
	    $sroute = $sst->{ifc}->{$v1};
	    $iroute = $sroute if (! defined $iroute);
	    return if (route_match($sroute,$hroute));
	}
    }

    fix_routes($hroute,$iroute);
}


sub update_service_ifc {
    my $state = shift;
    my $ifc = shift;
    my $conf = shift;
    my $info = $state->{ifc_info}->{$ifc};

    if (defined $info) {
	my $cmd = "ifconfig $ifc $info->{ip_addr}";
	if (defined $info->{ip_net}) {
	    $cmd .= " netmask $info->{ip_net}";
	}
	if (defined $info->{ip_broadcast}) {
	    $cmd .= " broadcast $info->{ip_broadcast}";
	}
    }

    if ($conf->{ifc}->{$ifc}->{uponly}) {
	return;
    }

    system "ifconfig $ifc addr 0.0.0.0";
}


sub main {
    my $mode = $ARGV[0];
    my $ifc = $ENV{interface};
    my $setFl;
    my $state;
    my $fp;
    my $confAll;
    my @update_functions = (
			    \&update_service_ifc,
			    \&update_service_route,
			    \&update_service_resolver,
			    \&update_service_hostname,
			    \&update_service_ntp,
			    );
    my %call_modes = (
		      deconfig => 0,
		      bound => 1,
		      renew => 1,
		      );

    $confAll = readConf();
    return 3 if (! exists $confAll->{ifc}->{$ifc});

    return 2 if (!exists $call_modes{$mode});

    $state = readLeaseFile();
    if (ref $state ne 'HASH') {
	return 0 if (! $call_modes{$mode});
	$state = {
	    ifc_info => {
	    },
	    service => {
	    },
	};
    }

    if ($call_modes{$mode}) {
	$state->{ifc_info}->{$ifc} = gatherState();
	$setFl = 1;
    } else {
	delete $state->{ifc_info}->{$ifc};
	@update_functions = reverse @update_functions;
	$setFl = 0;
    }

    foreach $fp (@update_functions) {
	&{$fp}($state,$ifc,$confAll);
    }

    writeLeaseFile($state);
    return 0;
}

my $ret = main();
$ret;