mxvlanctl

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

sub USAGE { "usage: $0 start|stop|restart\n" }

my $hostname=`/bin/hostname`;chomp($hostname);
$hostname=~s/\.molgen\.mpg\.de$//i;

sub sys {
	my ($cmd)=@_;
	print "$cmd\n";
	system $cmd and exit 1;
}


sub fix_eth {		# fix 'ethX' to 'netXX' if ethX does not exist, but netXX does (old name used in config)
	my ($dev)=@_;
	if ($dev=~/^eth(\d+)/ and !-d "/sys/class/net/$dev") {
		my $netdev=sprintf('net%02d',$1);
		-d  "/sys/class/net/$netdev" and return $netdev;
	}
	return $dev;
}

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

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



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


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


	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];
	}
	open IN,'-|','ip','addr' or die "$!\n";
	while (<IN>) {
		if (my ($addr,$dev)=/^\s*inet (\S+) scope global (\S+)/) {
			exists ($have_vlan->{$dev}) and $have_addr->{$addr}=$dev;
		}
	}
	close IN;
	return ($have_vlan,$have_addr);

}

sub read_mxvlans {
	my $want_vlan={};	# { "eth5.150"=>[eth5,150]", "vlan.github"=>[net02,54], ... }
	my $want_addr={};	# { "141.14.12.12/24" => "vlan.github", .. }

	my $file='/etc/mxvlans';
	open IN,'<',$file or die "$file: $!\n";
	while (<IN>) {
		s/#.*//;
		chomp;
		my @words=split;
		@words or next;
		eval {
			@words==4 or @words==5 or die "format error : $_\n";
			my ($host,$base_device,$vlan_num,$vlan_device,$cidr)=@words;
			$base_device=fix_eth($base_device);	# temp accept ethX for netXX
			if ($host eq $hostname) {
				$vlan_num=~/^\d+$/ or die "VLAN number not numeric\n";
				$want_vlan->{$vlan_device}=[$base_device,$vlan_num];
				if (defined $cidr) {
					$want_addr->{$cidr}=$vlan_device;
				}
			}			
		};
		if ($@) {
			die "$file line $. : $@";
		}
	}
	return ($want_vlan,$want_addr);
}


sub configure_vlans {
	my ($want_vlan,$want_addr)=@_;
	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 $ip (sort keys %$want_addr) {
		my $device=$want_addr->{$ip};
		sys("ip addr add $ip dev $device");
	}
	for my $device (sort keys %$want_vlan) {
		sys("ip link set dev $device up");
	}
}

sub unconfigure_vlans {
	my ($have_vlan,$have_addr)=@_;

	for my $device (sort keys %$have_vlan) {
		sys("ip link set dev $device down");
	}
	for my $ip (sort keys %$have_addr) {
		my $device=$have_addr->{$ip};
		sys("ip addr delete $ip dev $device");
	}
	for my $device (sort keys %$have_vlan) {
		my ($base_device,$vlan_num)=$device=~/^([^.]+)\.(.+)$/;
		sys("ip link delete $device");
	}
}

@ARGV==1 or die USAGE;

my ($cmd)=@ARGV;


if ($cmd eq 'start' or $cmd eq 'restart') {

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

	my ($want_vlan,$want_addr)=read_mxvlans();
	my ($have_vlan,$have_addr)=read_active_vlans();
	
	my ($new_vlan,$new_addr,$del_vlan,$del_addr)=({},{},{},{});

	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 %$want_addr) {
		$new_addr->{$_}=$want_addr->{$_}
			unless exists $have_addr->{$_}
			&& $have_addr->{$_} eq $want_addr->{$_};
	}
	for (keys %$have_vlan) {
		$del_vlan->{$_}=$have_vlan->{$_}
			unless exists $want_vlan->{$_}
			&& $have_vlan->{$_}[0] eq $want_vlan->{$_}[0]
			&& $have_vlan->{$_}[1] eq $want_vlan->{$_}[1];
	}
	for (keys %$have_addr) {
		$del_addr->{$_}=$have_addr->{$_}
			unless exists $want_addr->{$_}
			&& $want_addr->{$_} eq $have_addr->{$_};
	}
	unconfigure_vlans($del_vlan,$del_addr);
	configure_vlans($new_vlan,$new_addr);
} elsif ($cmd eq 'stop') {
	my ($have_vlan,$have_addr)=read_active_vlans();
	unconfigure_vlans($have_vlan,$have_addr);
} else {
	die USAGE;
}