mxrouterctl

#! /usr/local/system/perl/bin/perl
use strict;
use warnings;

use Getopt::Long;
use Data::Dumper;

# options

our ($opt_quiet,$opt_noop,$opt_this_ns);
our $NETNS="MXR";

use constant OPTIONS => (
	'quiet'     => \$opt_quiet,
	'noop'      => \$opt_noop,
	'this-ns'   => \$opt_this_ns,
	'ns:s'      => \$NETNS,
);

sub USAGE {
	return <<"__EOF__";
usage: $0
  start                  [options]  # start router
  stop                   [options]  # stop router
  restart | reload       [options]  # modify router
  test                   [options]  # read config and dump rules in iptable format

  bash                 # start a bash in netns
  exec cmd ...         # execute comamnd in netns

options:
  --quiet      : do not log actions
  --noop       : dry run
  --this-ns    : execute in current namespace  (used internally )

  --ns NETNS   : for this network namespace/router (default: MXR )

__EOF__
}

sub scandir {
	my ($dirname)=@_;
	opendir my $dir,$dirname or die "$dirname: $!\n";
	return sort grep !/^\./,readdir $dir;
}

sub slurpfile {
	my ($path)=@_;
	open my $fh,'<',$path or die "$path: $!\n";
	return join ('',<$fh>);
}

sub slurpfile_or_empty {
	my ($path)=@_;
	return -e $path ? slurpfile($path) : ''
}

sub slurpfile_chomp {
        my $data=slurpfile($_[0]);
        chomp($data);
        return $data;
}

sub slurpfile_chomp_or_empty {
	my ($path)=@_;
	return -e $path ? slurpfile_chomp($path) : ''
}

sub writefile {
	my ($path,$data)=@_;
	open my $fh,'>',$path or die "$path: $!\n";
	print $fh $data;
}

sub network_devices {		# -> ( 'bond0','dummy0','eth0','eth1','eth2','eth2.43','eth3','eth4','eth5','lo','sit0' )
	return grep -d "/sys/class/net/$_",scandir('/sys/class/net');
}

sub network_hardware_devices {	# -> ( eth0','eth1','eth2','eth3','eth4','eth5' )
	return grep -e "/sys/class/net/$_/device",network_devices();
}

sub get_ipv4_routing { return slurpfile_chomp('/proc/sys/net/ipv4/ip_forward'); }
sub set_ipv4_routing { my ($data)=@_;writefile('/proc/sys/net/ipv4/ip_forward',$data) unless $opt_noop; }
sub get_ipv4_send_redirects {my ($dev)=@_;return slurpfile_chomp("/proc/sys/net/ipv4/conf/$dev/send_redirects"); }
sub set_ipv4_send_redirects {my ($dev,$data)=@_;writefile("/proc/sys/net/ipv4/conf/$dev/send_redirects",$data) unless $opt_noop; }
sub get_ipv4_rp_filter {my ($dev)=@_;return slurpfile_chomp("/proc/sys/net/ipv4/conf/$dev/rp_filter"); }
sub set_ipv4_rp_filter {my ($dev,$data)=@_;writefile("/proc/sys/net/ipv4/conf/$dev/rp_filter",$data) unless $opt_noop; }
sub get_ipv4_log_martians {my ($dev)=@_;return slurpfile_chomp("/proc/sys/net/ipv4/conf/$dev/log_martians"); }
sub set_ipv4_log_martians {my ($dev,$data)=@_;writefile("/proc/sys/net/ipv4/conf/$dev/log_martians",$data) unless $opt_noop; }

sub get_ipv6_accept_ra {my ($dev)=@_;return slurpfile_chomp("/proc/sys/net/ipv6/conf/$dev/accept_ra"); }
sub set_ipv6_accept_ra {my ($dev,$data)=@_;writefile("/proc/sys/net/ipv6/conf/$dev/accept_ra",$data) unless $opt_noop; }

sub get_ipv6_forwarding { return slurpfile_chomp("/proc/sys/net/ipv6/conf/all/forwarding"); }
sub set_ipv6_forwarding { my ($data)=@_;writefile("/proc/sys/net/ipv6/conf/all/forwarding",$data) unless $opt_noop; }

