#! /usr/bin/perl -w

# (C) Carsten Gross 04/2017

use strict;
use Config::Simple;
use Sys::Syslog;
use Sys::Syslog qw(:standard :macros);
# use NetAddr::IP::Util qw(:all); 

# Global definitions

my $EthersFile = "/etc/ethers-2.0";
my %ETHERS; 
# DNS Update Statements. If one empties @SERVER, no dynamic DNS is done
my @DNSUpdate = ("", ""); 
my @DNSKey = ("/etc/bind/example.com.keyfile", "/etc/bind/reverse-zone.keyfile"); # Forward zone, Reverse Zone
my @SERVER = qw(dns.example.com);

##############################################################
# Helper functions
##############################################################

# Convert a MAC address into EUI-64 token format to get the /64-IPv6 suffix
sub ConvertMac($) {
    my $mac = shift;
    my $eui = "";
    $mac = lc($mac);
    $mac =~ s/://g;
    $mac = $mac . "";
    if (length($mac) != 12) {
        print STDERR "MAC Address $mac is not valid.\n";
        return undef;
    }
    my $firstblock = substr($mac,0,2);
    $firstblock =  (hex($firstblock) | 2);
    my $secondblock = substr($mac,2,4);
    my $thirdblock  = 'fffe';
    my $fourthblock = substr($mac,6,6);
    $eui = sprintf "%02x", $firstblock;
    $eui .= $secondblock . $thirdblock . $fourthblock;
    return $eui;
}

