view release on metacpan or  search on metacpan

bin/rip44d  view on Meta::CPAN

	print $fh "Usage:\n"
		. "  $me [-v] [-d] [-i <tunnelif>] [-a <localaddrs>] [-p <password>]\n"
		. "Options:\n"
		. "  -v   increase verbosity slightly to print error messages on stderr\n"
		. "  -d   increase verbosity greatly (debug mode)\n"
		. "  -i <tunnelinterface>\n"
		. "       use the specified tunnel interface, defaults to tunl0\n"
		. "  -a <comma-separated-ip-list>\n"
		. "       ignore routes pointing to these (local) gateways\n"
		. "       (list contains system's local IP addresses by default)\n"
		. "  -p <password>\n"
		. "       use RIPv2 password 'authentication', defaults to none\n"
		;
}

sub VERSION_MESSAGE()
{
	my($fh) = @_;
	
	print $fh "$me version $VERSION\n";
}

# Figure out local interface IP addresses so that routes to them can be ignored

sub fill_local_ifs()
{
	my $s = `$ifconfig -a`;
	
	while ($s =~ s/inet addr:(\d+\.\d+\.\d+\.\d+)//) {
		warn "found local address: $1\n" if ($verbose);
		$my_addresses{$1} = 1;
	}
}

# Convert a netmask (in integer form) to the corresponding prefix length,
# and validate it too. This is a bit ugly, optimizations are welcome.

sub mask2prefix($)
{
	my($mask) = @_; # integer
	
	# convert to a string of 1's and 0's, like this (/25):
	# 11111111111111111111111110000000
	my($bits) = unpack("B32", pack('N', $mask));
	
	# There should be a continuous row of 1's in the
	# beginning, and a continuous row of 0's in the end.
	# Regexp is our hammer, again.
	return -1 if ($bits !~ /^(1*)(0*)$/);
	
	# The amount of 1's in the beginning is the prefix length.
	return length($1);
}

# delete a route from the kernel's table

sub route_delete($)
{
	my($rkey) = @_;
	
	# This is ugly and slow - we fork /sbin/ip twice for every route change.
	# Should talk to the netlink device instead, but this is easier to
	# do right now, and good enough for this little routing table.
	my($out, $cmd);
	$cmd = "LANG=C $routebin route del $rkey";
	$out = `$cmd 2>&1`;
	if ($?) {
		if ($verbose > 1 || $out !~ /No such process/) {
			warn "route del failed: '$cmd': $out\n";
		}
	}
}

# expire old routes

sub expire_routes()
{
	warn "expiring old routes\n" if ($verbose);
	
	my $exp_t = time() - $route_ttl;
	my $now = time();
	
	foreach my $rkey (keys %current_routes) {
		if ($current_routes{$rkey}->{'t'} < $exp_t) {
			# expire route
			warn "route $rkey has expired, deleting\n" if ($verbose);
			route_delete($rkey);
			delete $current_routes{$rkey};
		} elsif ($current_routes{$rkey}->{'t'} > $now) {
			# clock has jumped backwards, the time is in
			# the future - set 't' to $now so that the route
			# will be expired eventually
			$current_routes{$rkey}->{'t'} = $now;
		}
	}
}

# Consider adding a route in the routing table

sub consider_route($$$$)
{
	my($net, $mask, $nexthop, $rtag) = @_;
	
	my $rkey = "$net/$mask";
	if (defined $current_routes{$rkey}
		&& $current_routes{$rkey}->{'nh'} eq $nexthop
		&& $current_routes{$rkey}->{'rtag'} eq $rtag) {
		# ok, current route is fine
		warn "route $rkey is installed and current\n" if ($verbose > 1);
		$current_routes{$rkey}->{'t'} = time();
		return;
	}
	
	warn "route $rkey updated: via $nexthop rtag $rtag\n" if ($verbose > 1);
	
	$current_routes{$rkey} = {
		'nh' => $nexthop,
		'rtag' => $rtag,
		't' => time()
	};