our @TABLES=qw( raw nat mangle filter );
our %CHAINS=(
	'raw'    => [qw(PREROUTING               OUTPUT)],
	'nat'    => [qw(PREROUTING INPUT         OUTPUT POSTROUTING)],
	'mangle' => [qw(PREROUTING INPUT FORWARD OUTPUT POSTROUTING)],
	'filter' => [qw(           INPUT FORWARD OUTPUT)],
);

our %WANT_RULES;
for my $table (@TABLES) {
	for my $chain ( @{$CHAINS{$table}} ) {
		$WANT_RULES{$table}{$chain}=[];
	}
}

sub rule {
	my ($table,$chain,$rule)=@_;
	exists $WANT_RULES{$table}         or die "rule($table $chain $rule) : there is no table $table\n";
	exists $WANT_RULES{$table}{$chain} or new_chain($table,$chain);
	push @{$WANT_RULES{$table}{$chain}},$rule;
}

sub new_chain {
	my ($table,$chain)=@_;
	push @{$CHAINS{$table}},$chain;
	$WANT_RULES{$table}{$chain}=[];
}

our %BUILTIN_CHAINS=map {$_=>1} qw(PREROUTING INPUT FORWARD OUTPUT POSTROUTING);

sub rules_in_restore_format {
	my $out='';

	for my $table (@TABLES) {
		$out.="*$table\n";
		for my $chain ( @{$CHAINS{$table}} ) {
			if ($BUILTIN_CHAINS{$chain}) {
				$out.=":$chain ACCEPT [0:0]\n";
			} else {
				$out.=":$chain - [0:0]\n";
			}
		}
		for my $chain ( @{$CHAINS{$table}} ) {
			for my $rule (@{$WANT_RULES{$table}{$chain}}) {
				$out .= "-A $chain $rule\n";
			}
		}
		$out.="COMMIT\n";
	}
	return $out;
}

sub sys {
	my @cmd=@_;
	print join(' ',@cmd),"\n" unless $opt_quiet;
	my $sts=system @cmd;

	if ($sts) {
		if ($sts == -1) {
			die "previous command failed to execute: $!\n";
		} elsif ($sts & 127) {
			die(sprintf("previous command died with signal %d, %s coredump\n",
				($sts & 127),  ($sts & 128) ? 'with' : 'without'));
		} else {
			die(sprintf("previous command failed with exit status %d\n", $sts >> 8));
		}
	}
}

sub create_netns {
	my ($ns)=@_;
	sys('ip','netns','add',$ns);
}

sub delete_netns {
	my ($ns)=@_;
	sys('ip','netns','del',$ns);
}

sub have_netns {
	my ($ns)=@_;
	return -e "/var/run/netns/$ns";
}

sub netif_is_up {my ($dev)=@_;return get_netif_flags($dev)&1;}
sub get_netif_flags { my ($dev)=@_;return hex(slurpfile_chomp("/sys/class/net/$dev/flags"));}   	# see include/uapi/linux/if.h for meaning

our $want_route;	# ( "$dest#$gw" => 1 )

sub route {
	my ($to,$gw)=@_;
	$want_route->{"$to#$gw"}=1;
}

sub read_active_route {
	my $have_route={};
	my $device;
	open IN,'-|','ip','route' or die "$!\n";
	while (<IN>) {
		if (/^(\S+) via (\S+)/) {
			$have_route->{"$1#$2"}=1;
		}
	}
	open IN,'-|','ip','-6','route' or die "$!\n";
	while (<IN>) {
		if (/^(\S+) via (\S+)/) {
			$have_route->{"$1#$2"}=1;
		}
	}
	return ($have_route);
}

sub unconfigure_route {
	my ($del_route)=@_;
	for my $r (keys %$del_route) {
		my ($to,$gw)=split /#/,$r;
		sys('ip','route','del',$to,'via',$gw);
	}
}

sub configure_route {
	my ($new_route)=@_;
	for my $r (keys %$new_route) {
		my ($to,$gw)=split /#/,$r;
		sys('ip','route','add',$to,'via',$gw);
	}
}

our $ip_want_addr;

sub ip {
	my ($device,$cidr)=@_;
	exists $ip_want_addr->{$cidr} and die "IP address $cidr already configured\n";
	$ip_want_addr->{$cidr}=$device;
}

