#!/usr/bin/suidperl

# ifswitch -- Dynamically change network settings
#
# Copyright (c) 2001  Alexander Hajnal (ahajnal@interport.net)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software 
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

# For the latest version, see http://alephnull.net/linux/ifswitch
# v1.0 - Initial release (June 18, 2001)

use Gtk;         # load the Gtk-Perl module
use strict;      # a good idea for all non-trivial Perl scripts

init Gtk;        # initialize Gtk-Perl
set_locale Gtk;  # internationalize

# PATH must contain ifconfig, ifup, and ifdown
$ENV{PATH}='/bin:/sbin:/usr/bin:/usr/sbin';

my $verbose=0;

# *** Determine current interfaces ***
sub GetInterfaces {
	my $iface='';
	my $addr='';
	my $gw = '';
	my %interfaces=();
	foreach (`ifconfig`) {
		if (/^(\S+)\s/) { # interface name is always at beginning of line
			$iface=$1;
			$addr='';
			$gw = '';
		} else { # Get interface's IP address
			if (/\baddr:(\S+)\b/) {
				$addr=$1;
			}
		}
	  if ($iface && $addr) { # record the interface
			$interfaces{$iface}=$addr;
			$iface='';
			$addr='';
			$gw = '';
		}
	}
	return \%interfaces;
}

sub Die {
	print STDERR "Error: ".$_[0]."\n";
	exit;
}

sub Warn {
	print STDERR "Warning: ".$_[0]."\n";
}

# *** Parse configuration file ***

# Split config file line into label and filename 
sub Split {
	my($line)=$_[0];
	my $file = '';
	my $label = '';
	if ($line =~ /(((\\.)|\S)+)$/) { # look for filename at end of line
		$file = $1;
		if ($line =~ /^(.*\S){0,1}\s+\Q$file\E$/) { # find the label
			$label = $1;
			$file =~ s/\\(.)/$1/g;
		}
	}
	return ($label, $file);
}

