#!/usr/bin/perl -w
# 
# -------------------------------------------------------------------
#                                   X-BONE
#
#                          http://www.isi.edu/xbone
#                USC Information Sciences Institute (USC/ISI)
#                   Marina del Rey, California 90292, USA
#                          Copyright (c) 1998-2005
# 
# -------------------------------------------------------------------
#
# Copyright (c) 1998-2005 by the University of Southern California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and
# its documentation in source and binary forms for non-commercial
# purposes and without fee is hereby granted, provided that the above
# copyright notice appear in all copies and that both the copyright
# notice and this permission notice appear in supporting
# documentation, and that any documentation, advertising materials,
# and other materials related to such distribution and use acknowledge
# that the software was developed by the University of Southern
# California, Information Sciences Institute.  The name of the
# University may not be used to endorse or promote products derived
# from this software without specific prior written permission.
# 
# THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT
# THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE.  THIS SOFTWARE IS
# PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# Other copyrights might apply to parts of this software and are so
# noted when applicable.
#
# -------------------------------------------------------------------
#
# Effort partly sponsored by the Defense Advanced Research Projects
# Agency (DARPA) and Air Force Research Laboratory, Air Force Materiel
# Command, USAF, under agreement numbers F30602-98-1-0200 (X-Bone) and
# F30602-01-2-0529 (DynaBone). The views and conclusions contained
# herein are those of the authors and should not be interpreted as
# necessarily representing the official policies or endorsements,
# either expressed or implied, of the Defense Advanced Research
# Projects Agency (DARPA), the Air Force Research Laboratory, or the
# U.S. Government.
#
# This work was partly supported by the NSF STI-XTEND (ANI-0230789)
# and NETFS (ANI-0129689) projects. Any opinions, findings, and
# conclusions or recommendations expressed in this material are those
# of the authors and do not necessarily reflect the views of the
# National Science Foundation.
#
# -------------------------------------------------------------------
#  $RCSfile: vserver-script.pl,v $
#
# $Revision: 1.5 $
#   $Author: pingali $
#     $Date: 2005/03/31 07:03:42 $
#    $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Venkata Pingali

use Getopt::Long qw(:config no_ignore_case);  
use Data::Dumper; 
use FileHandle; 

####################################################
# This is a xbone application deployment script that 
# deploys linux vservers on a bunch of machines. 
# To use this you need to: 
#  1. install vserver rpms + kernel patch 
#  2. install xbone 
#  3. create a set of vservers 
#  4. create a list of vservers in the/etc/vserver-list 
#     (e.g. $cat /etc/vserver-list 
#           vserver1.conf
#           vserver2.conf)  
#  5. start the RD 
#  6. use this script as the application deployment 
#     script in the XBone gui. 
#
# Assumes: /etc/vservers/vserver-list 
#                   a list of available vservers
#  The format of the vserver-list file is simple. 
#  It has the name of each configured vserver 
#  on a separate line. 
#                   
# Logfile: /etc/vservers/log 
#                   the location can be changed 
####################################################

#---------------------------------
#my $VSERVERDIR = "/tmp/etc/vservers"; 
my $VSERVERDIR = "/etc/vservers"; 
my $LOGFILE = "$VSERVERDIR/log"; 
my $VSERVERLIST = "$VSERVERDIR/vserver-list"; 


####################################################
# NOT USED BUT MAY BE NECESSARY LATER ON 
# Save the configuration 
#
####################################################
sub do_save_config($) { 
  my $temp = shift; 

  #=> Save the configuration
  my $dir = `dirname $0` ; 
  chomp($dir); 
  my $file = $dir . "/.conf";
  my $fh = new FileHandle;
    
  eval{
    # open the file for writing
    if(!$fh->open ($file, ">")){
      die "open";
    }
    # set permission
    if(!chmod(0600, $file)){
      die "chmod";
    }
    
    $state = Data::Dumper->Dump([$temp], ["temp"]);
    $fh->print("$state"); 
    $fh->close or die "close: $!"; 
  };
  
  
}; # do save 