sub read_active_ip {

	my $have_addr={};
	my $device;
	open IN,'-|','ip','addr' or die "$!\n";
	while (<IN>) {
		if (/^\d+: (\S+):/) {
			$device=$1;
			$device=~s/\@.+$//;
			next;
		}
		if (my ($addr)=/\s*inet6? (\S+) scope global/) {
			next if /dynamic/;
			$have_addr->{$addr}=$device;
		}
	}
	return ($have_addr);
}

sub unconfigure_ip {
	my ($have_addr)=@_;
	for my $ip (sort keys %$have_addr) {
		my $device=$have_addr->{$ip};
		sys("ip addr delete $ip dev $device");
	}
}

sub configure_ip {
	my ($want_addr)=@_;
	for my $ip (sort keys %$want_addr) {
		my $device=$want_addr->{$ip};
		sys("ip addr add $ip dev $device");
	}
}

our $want_vlan;

sub vlan {
	my ($base_device,$vlan_num,$vlan_device,$cidr)=@_;
	$vlan_num=~/^\d+$/ or die "VLAN number not numeric\n";
	$want_vlan->{$vlan_device}=[$base_device,$vlan_num];
	if (defined $cidr) {
		ip($vlan_device,$cidr);
	}
}

sub read_active_vlans {
	my $have_vlan={};	# { "eth5.150"=>1, ... }

	-e "/proc/net/vlan/config" or sys("modprobe 8021q || true");

	my $file="/proc/net/vlan/config";
	open IN,'<',$file or die "$file: $!\n";
	while (<IN>) {
		/^(\S+)\s*\|\s*(\d+)\s*\|\s*(\S+)\s*$/ or next;		# eth0.150       | 150  | eth0
		my ($vlan_device,$vlan_num,$base_device)=($1,$2,$3);
		$have_vlan->{$vlan_device}=[$base_device,$vlan_num];
	}
	return ($have_vlan);
}

sub configure_vlans {
	my ($want_vlan)=@_;
	for my $device (sort keys %$want_vlan) {
		my ($base_device,$vlan_num)=@{$want_vlan->{$device}};
		sys("ip link set dev $base_device up") unless netif_is_up($base_device);
		sys("ip link add link $base_device name $device type vlan id $vlan_num");
	}
	for my $device (sort keys %$want_vlan) {
		sys("ip link set dev $device up");
	}
}

my $want_ipsets;    # { name => [type,filename,create-options]) , ... }

sub ipset {
	my ($name,$type,$filename,@options)=@_;
	$want_ipsets->{$name}=[$type,$filename,@options];
}

sub read_active_ipsets {
	my $active_ipsets;		# { $name => 1 , ... )
	open my $p,'-|','ipset','--list','-n' or die "$!";
	while (<$p>) {
		chomp;
		$active_ipsets->{$_}=1;
	}
	return $active_ipsets;
}

sub unconfigure_ipsets {
	my ($have_ipsets)=@_;
	for my $name (sort keys %$have_ipsets) {
		sys('ipset','destroy',$name);
	}
}

sub configure_ipsets {
	my ($want_ipsets)=@_;
	for my $name (sort keys %$want_ipsets) {
		my ($type,$filename,@options)=@{$want_ipsets->{$name}};
		sys('ipset','create',$name,$type,@options);
	}
}
sub reload_ipsets {
	my ($want_ipsets)=@_;
	for my $name (sort keys %$want_ipsets) {
		my ($type,$filename,@options)=@{$want_ipsets->{$name}};
		my $tmp="$name-TMP";
		warn "read ipset $name from $filename\n";
		system('ipset','create',$tmp,$type,@options) and exit 1;
		$type eq 'hash:ip' or die "read ipset type $type from file not implemented\n";
		open my $in,'<',$filename or die "$filename: $!\n";
		while (<$in>) {
			s/#.*//;
			/^\s*(\d+\.\d+\.\d+\.\d+)\s*$/ or next;
			system('ipset','add',$tmp,$1) and exit 1;
		}
		system('ipset','swap',$name,$tmp) and exit 1;
		system('ipset','destroy',$tmp) and exit 1;
	}
}

our %radvd;		# ( 'net03' => 'AdvSendAdvert on;prefix 2a02:d480:e08:20::/64;' , ...)

sub radvd {
	my ($if,$conf)=@_;
	$radvd{$if}=$conf;
}

# 'lo' implied without config. Note: ipv6 seems to *need* lo for unknown reasons
our $want_if = {'lo' => 1};    # includes lo, veth and physical devices but not vlan devices
our $want_veth;

