#!/usr/bin/perl
#
#  fallback-gw
#
#  Checks availibility of neighbor routers using ping
#  and activates backup routing on ping failures.
#
#  Written by ilya.evseev@gmail.com
#   - Jan 2009 : initial revision, FreeBSD-only.
#   - May 2009 : modular design, Linux support added.
#   - Apr 2010 : move all OS-specific parts to external hooks.
#  Distributed as Public Domain
#
#  Visit for documentation and updates:
#  http://sources.homelink.ru/fallback-gw/
#
use strict;
use warnings;

use FindBin;
use Config::General;

my $dry_run = (@ARGV and $ARGV[0] eq '--dry'    ) ? shift @ARGV : undef;
my $verbose = (@ARGV and $ARGV[0] eq '--verbose') ? shift @ARGV : undef;
my $cfgname = @ARGV ? shift @ARGV : "$FindBin::Bin/$FindBin::Script.conf";
my $cfgfile = new Config::General($cfgname);
my %config  = $cfgfile->getall;
my $commands= $config{commands} or die "Missing <commands> section\n";

$commands->{$_} || die "Missing \"$_\" line in <commands> section"
	foreach qw/ping list_routes add_route delete_route/;

my %dest2gateways;   # { IP/Mask => [ gw1, gw2, ... ], ... }
my $exitcode = 0;

sub enumerate_list($$$);

sub enumerate_ref($$$) {
	my ($name, $conf, $handler) = @_;
	#print "DEBUG: Config $name = $conf\n";
	return $handler->($conf)
		if $conf =~ /^\d+\.\d+\.\d+\.\d+$/
		or $conf =~ /^\d+[\.\d]+\/\d+$/;
	#print "DEBUG: Recurse $name = $conf\n";
	my $a = $config{$name} or die "No section of $name type!\n";
	my $b =    $a->{$conf} or die "No section $conf of $name type!\n";
	my $c =    $b->{$name} or die "No $name lines in $conf section!\n";
	enumerate_list($conf, $c, $handler);
}

sub enumerate_list($$$) {
	my ($name, $conf, $handler) = @_;
	die "Missing config $name!\n" if $name and not $conf;
	return unless $conf;
	my $typ = ref($conf);
	#print "DEBUG: Parse name = $name, type is '$typ'\n";
	if ($typ eq '') {
		enumerate_ref($name, $conf, $handler);
	} elsif ($typ eq 'HASH') {
		$handler->($_) while (undef,$_) = each %$conf;
	} elsif ($typ eq 'ARRAY') {
		$handler->($_) foreach @$conf;
	} else {
		die "Wrong config type for $name is $typ!\n";
	}
}

sub enumerate2array($$;$) {
	my ($name, $conf, $handler) = @_;
	my @result;
	enumerate_list($name, $conf->{$name}, sub {
		return $handler->($_[0]) if $handler;
		enumerate_ref($name, $_[0], sub {
			push @result, $_[0]
		} )
	} );
	\@result;
}

enumerate2array('destination2gateway', \%config, sub {
	my $d = enumerate2array('destination', $_[0]);
	my $g = enumerate2array('gateway',     $_[0]);
	foreach(@$d) {
		my $dd = $dest2gateways{$_} ||= [];
		push @$dd, $_ foreach @$g;
	}
} );

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

my %gw_routes;
my %gw_status;
my %gw4route;

sub debug_print { print        "[$$] ".localtime()." -- @_" if $verbose; }
sub  info_print { print STDERR "[$$] ".localtime()." -- @_"; }

sub cmd($;@) {
	my $cmdname = shift;
	my $cmd = $commands->{$cmdname} or die "Missing command: $cmdname\n";
	debug_print "Run command $cmdname = $cmd @_\n";
	system("$cmd @_ > /dev/null");
	die "Cannot $cmd @_: $!\n"
		if $? == -1;
	die "$cmd @_: died with signal ".($? & 127)."\n"
		if $? & 127;
	$? >> 8;
}

sub check_status($) {
	my $gw = shift;
	return $gw_status{$gw} if exists $gw_status{$gw};
	debug_print "Ping router $gw...\n";
	$gw_status{$gw} = cmd('ping', $gw);
}

open L, "$commands->{list_routes} |" or die "Cannot get routes: $!";
while(<L>) {
	my ($dest, $gw) = split;
	$dest = '0.0.0.0/0' if $dest eq 'default';
	$gw4route{$dest} = $gw;
	debug_print "Route $dest via $gw...\n";
	my $r = ($gw_routes{$gw} ||= {});
	$r->{$dest} = 1;
	if (check_status($gw)) {
		 info_print "Route $dest via $gw: FAILED\n";
	} else {
		debug_print "Route $dest via $gw: ok\n";
	}
}
close L;

while (my ($current_gw, $status) = each %gw_status) {
	next if !$status;   # ..'0' means OK
	debug_print "Not responding: ${current_gw}...\n";
	my $found;
DEST:	while (my ($dest, undef) = each %{$gw_routes{$current_gw}}) {
		#debug_print "...handle destination $dest...\n";
		my $d2g = $dest2gateways{$dest};
		unless ($d2g) {
			info_print "...delete route $dest via $current_gw\n";
			cmd('delete_route', $dest, $current_gw)
				unless $dry_run;
			$exitcode++;
			next DEST;
		}
		foreach my $new_gw (@$d2g) {
			next if $current_gw eq $new_gw;
			debug_print "...check $new_gw for replace\n";
			next if check_status($new_gw);   # ..'1' means FAILED, goto next
			info_print "...new router for $dest is $new_gw\n";
			if ($dry_run) {
			} elsif ($commands->{change_route}) {
				cmd('change_route', $dest, $new_gw);
			} else {
				cmd('delete_route', $dest, $new_gw);
				cmd(   'add_route', $dest, $new_gw);
			}
			$exitcode++;
			next DEST;
		}
		my $msg = "Cannot get fallback for $dest instead of $current_gw!\n";
		@$d2g > 1 ? info_print($msg) : debug_print($msg);
	}
}

while (my ($dest, $gateways) = each %dest2gateways) {
	next if exists $gw4route{$dest};
	info_print "Restore gateway to $dest\n";
	die "No router configured for $dest!\n"
		unless $gateways and @$gateways;
	my $gw = $$gateways[0];
	info_print "...via $gw\n";
	cmd('add_route', $dest, $gw)
		unless $dry_run;
	$exitcode++;
}

## EOF ##