####################################################
#
# NOT USED BUT MAY BE NECESSARY LATER ON 
# Save the configuration 
#
####################################################
sub do_load_config() { 

  #=> Save the configuration
  my $temp; 
  my $dir = `dirname $0` ; 
  chomp($dir); 
  my $file = $dir . "/.conf";
  my $fh = new FileHandle;
   
  my $data = ""; 
  if($fh->open($file, "<")){
    while(<$fh>){
      $data .= $_;
    }
    $data =~ /(.*)/s;       # untaint the value
      eval $data;
    $fh->close or	die "close";
  }else{
    die ("Cannot open file"); 
  }; 
  
  #print Dumper($temp); 
  return $temp; 
  
}; # do save 

####################################################
#
# configure the vserver. look at the list of available
# vservers from the vserver-list file, extract one
# assign it to this overlay. 
#
####################################################
sub do_conf($) { 

    my $cmds = shift; 
    my $freeserver = ""; 

    my $logfile = $LOGFILE; 
    my $MY_OVL_NAME = $cmds->{"ovlname"}; 
    my $ALL_MY_IPS = join(" ", @{$cmds->{"myvirtips"}}); 
    
    #print "MY_OVL_NAME = $MY_OVL_NAME ALL_MY_IPS = \"$ALL_MY_IPS\"\n"; 

    my $msg = `date`; 
    open(LOG, ">>$logfile") || die("logfile cannot be removed"); 

    my $oldfile = $VSERVERLIST;
    my $newfile = $VSERVERLIST . ".new"; 
            
    open(CONF, "<$oldfile") || do {
	print LOG "Cannot open the file: $oldfile"; 
	die("Cannot open the file: $oldfile"); 
    };

    while (<CONF>) {
	/:$MY_OVL_NAME/ and do {
	    print LOG "Error. The overlay is already assigned to one vserver\n"; 
	    die("overlay already assigned an overlay"); 
	}
    }

    # ok. you can proceed to assign a free vserver to the 
    # overlay. 
    open(CONFNEW, ">$newfile") || do { 
	print LOG "Cannot open the file: $newfile"; 
	die("Cannot open the file: $newfile"); 
    }; 
    
    seek CONF, 0, 0; # reset the file pointer. 

    while (<CONF>) {
	/^\s*#/ and do { print CONFNEW $_; next; }; 
	/^\s+$/ and do { print CONFNEW $_; next; }; 
	/:/ and do { print CONFNEW $_; next; }; 
	chomp($_); 
	$freeserver = $_; 
	print CONFNEW $freeserver . ":$MY_OVL_NAME\n";
	last; 
    }
    
    #copy the rest of the file. 
    while(<CONF>) { print CONFNEW $_; } 
    
    close(CONF); 
    close(CONFNEW); 
    close(LOG); 

    if ($freeserver eq "") { 
	unlink($newfile); 
	die ("Dont have a free server");
    };
    
    # got a freeserver 
    rename($newfile, $oldfile);
    
    # extracted the vserver filename 
    # update the vserver configuration file. 
    $oldfile = "$VSERVERDIR/" . $freeserver; 
    $newfile = "$VSERVERDIR/" . $freeserver . ".new"; 
    open(CONF, "<$oldfile") || die("Cannot open the file"); 
    open(CONFNEW, ">$newfile") || die("Cannot open the file"); 
    
    while(<CONF>){ 
	chomp; 

	/^\s*#/ and do { print CONFNEW $_ . "\n"; next; }; 
	/^\s+$/ and do { print CONFNEW $_ . "\n"; next; }; 
	
	# replace IPROOT 
	/(.*)IPROOT=(\".*\")(.*)/ and do {
	    print CONFNEW "$1" . "IPROOT=\"$ALL_MY_IPS\"" . "$3". "\t\t\#XBONENEW\n";
	    print CONFNEW "\#$_\t\t\#XBONEORIG\n";
	    next; 
	};
	
	# replace the capabilities 
	/(.*)S_CAPS=(\".*\")(.*)/ and do {
	    print CONFNEW "$1" . "S_CAPS=\"CAP_NET_RAW\"" . "$3". "\t\t\#XBONENEW\n"; 
	    print CONFNEW "\#$_\t\t\#XBONEORIG\n"; 
	    next; 
	};

	/IPROOTDEV/ and do { print CONFNEW "\#$_\t\t\#XBONEORIG\n"; next; };
	/S_HOSTNAME/ and do { print CONFNEW "\#$_\t\t\#XBONEORIG\n"; next; };

	print CONFNEW $_. "\n";  
    }
    
    close(CONF); 
    close(CONFNEW); 
    
    rename($newfile, $oldfile); 
    
}