sub configure_if {
	my ($want_if)=@_;
	for my $if (keys %$want_if) {
		netif_is_up($if) or  sys('ip', 'link', 'set', $if, "up");
	}
}

sub unconfigure_if {
	my ($have_if)=@_;
	for my $if (keys %$have_if) {
		if (-d "/sys/class/net/$if/device") {
			# hardware device
			sys('ip', 'link', 'set', $if, 'netns', 1);
		} else {
			# virtual device
			sys('ip', 'link', 'del', $if);
		}
	}
}

our $DHCRELAY_FORWARD;
our %DHCRELAY_IF;

sub want_ulogd_conf {
	my $L='/usr/lib/ulogd/';
	<<"__EOF__";
[global]

logfile="/var/run/mxrouter/$NETNS/ulogd.log"
loglevel=1

plugin="$L/ulogd_inppkt_NFLOG.so"
plugin="$L/ulogd_raw2packet_BASE.so"
plugin="$L/ulogd_filter_IFINDEX.so"
plugin="$L/ulogd_filter_IP2STR.so"
plugin="$L/ulogd_filter_PRINTPKT.so"
plugin="$L/ulogd_output_LOGEMU.so"

stack=log1:NFLOG,base1:BASE,ifi1:IFINDEX,ip2str1:IP2STR,print1:PRINTPKT,emu1:LOGEMU

[emu1]
file="/var/log/ulogd_$NETNS.log"
sync=1
__EOF__
}

our %disable_ipv4_rp_filter = ('all' => 1);  # this is AND ( https://marc.info/?l=linux-kernel&m=123606366021995&w=2 )

sub disable_ipv4_rp_filter {
	my ($if)=@_;
	$disable_ipv4_rp_filter{$if}=1;
}