# Make nibble written reverse entry 
sub ReverseEntry($$) {
	my $addr = shift;
	my $networksize = shift; 
	if (! defined $networksize) {
		$networksize = 0; 
	}
	$networksize = $networksize / 16; 
	# Bust the v6 address apart into the colon-delimited sections.
	my @sections = split(/:/, $addr);
	my @v6_array;
	# Iterate through them backwards.
	foreach my $section (reverse @sections) {
		# Split each section up backwards into a list, so e.g. '2001' becomes
		# ('1', '0', '0', '2').
		my @digits = reverse(split(//, $section));
		my $str = $digits[0];
		my $i;
		if ($#digits >= 0) {
			# Join the digits we have together with dots.
			for ($i = 1; $i <= $#digits; $i++) {
				$str .= ('.' . $digits[$i]);
			}   
			# If there were fewer than four digits then make the remainder up with
			# zeroes. (and make a special handling for the "all-0-case")
			while ($i < 4) {
				$str .= '.' . '0';
				$i++;
			}
		} else {
			$str = "0.0.0.0";
		}
		push(@v6_array, $str);
	}
	for (my $i = 0; $i < $networksize; $i++) {
		pop @v6_array; 
	}
	# splice(@v6_array, -$networksize); 
	# Join the sections together with dots and add the reverse zone TLD on the
	# end.
	my $revstr = join('.', @v6_array) . '.ip6.arpa';
	return $revstr;
}

# Read the new ethers file
# File-format
# MAC-address<whitespace>ipv4<whitespace>EUI-64(or /64 suffix)<whitespace>hostname<whitespace>network-interface

sub ReadEthers() {
	if (! open(FH, "<", $EthersFile)) {
		syslog(LOG_DEBUG, "Cannot read $EthersFile: $!"); 
	} 
	my $Counter = 0; 
	while (my $line = <FH>) {
		chomp $line;
		if ($line =~ /^#/) {
			next;
		}
		if ($line =~ /^\s*$/) {
			next;
		}
		my @L = split(/\s+/, $line);
		my $mac = lc($L[0]); 
		my $ipv4 = $L[1]; 
		my $ipv6suffix = lc($L[2]);
		my $hostname = $L[3];
		my $interface = $L[4]; 
		my %H; 
		if ($ipv6suffix eq 'eui-64' || $ipv6suffix eq 'eui64') {
			$ipv6suffix = ConvertMac($L[0]);
			my $euir = reverse $ipv6suffix; 
			my @E = split("", $euir);
			my $reverse = join(".", @E);
			$H{'ipv6reverse'} = $reverse;
		}
		$H{'ipv4'} = $ipv4; 
		$H{'ipv6'} = $ipv6suffix; 
		$H{'hostname'} = $hostname; 
		$H{'interface'} = $interface;
		$ETHERS{$mac} = \%H;
		$Counter += 1; 

	}
	close (FH); 
	syslog(LOG_INFO, "Read $Counter host entries from $EthersFile");
	return; 
}

# Generate DNS entires aka nsupdate statements that are sent to 
# a bind installation. You can also adjust this to make SQL updates or whatever

sub DoDNSStuff($$) {
	my $interface = shift; 
	my $prefix = shift;
	$prefix =~ s/::1$//; 
	# Generate forward and reverse-entries:
	foreach my $mac(keys %ETHERS) {	
		my $h = $ETHERS{$mac};
		if ($interface ne $$h{'interface'}) {
			next;
		}
		my $addr; 
		if (length($$h{'ipv6'}) == 16) {
			my @L = unpack("A4A4A4A4", $$h{'ipv6'}); 
			$addr = $prefix . ":" . join(":", @L); 
		} else {
			$addr = $prefix . $$h{'ipv6'}; 
		}
		# Try to generate the reverse notation
		my $rev = ReverseEntry($addr, 0); 
		my $name = $$h{'hostname'};
		my $reversename = $name;
		$reversename =~ s/\.dyn//; 
		$DNSUpdate[0] .= "update delete $name AAAA\n";
		$DNSUpdate[0] .= "update add $name 60 AAAA " . $addr . "\n";
		$DNSUpdate[1] .= "update delete $rev PTR\n";
		$DNSUpdate[1] .= "update add $rev 60 PTR " . $reversename . ".\n";
		#syslog(LOG_INFO, "DoDNSStuff: $name IN AAAA $addr"); 
		#syslog(LOG_INFO, "DoDNSStuff: $rev IN PTR $name."); 
	}
}

##############################################################
# here we start executing our main() function
##############################################################
# main()

# These are all environment variables that are set by dibbler.
# ETHERS is an exception, it is set in the next lines to the mtime
# of the ethersfile given above
my @FIELDS = (qw(DOWNLINK_PREFIXES ADDR1 ADDR1VALID ADDR1PREF IFACE REMOTE_ADDR PREFIX1PREF PREFIX1VALID SRV_OPTION23 ETHERS)); 

my @T = stat($EthersFile); 
my $mtime = $T[9];
$ENV{'ETHERS'} = $mtime; 

my %Handle; 
# Get the current DHCPv6 attributes from the environment
# These were fetched by dibbler-client. Get read of trailing and leading whitespace
foreach my $key (@FIELDS) {
	$Handle{$key} = $ENV{$key};
	# remove trailing and leading white-space
	$Handle{$key} =~ s/^\s*//;
	$Handle{$key} =~ s/\s*$//; 
}

# open syslog connection for "DAEMON" 
openlog("ipv6-networking-dibbler", "nofatal", LOG_DAEMON);

# Get current timestamp in UNIX-format
my $ts = time(); 

my $store = new Config::Simple(syntax=>'ini'); 
$store->read('/tmp/ipv6-network.tmp');
# Compare environment with stored variables
my %CFG; 
my $differs = 0; 
foreach my $key (@FIELDS) {
	$CFG{$key} = $store->param($key) . "";
	# Trailing und leading white-space entfernen 
	$CFG{$key} =~ s/^\s*//;
	$CFG{$key} =~ s/\s*$//;
	if (! defined $CFG{$key} || $CFG{$key} ne $Handle{$key} . "") {
		syslog(LOG_INFO, "ipv6 difference detected in configuration for $key: CFG{key}: " . $CFG{$key} . ", Handle{key}: " . $Handle{$key}); 
		$differs = 1;
	}
}
$CFG{'LASTSTORE'} = $store->param('LASTSTORE');

# after reading in of the temporary file: differs tells wether there is
# something differend and the network has to be reconfigured

if ($differs == 0) {
	# nothing has changed. But valid timers will expire. Therefore we check for the last update we did make 
	# best thing is to just update the valid and preferred lifetime anytime we are called by dibbler
	#if ( ( $CFG{'LASTSTORE'} + $CFG{'PREFIX1PREF'} + 60 ) > $ts ) {
		#syslog(LOG_INFO, "ipv6 configuration not changed, prefix is also still valid, nothing to do, exit\n");
		#exit 0; 
	#} else {
		syslog(LOG_INFO, "ipv6 configuration not changed, prefix is about to expire, refresh lifetimes\n");
	#}
} else {
	# Reading of new ethers is required, update of DNS is required
	ReadEthers(); 
}

# Store everything into the temporary storage file
foreach my $key (@FIELDS) {
	$store->param($key, $Handle{$key});
} 
$store->param('LASTSTORE', $ts);
$store->write();

# update DNS zone for upstream interface
if ($differs == 1) {
	my $var = sprintf "Using " . $Handle{'IFACE'} . " with interface address " . $Handle{'ADDR1'} . " via gw " . $Handle{'REMOTE_ADDR'} . " as default gw (expires " . $Handle{'ADDR1VALID'} . ")"; 
	syslog(LOG_INFO, $var);
	my $address = lc($Handle{'ADDR1'}); 
	# Short to /64 network
	$address =~ /^([0-9a-f]{0,4}:[0-9a-f]{0,4}:[0-9a-f]{0,4}:[0-9a-f]{0,4}).*$/; 
	$address = $1; 
	DoDNSStuff($Handle{'IFACE'}, $address); 
}

# 
# the default interface (where we got the DHCPv6 prefix delegation) also gets RA. This sets the interface address but not the
# default route. It is set here. 
# Unfortunatly the "next-hop" address is not set in DHCPv6 (only the multicast-adress of the DHCPv6 server in REMOTE_ADDR, this is useless)
# If the device is a Fritz!Box one can take the ULA of the DNS server and replace the fd00 with fe80. This is very hacky.

if ($differs == 1) {
	my $RemoteAddr = $Handle{'SRV_OPTION23'}; 
	$RemoteAddr =~ s/^fd00/fe80/; 
	system("ip -6 route del default via " . $RemoteAddr . " dev " . $Handle{'IFACE'});
	# configure interface
	# system("ip -6 addr add " . $Handle{'ADDR1'} . "/64 dev " . $Handle{'IFACE'} . " valid_lft " . $Handle{'ADDR1VALID'} . " preferred_lft " . $Handle{'ADDR1PREF'}); 
	system("ip -6 route add default via " . $RemoteAddr . " dev " . $Handle{'IFACE'}); # . " expires " . $Handle{'ADDR1VALID'});
	syslog(LOG_INFO, "Set new default route via " . $RemoteAddr . " using interface " . $Handle{'IFACE'}); 
}

# Setup routes and interfaces with suffix 1. Also prepare DNS updates

# networks are defined and the prefix is longer then 5 characters 

if ( defined $Handle{'DOWNLINK_PREFIXES'} && length($Handle{'DOWNLINK_PREFIXES'}) > 5) {
	# In eine passende Variable laden
	my %Networks = split(" ", $Handle{'DOWNLINK_PREFIXES'});
	foreach my $interface (keys %Networks) {
		my $net = $Networks{$interface};
		my @A = split("/", $net); 
		my $addr = $A[0] . "1";
		my $prefixsize = $A[1]; # /64 is expected
		if ($prefixsize != 64) {
			print STDERR "Interface $interface skipped, prefix size is $prefixsize.\n";
			next;
		}
		if ($differs > 0) {
			DoDNSStuff($interface, $addr); 
			syslog(LOG_INFO, "interface $interface: Setting addr $addr/$prefixsize, valid lft " . $Handle{'PREFIX1VALID'} . ", preferred lft " . $Handle{'PREFIX1PREF'}); 
			print STDERR "interface $interface: Setting addr $addr/$prefixsize, valid lft " . $Handle{'PREFIX1VALID'} . ", preferred lft " . $Handle{'PREFIX1PREF'} . "\n";
			system ("ip -6 addr add $addr/$prefixsize dev $interface valid_lft " . $Handle{'PREFIX1VALID'} . " preferred_lft " . $Handle{'PREFIX1PREF'});
		} else {
			syslog(LOG_INFO, "interface $interface: renewing livetime");
			system("ip -6 addr change $addr/$prefixsize dev $interface valid_lft " . $Handle{'PREFIX1VALID'} . " preferred_lft " . $Handle{'PREFIX1PREF'});
		}
	}
}
if ($differs == 0) {
	# Our work is done, no need to restart radvd or update DNS stuff
	exit(0);
}

foreach my $server (@SERVER) {
	syslog(LOG_INFO, "Updating forward and reverse DNS zones");
	foreach my $id (qw(0 1)) {
		# DO DNS Stuff
		open PH, "|/usr/bin/nsupdate -k " . $DNSKey[$id];
		print PH "server $server\n";
		# print STDERR $DNSUpdate[$id];
		print PH $DNSUpdate[$id]; 
		print PH "send\n";
		print PH "quit\n";
		close(PH); 
	}
}

# restart radvd if needed
system("killall radvd");
#my $login; 
#my $pass; 
#my $uid;
#my $gid; 
#($login,$pass,$uid,$gid) = getpwnam("radvd"); 
#chown($uid, 0, "/etc/dibbler/radvd.conf"); 
chmod(0644, "/etc/dibbler/radvd.conf");
system("/usr/sbin/radvd -u radvd -p /var/run/radvd/radvd.pid -C /etc/dibbler/radvd.conf");

exit 0;