####################################################
#
# stop the vserver 
#
####################################################
sub do_kill($) {    

    my $cmds = shift; 
    my $server = ""; 
    my $oldfile = $VSERVERLIST; 
    my $MY_OVL_NAME = $cmds->{"ovlname"}; 

    open(CONF, "<$oldfile") || die("Cannot open the file: $oldfile"); 
    while (<CONF>) {
	/$MY_OVL_NAME/ and do { 
	    chomp($_); 
	    $_ =~ s/:.*$//; 
	    $server = $_; 
	    last; 
	}; 
    }    
    close(CONF);     
    die ("unable to find the correct server") if ($server eq ""); 

    $server =~ s/.conf$//;     
    my @cmd = ("/usr/sbin/vserver", "$server", "stop"); 
    #system(@cmd) == 0 || die("Cannot stop the vserver @cmd ");     
    system(@cmd); # some scripts may fail. 
}

####################################################
#
# start the vserver and possibly in future an application
#
####################################################
sub do_run($) {    

    my $cmds = shift; 
    my $server = ""; 
    my $oldfile = $VSERVERLIST; 
    my $MY_OVL_NAME = $cmds->{"ovlname"}; 


    open(CONF, "<$oldfile") || die("Cannot open the file: $oldfile"); 
    while (<CONF>) {
	/$MY_OVL_NAME/ and do { 
	    chomp($_); 
	    $_ =~ s/:.*$//; 
	    $server = $_; 
	    last; 
	}; 
    }    
    close(CONF); 
    die ("unable to find the correct server") if ($server eq ""); 
    
    $server =~ s/.conf$//;     
    my @cmd = ("/usr/sbin/vserver", "$server", "start"); 
    system(@cmd); # some scripts may fail. 
}

####################################################
#
# remove the vserver assignment. future work: cleanup
# the vserver conf file as well. 
#
####################################################
sub do_cleanup($) {
    
    my $cmds = shift; 
    my $freeserver = ""; 
    my $oldfile = $VSERVERLIST; 
    my $newfile = $VSERVERLIST . ".new"; 
    my $MY_OVL_NAME = $cmds->{"ovlname"}; 

    open(CONF, "<$oldfile") || die("Cannot open the file: $oldfile"); 
    open(CONFNEW, ">$newfile") || die("Cannot open the file: $newfile"); 

    while (<CONF>) {
	/:$MY_OVL_NAME/ and do { 
	    $_ =~ s/:$MY_OVL_NAME//; 
	    $freeserver = $_;
	    chomp($freeserver);
	    print CONFNEW $_; 
	    last; 
	}; 
	print CONFNEW $_; 
    }
    
    #copy the rest of the file. 
    while(<CONF>) { print CONFNEW $_; } 
    
    close(CONF); 
    close(CONFNEW); 
  
    die ("Cannot find the correct free server to cleanup")
      if (not defined($freeserver));

    # got a freeserver 
    rename($newfile, $oldfile); 
    
    # extracted the vserver filename 
    # update the vserver configuration file. 
    $oldfile = "$VSERVERDIR/" . $freeserver; 
    $newfile = "$VSERVERDIR/" . $freeserver . ".new"; 
    open(CONF, "<$oldfile") || die("Cannot open the file"); 
    open(CONFNEW, ">$newfile") || die("Cannot open the file"); 
    
    while(<CONF>){ 
	/\#XBONENEW/ and next; 
	/\#XBONEORIG/ and do {
	    $_ =~ s/^\#//; 
	    $_ =~ s/\#XBONEORIG//; 
	}; 

	print CONFNEW $_; 
    }
    
    close(CONF); 
    close(CONFNEW); 
    
    rename($newfile, $oldfile); 
    
}

####################################################
#
# log changes/errors to /etc/vservers/log
#
####################################################

sub note($$) {    
    my ($cmds, $input) = @_; 
    
    my $logfile = $LOGFILE;

    open(LOG, ">>$logfile") || die("logfile $logfile cannot be created"); 

    my $msg = `date`; 
    chomp($msg); 
    print LOG ">>>[$input] at $msg<<<\n"; 
    if ($input !~ /(done|error)/i){ 
	print LOG "Command = " . Dumper($cmds); 
    }
    close(LOG); 
};