sub start {

	-d "/var/run/mxrouter/$NETNS" or sys ('mkdir','-p',"/var/run/mxrouter/$NETNS");

	my $process_dhcrelay;

	if ($DHCRELAY_FORWARD && %DHCRELAY_IF) {
		$process_dhcrelay=want_process(
			'dhcrelay',
			'/usr/sbin/dhcrelay','-q','-4','-pf',"/var/run/mxrouter/$NETNS/dhcrelay.pid",
			map({('-i',$_)} sort keys %DHCRELAY_IF),
			$DHCRELAY_FORWARD
		);
	} else {
		$process_dhcrelay=want_process('dhcrelay');
	}

	my $have_radvd_conf=slurpfile_or_empty("/var/run/mxrouter/$NETNS/radvd.conf");
	my $want_radvd_conf='';
	if (%radvd) {
		$want_radvd_conf=join("\n\n",map({"interface $_ {\n".$radvd{$_}."\n};\n"} sort keys %radvd));
	}

	my $process_radvd;
	if ($want_radvd_conf) {
		$process_radvd=want_process(
			'radvd',
				'/usr/sbin/radvd',
				'-C',"/var/run/mxrouter/$NETNS/radvd.conf",
				'-p',"/var/run/mxrouter/$NETNS/radvd.pid",
				'-m','syslog'
		);
		if ($want_radvd_conf ne $have_radvd_conf) {
			print "# update /var/run/mxrouter/$NETNS/radvd.conf\n";
			writefile("/var/run/mxrouter/$NETNS/radvd.conf",$want_radvd_conf);
		}
	} else {
		$process_radvd=want_process('radvd');
		unlink("/var/run/mxrouter/$NETNS/radvd.conf");
	}
	if ($have_radvd_conf ne $want_radvd_conf) {
		stop_process($process_radvd);
	}

	my $want_ulogd_conf=want_ulogd_conf();
	my $have_ulogd_conf=slurpfile_or_empty("/var/run/mxrouter/$NETNS/ulogd.conf");

	if ($want_ulogd_conf ne $have_ulogd_conf) {
		print "# update /var/run/mxrouter/$NETNS/ulogd.conf\n";
		writefile("/var/run/mxrouter/$NETNS/ulogd.conf",$want_ulogd_conf);
	}

	my $process_ulogd;
	$process_ulogd=want_process(
		'ulogd',
			'/usr/sbin/ulogd',
			'-c',"/var/run/mxrouter/$NETNS/ulogd.conf",
			'-p',"/var/run/mxrouter/$NETNS/ulogd.pid",
			'-d'
	);

	if ($want_ulogd_conf ne $have_ulogd_conf) {
		stop_process($process_ulogd);
	}

	my $have_addr=read_active_ip();
	my ($new_addr,$del_addr)=({},{});

	my $have_if = {map {$_ => 1} network_devices()};
	for (keys %$want_if) {
		exists $have_if->{$_} or warn "Interface $_ not available\n";
	}
	my $del_if={};
	for (keys %$have_if) {
		exists $want_if->{$_}
			|| exists $want_vlan->{$_}
			|| $_ eq 'lo'
			or $del_if->{$_} = 1;
	}

	my ($have_vlan)=read_active_vlans();
	delete $have_vlan->{$_} for keys %$want_if;  # vlan interfaces created in main and moved via interface()
	my $new_vlan = {};

	for (keys %$want_vlan) {
		$new_vlan->{$_}=$want_vlan->{$_}
			unless exists $have_vlan->{$_}
			&& $have_vlan->{$_}[0] eq $want_vlan->{$_}[0]
			&& $have_vlan->{$_}[1] eq $want_vlan->{$_}[1];
	}

	for (keys %$ip_want_addr) {
		$new_addr->{$_}=$ip_want_addr->{$_}
			unless exists $have_addr->{$_}
			&& $have_addr->{$_} eq $ip_want_addr->{$_};
	}
	for (keys %$have_addr) {
		$del_addr->{$_}=$have_addr->{$_}
			unless exists $ip_want_addr->{$_}
			&& $ip_want_addr->{$_} eq $have_addr->{$_};
	}

	my ($have_route)=read_active_route();
	my ($new_route,$del_route)=({},{});
	for (keys %$want_route) {
		$new_route->{$_}=$want_route->{$_}
			unless exists $have_route->{$_};
	}
	for (keys %$have_route) {
		$del_route->{$_}=$have_route->{$_}
			unless exists $want_route->{$_};
	}

#	unless (get_ipv6_forwarding()>0) {
#		warn "enable IPV6 forwarding\n" unless $opt_quiet;
#		set_ipv6_forwarding(1);
#	}

	unless (get_ipv4_routing()>0) {
		warn "enable IPV4 routing\n" unless $opt_quiet;
		set_ipv4_routing(1);
	}

	my $have_ipsets=read_active_ipsets();
	my ($new_ipsets,$del_ipsets)=({},{});
	for (keys %$want_ipsets) {
		$new_ipsets->{$_}=$want_ipsets->{$_}
			unless exists $have_ipsets->{$_};
	}
	for (keys %$have_ipsets) {
		$del_ipsets->{$_} = $have_ipsets->{$_}
			unless exists $want_ipsets->{$_};
	}

	stop_process_if($process_ulogd);
	stop_process_if($process_dhcrelay);
	stop_process_if($process_radvd);
	unconfigure_route($del_route);
	unconfigure_ip($del_addr);
	unconfigure_if($del_if);

	configure_if($want_if);
	configure_vlans($new_vlan);
	configure_ip($new_addr);
	configure_route($new_route);

	for my $dev ('all','default',network_devices()) {
		if (get_ipv4_send_redirects($dev)>0) {
			warn "disable IPV4 send redirects on $dev\n" unless $opt_quiet;
			set_ipv4_send_redirects($dev,0);
		}

		my $ipv4_rp_filter = $disable_ipv4_rp_filter{$dev} ? 0 : 1;
		if (get_ipv4_rp_filter($dev)!=$ipv4_rp_filter) {
			warn (($ipv4_rp_filter ? "enable" : "disable")." ipv4_rp_filter   on $dev\n") unless $opt_quiet;
			set_ipv4_rp_filter($dev,$ipv4_rp_filter);
		}
#		if (get_ipv4_log_martians($dev)==0) {
#			warn "enable martians log on $dev\n" unless $opt_quiet;
#			set_ipv4_log_martians($dev,1);
#		}
		if (get_ipv6_accept_ra($dev)==1) {
			warn "disable accept_ra on $dev\n" unless $opt_quiet;
			set_ipv6_accept_ra($dev,0);
		}
	}

	start_process_if($process_ulogd);
	start_process_if($process_dhcrelay);
	start_process_if($process_radvd);

	configure_ipsets($new_ipsets);
	unless ($opt_noop) {
		open my $pipe,'|-','iptables-restore' or die "$!\n";
		print $pipe rules_in_restore_format();
		close $pipe or die "$!\n";
		$? and exit 1;
	}
	unconfigure_ipsets($del_ipsets);
	reload_ipsets($want_ipsets);
}