# Load main configuration file and parse interface files
sub ParseConfig {
	my $line;
	open CONF, '/etc/ifswitch.conf' or die "Could not open configuration file /etc/ifswitch.conf\n";
	my %Config=();
	while (<CONF>) {
		chomp;
		unless (/^(#.*)*$/) { # skip comments and blank lines
			my ($label,$file)=Split($_); # get the label and filename
			$Config{$label}=$file;
		}
	}
	close CONF;
	return CheckConfig(\%Config); # return a hash of labels and filenames
}

# *** Check config file ***
sub CheckConfig {
  my $Config=$_[0];
	# Check validity of options
	Die "IFSwitchTarget not specified" unless ($$Config{IFSwitchTarget});
	Die "No interfaces specified" unless (scalar keys %$Config > 1);
	Die "IFSwitchTarget $$Config{IFSwitchTarget} is not a symbolic link "
		  if ((-e $$Config{IFSwitchTarget}) && !( -s $$Config{IFSwitchTarget}));
	
	# record the target filename
	$main::IFSwitchTarget=$$Config{IFSwitchTarget};
	my %Targets=();
	my $name;
	my $file;
	while (($name, $file) = each %$Config) { # check each line of configuration 
		unless ($name eq 'IFSwitchTarget') { # if it's a interface specification
			unless (-e $file) { # does file exist?
				Warn "Interface file '$file' does not exist";
			} else {
				unless (-s $file) { # Check for zero length file
					Warn "Interface file '$file' contains no data";
				} else {
					# read interface configuration
					$Targets{$name}=[$file,[]];
					open IN, $file; # open configuration file
					my $iface='';
					my $addr='';
					my $gw = '';
					my $last_iface='';
					my $line;
					while ($line=<IN>) {  # read line from file
						
						if ($line =~ /^\s*iface\s+(\S+).+\binet\b/) {
							# start of interface specification
							$iface=$1;
						  if (($last_iface ne '') && ($iface ne $last_iface)) {
								# if not the first interface then record it
								push @{@{$Targets{$name}}[1]},[$last_iface, $addr, $gw];
								$addr='';
								$gw = '';
							}
							if ($line =~ /(\bloopback\b)/) { # check for loopback interface
							  $addr='loopback';
							}
							$last_iface=$iface;
							
						} elsif ($line =~ /^\s*address\s+(\S+)$/) { # get IP address
							$addr=$1;
							
						} elsif ($line =~ /^\s*gateway\s+(\S+)$/) { # get gateway address
							$gw=$1;
						}
					}
					
				  if ($last_iface ne '') {
						# record the last interface
						push @{@{$Targets{$name}}[1]},[$last_iface, $addr, $gw];
					}
					close IN;
				}
			}
		}
	}
	return \%Targets;
}

# *** Read current interfaces ***
%main::Current=%{GetInterfaces()};
%main::CurrentIP=();
foreach (%main::Current) {
  $main::CurrentIP{$main::Current{$_}}=$_;
}

# *** Read configuration files ***
my $IFSwitchTarget='';
my %Targets=%{ParseConfig()};

# Configration is placed into two hashes:
# 
# Current configuration:
# %Current -> (name=>ip, ...)
# 
# Available configurations:
# %Targets -> (name=>(  filename, 
#                       ((ifname, ip, gw), ...)
#                    ),
#              ...)

# *** Determine which configuration matches the current one ***
if ($verbose) {
	print "Current configuration:\n";
	foreach (keys %main::Current) {
		print "\t$_: $main::Current{$_}\n";
	}
	print "Available configurations:\n";
}
my $config;
my $CurrentConfig='';
foreach $config(keys %Targets) { # check each configuration file
  print "$config\n" if ($verbose);
	my($fname,$ifaces)=@{$Targets{$config}};
	print "\tfilename: $fname\n" if ($verbose);
	
	foreach (@$ifaces) { # check each interface in file
	  if ($$_[1] && $main::CurrentIP{$$_[1]}) {
			# if interface's IP address matches our current IP address
		  print "*" if ($verbose);
			$CurrentConfig=$config; # note that this config matches our's
		}
		if ($verbose) {
			if ($$_[2]) {
				print "\t$$_[0]: $$_[1], gw $$_[2]\n";
			} else {
				print "\t$$_[0]: $$_[1]\n";
			}
		}
	}
}

# *** END CONFIGURATION ***

# *** START GUI ***

# convenience variables for true and false
my $false = 0;
my $true = 1;

# *** Create text widget ***
my $textarea = new Gtk::Text();
$textarea->set_editable( 1 );
$textarea->set_usize( 400, 100 );
my $vscrollbar = new Gtk::VScrollbar( $textarea->vadj );
my $text_table = new Gtk::Table( 1, 2, 0 );
$text_table->set_row_spacings( 0 );
$text_table->set_col_spacings( 0 );
$text_table->attach_defaults( $textarea, 0, 1, 0, 1 );
$text_table->attach( $vscrollbar, 1, 2, 0, 1, 'fill',
		[ 'expand', 'shrink', 'fill' ], 0, 0 );
$textarea->show();
$vscrollbar->show();
$text_table->show();
my $fixed_font = Gtk::Gdk::Font->load("-misc-fixed-medium-r-*-*-*-120-*-*-*-*-*-*");


# *** Create controls ***
my $l_switchto  = new Gtk::Label( "switch to: " );
my $b_which = new Gtk::Button( "GO" );

my @targets=sort keys %Targets;

my $target_menu = new Gtk::Menu();
my $label;
my $menu_item;
my $target;
if ($CurrentConfig ne '') {
  $main::target=$CurrentConfig;
} else {
	$main::target=$targets[0];
}

# Append text to status display
sub StatusAppend {
  my $text=$_[0];
	$textarea->freeze();
	$textarea->set_point($textarea->get_length());
	$textarea->insert( $fixed_font, undef, undef, $text."\n" );
	$textarea->thaw();
	$textarea->set_point($textarea->get_length());
}

# Clear status display
sub StatusClear {
	$textarea->freeze();
	$textarea->set_point(0);
	$textarea->forward_delete($textarea->get_length());
	$textarea->thaw();
}

# Called when interface selection changes
sub SwitchConfig {
  my $which=$_[0];
  $main::target=$which;
	my($fname,$ifaces)=@{$Targets{$which}};
	my $out="$which:\n";
	$out.="  filename: $fname\n";
	$out.="  interfaces:\n";
	foreach (@$ifaces) {
	  if ($$_[1] && $main::CurrentIP{$$_[1]}) {
			if ($$_[2]) {
				$out.="  * $$_[0]: $$_[1], gateway $$_[2]\n";
			} else {
				$out.="  * $$_[0]: $$_[1]\n";
			}
		} else {
			if ($$_[2]) {
				$out.="    $$_[0]: $$_[1], gateway $$_[2]\n";
			} else {
				$out.="    $$_[0]: $$_[1]\n";
			}
		}
	}
	StatusClear();
	StatusAppend($out);
}

# *** Create interface selection menu ***
my $chosen;
my $idx=0;
foreach $label(@targets) {
  # Create a new menu-item with a name...
	$menu_item = new Gtk::MenuItem( "$label" );
  # and add it to the menu.
  $target_menu->append( $menu_item );
	$target_menu->set_active($idx) if ($label eq $main::target);
  # Do something interesting when the menuitem is selected
  $menu_item->signal_connect( 'select', sub { SwitchConfig($label); } );
  # Show the widget
  $menu_item->show();
	$idx++;
}
my $target_popup = new Gtk::OptionMenu();
$target_popup->set_menu( $target_menu );

# *** Create and populate controls table ***
my $control_table = new Gtk::Table( 3, 1, 0 );
$control_table->set_row_spacings( 5 );
$control_table->set_col_spacings( 5 );
$control_table->attach( $l_switchto, 0, 1, 0, 1, 'shrink', [ 'shrink' ], 0, 0 );
$control_table->attach( $target_popup, 1, 2, 0, 1, 'shrink', [ 'shrink' ], 0, 0 );
$control_table->attach( $b_which, 2, 3, 0, 1, 'shrink', [ 'shrink' ], 0, 0 );

$l_switchto->show();
$target_popup->show();
$b_which->show();

$control_table->show();

# *** Main window ***
my $window = new Gtk::Window( "toplevel" );
$window->set_title( "IFSwitch v1.0" );
my $main_table = new Gtk::Table( 2, 1, 0 );
$main_table->set_row_spacings( 0 );
$main_table->set_col_spacings( 0 );
$main_table->attach( $control_table, 0, 1, 0, 1, 'shrink', [ 'shrink' ], 0, 0 );
$main_table->attach( $text_table, 0, 1, 1, 2, 'fill', [ 'shrink' ], 0, 0 );
$main_table->show();

# set window attributes and show it
$window->border_width( 15 );
$window->add( $main_table );
$window->show();


# *** Callback registration ***

sub CloseAppWindow {
  Gtk->exit( 0 );
  return $false;
}

$window->signal_connect( "delete_event", \&CloseAppWindow );   
$b_which->signal_connect( "clicked", \&run );

# *** Callback function to perform the interface switch ***
sub run {
  # determine the filename to switch to
	my($fname,$ifaces)=@{$Targets{$main::target}};
	StatusClear();
	StatusAppend("Switching to $fname\n");
	
	# bring down the current interface
	StatusAppend("# ifdown -v eth0");
	open IF, 'ifdown -v eth0|'; 
	my $out;
	StatusAppend($out) while ($out=<IF>);
	close IF;
	
	# remove the old configuration's symlink
	StatusAppend("# rm $main::IFSwitchTarget");
	unlink $main::IFSwitchTarget;
	
	# create a link to the new configuration
	StatusAppend("# ln -s $fname $main::IFSwitchTarget");
	symlink $fname, $main::IFSwitchTarget;
	
	# bring up the new interface
	StatusAppend("# ifup -v eth0");
	open IF, 'ifup -v eth0|'; 
	StatusAppend($out) while ($out=<IF>);
	close IF;
	
	# update our internal copy of the configuration
	%main::Current=%{GetInterfaces()};
	%main::CurrentIP=();
	foreach (%main::Current) {
  	$main::CurrentIP{$main::Current{$_}}=$_;
	}
}

# Display the current configuration
SwitchConfig($main::target);

# Gtk event loop
main Gtk;

# Should never get here
exit(0);