####################################################
#
# Process command line 
#
####################################################

# cmdline 
#-t run -f tunl3 -f tunl5 -H mtv.isi.edu -i 172.26.0.13 -i 172.26.0.9
#-N mtv.isi.edu -N sci.isi.edu -N ifc.isi.edu -O 128.9.112.68 -P 4165
#-I 128.9.160.79 -a 172.26.0.9 -a 172.26.0.14 -a 172.26.0.10 -d
#test1.xbone.overlay -A 128.9.160.79 -A 128.9.160.93 -A 128.9.160.95 -p
#172.26.0.0/28)

sub process_cmdline {

    my %cmdl_opts;	
    my (@ilist, @flist, @alist, @Alist, @Nlist); 

    #print "\nThe commandline was:\n";
    #foreach (@ARGV){
    #  print "\"$_\" "; 
    #}
    #print "\n"; 

    my @opts_spec = 
	(
	 "op|t=s",  # operation 
	 
	 # host properties
	 "myinterfaces|f=s" => \@flist,  # interface 
	 "myhostname|H=s",  # localhost name
	 "myphyip|I=s",  # ip address of the local host 
	 "myvirtips|i=s" => \@ilist,  # addresses 
	 
	 # overlay properties 
	 "prefix|p=s",  # prefix for the entire network 
	 "ovlmgr|O=s",  # name of the overlay manager 
	 "ovlmgrport|P=s",  # control port of the OM 
	 
	 # global peroperties 
	 "allvirtips|a=s" => \@alist,  # other virtual addresses within the network 
	 "ovlname|d=s",  # name of the overlay 
	 "allphyhostnames|N=s" => \@Nlist,  # names of physical hosts in the network 
	 "allphyips|A=s" => \@Alist,  # ip addresses of other hosts in the network 
    ); 
    
    
    if (GetOptions(\%cmdl_opts, @opts_spec)==0) { 
	print "Usage: vserver-script.pl [<option>]\n";
	print "The following options are supported\n";
	foreach my $opt (@opts_spec){
	  if (ref($opt) !~ /(ARRAY|HASH)/){
	    $opt =~ s/=s/ = <value>/;
	    print "\t$opt\n";
	  }
	}

	die("Command line could not be processed"); 
    }
    

    $cmdl_opts{"allphyhostnames"} = \@Nlist;
    $cmdl_opts{"allphyips"}= \@Alist; 
    $cmdl_opts{"allvirtips"}= \@alist; 
    $cmdl_opts{"myinterfaces"}= \@flist; 
    $cmdl_opts{"myvirtips"}= \@ilist; 
    
    #print Dumper(\%cmdl_opts); 

    return \%cmdl_opts; 
}

####################################################
#
# main..
#
####################################################

my $cmds = process_cmdline(); 
$ENV{"PATH"} = "/bin:/usr/bin:/usr/sbin"; 

eval { 
  my $op = ${$cmds}{"op"}; 
  if ($op !~ /verify/){
    if ($op !~ /conf/){
      $cmds = do_load_config(); 
    } else {
      do_save_config($cmds); 
    }
  }

  SWITCH: for ($op) { 

      # verify is run as nobody. so we cannot do anything privileged like logging.  
      /verify/ and do { last SWITCH; };

      /conf/ and do { note($cmds, "conf"); do_conf($cmds); note($cmds, "conf done"); last SWITCH; };
      /run/ and do { note($cmds, "run"); do_run($cmds); note($cmds, "run done"); last SWITCH; };
      /pid/ and do { note($cmds, "pid"); note($cmds, "pid done"); last SWITCH; };
      /kill/ and do { note($cmds, "kill"); do_kill($cmds); note($cmds, "kill done"); last SWITCH; };
      /cleanup/ and do { note($cmds, "cleanup"); do_cleanup($cmds); note($cmds, "cleanup done"); last SWITCH; };

      # install and deinstall are use in this experiment
      /install/ and do { note($cmds, "install"); note($cmds, "install done"); last SWITCH; }; 
      /deinstall/ and do { note($cmds, "deinstall"); note($cmds, "deinstall done");last SWITCH; };
      
      # default 
      note($cmds, "Unknown input:" . $op); 
  }
}; 

if ($@) {
    note($cmds, "ERROR : $@"); 
    exit(1); 
}

exit 0;