sub move_dev_into_ns {
	my ($dev,$ns)=@_;
	sys('ip','link','set',$dev,'netns',$ns);
}

sub stop {
	# we are are going to delete the namespace. Dont bother... with settings, but stop all processes

	for my $pid (`ip netns pids $NETNS`) {
		chomp($pid);
		$pid == $$ and next;
		-d "/proc/$pid" or next;	# eg the "ip netns" command
		my $comm=slurpfile_chomp_or_empty("/proc/$pid/comm");
		print "kill pid $pid comm $comm\n";
		kill_process($pid);
	}

}

sub test {
	print rules_in_restore_format()
}

sub interface {
	my ($dev)=@_;
	$want_if->{$dev}=1;
}

sub veth {
	my ($dev) = @_;
	$want_if->{$dev} = 1;
	$want_veth->{$dev} = 1;
}

sub dhcrelay_forward {
	my ($ip)=@_;
	$DHCRELAY_FORWARD=$ip;
}

sub dhcrelay_if {
	my ($if)=@_;
	$DHCRELAY_IF{$if}=1;
}

sub ref_to_string {
	my ($ref)=@_;
	return Data::Dumper->new([$ref])->Terse(1)->Indent(0)->Dump();
}

sub kill_process {
	my ($pid)=@_;

	print "kill $pid\n";

	-d "/proc/$pid" or return;
	kill TERM=>$pid;
	for (my $i=0;$i<5;$i++) {
		-d "/proc/$pid" or return;
		sleep 1;
	}
	print "kill -9 $pid\n";
	kill KILL=>$pid;
	for (my $i=0;$i<5;$i++) {
		-d "/proc/$pid" or return;
		sleep 1;
	}
	die "faield to kill PID $pid\n";
}

###################### process maintenance

sub pidfilename {				# 'dhcrelay' => "/var/run/mxrouter/$NETNS/dhcrelay.pid"
	my ($name)=@_;
	return "/var/run/mxrouter/$NETNS/$name.pid";
}

sub cmdfilename {				# 'dhcrelay' => "/var/run/mxrouter/$NETNS/dhcrelay.cmd.pl"
	my ($name)=@_;
	return "/var/run/mxrouter/$NETNS/$name.cmd.pl";
}

sub get_running_pid {
	my ($name)=@_;
	my $pidfilename=pidfilename($name);
	-e $pidfilename or return undef;
	my $pid=slurpfile_chomp($pidfilename);
	$pid or return undef;
	-d "/proc/$pid" or return undef;
	return $pid;
}

# process : [ name , [ @want_cmd ] , $want_cmd_hash , $pid , $runnig_cmd_hash ]

sub want_process {
	my $name=shift;
	my $want_cmd_array_ref=[@_];			# may be emtpy

	my $want_cmd_hash=ref_to_string($want_cmd_array_ref);

	my $pid=get_running_pid($name);			# may be undef
	my $running_cmd_hash;

	if ($pid) {
		my $cmdfilename=cmdfilename($name);
		if (-e $cmdfilename) {
			$running_cmd_hash=slurpfile_chomp($cmdfilename);
		} else {
			$running_cmd_hash='';
		}
	}
	return [ $name , $want_cmd_array_ref , $want_cmd_hash , $pid , $running_cmd_hash ];
}

sub stop_process {
	my ($process)=@_;
	my ( $name , $want_cmd_array_ref , $want_cmd_hash , $pid , $running_cmd_hash ) = @$process;
	$pid or return;
	print "# kill $pid $name\n";
	kill_process($pid);
	unlink(cmdfilename($name));
	$process->[3]=undef;
}

sub start_process {
	my ($process)=@_;
	my ( $name , $want_cmd_array_ref , $want_cmd_hash , $pid , $running_cmd_hash ) = @$process;
	sys(@$want_cmd_array_ref);
	writefile(cmdfilename($name),$want_cmd_hash);
}

sub stop_process_if {
	my ($process)=@_;
	my ( $name , $want_cmd_array_ref , $want_cmd_hash , $pid , $running_cmd_hash ) = @$process;
	$pid or return;
	if (!@$want_cmd_array_ref || $want_cmd_hash ne $running_cmd_hash) {
		stop_process($process);
		$process->[3]=undef;
	}
}
sub start_process_if {
	my ($process)=@_;
	my ( $name , $want_cmd_array_ref , $want_cmd_hash , $pid , $running_cmd_hash ) = @$process;
	$pid and return;
	@$want_cmd_array_ref or return;
	start_process($process);
}

##########################################

sub prepare_netns_interfaces {
		# create veth pair if not yet available
		for my $dev (sort keys %$want_veth) {
			-d "/sys/class/net/$dev" and next;
			sys('ip', 'link', 'add', $dev, 'type', 'veth', 'peer', 'name', $dev, 'netns', $NETNS);
			sys('ip', 'link', 'set', $dev, 'up');
		}
		# move interfaces which are still in the init namespace
		# ignore veth devices and lo, which exists in both namespaces
		for my $dev (sort keys %$want_if) {
			$dev eq 'lo'  || $want_veth->{$dev} and next;
			-d "/sys/class/net/$dev" and sys('ip', 'link', 'set', $dev, 'netns', $NETNS);
		}
}

##########################################

my @SAVED_ARGV=@ARGV;

GetOptions(OPTIONS) or die USAGE;
@ARGV>=1 or die USAGE;

my ($cmd)=@ARGV;

our $CONFIG_FILE="/etc/local/mxrouter/$NETNS.cf.pl";

unless (-e $CONFIG_FILE) {
	warn "$0 : ignored - no file $CONFIG_FILE\n";
	exit;
}

unless (defined do "$CONFIG_FILE") {
	die "$CONFIG_FILE: $@\n" if $@;
	die "$CONFIG_FILE: $!\n";
}

if (!$opt_this_ns) {
	if ($cmd eq 'start') {
		# neighbour table thresholds
		# 2DO: read this from config file
		#  these are not namespace local
		# 
		# http://lxr.free-electrons.com/source/Documentation/networking/ip-sysctl.txt
		# gc_thresh1 : Minimum number of entries to keep Default 128
		#   Garbage collector will not purge entries if there are fewer than this number.
		# gc_thresh2 : Threshold when garbage collector becomes more aggressive about purging entries
		#    Entries older than 5 seconds will be cleared when over this number
		# gc_thresh3 : Maximum number of neighbor entries allowed.

		writefile('/proc/sys/net/ipv4/neigh/default/gc_thresh1','1536');
		writefile('/proc/sys/net/ipv4/neigh/default/gc_thresh2','2048');
		writefile('/proc/sys/net/ipv4/neigh/default/gc_thresh3','2560');

		have_netns($NETNS) and die "already running (network namespace $NETNS already exists)\n";
		create_netns($NETNS);
		prepare_netns_interfaces();
		system('ip','netns','exec',$NETNS,$0,'--this-ns',@SAVED_ARGV) and exit 1;
	} elsif ($cmd eq 'stop') {
		have_netns($NETNS) or die "not running (network namespace $NETNS does not exist)\n";
		system('ip','netns','exec',$NETNS,$0,'--this-ns',@SAVED_ARGV) and exit 1;
		delete_netns($NETNS);
	} elsif ($cmd eq 'reload') {
		have_netns($NETNS) or die "not running (network namespace $NETNS does not exist)\n";
		prepare_netns_interfaces();
		system('ip', 'netns', 'exec', $NETNS,$0,'--this-ns', @SAVED_ARGV) and exit 1;
	} else {
		have_netns($NETNS) or die "not running (network namespace $NETNS does not exist)\n";
		system('ip','netns','exec',$NETNS,$0,'--this-ns',@SAVED_ARGV) and exit 1;
	}
} else {
	if ($cmd eq 'start') {
		start();
	} elsif ($cmd eq 'restart' || $cmd eq 'reload') {
		start();
	} elsif ($cmd eq 'stop') {
		stop();
	} elsif ($cmd eq 'test') {
		test();
	} elsif ($cmd eq 'exec') {
		shift;
		sys(@ARGV);
	} elsif ($cmd eq 'bash') {
		$ENV{'PS1'}="$NETNS> ";
		sys('bash','--norc');
	} else {
		die USAGE;
	}
}