### Local Variables: ***
### mode:perl ***
### comment-column:0 ***
### comment-start: "### " ***
### comment-end: "***" ***
### End: ***
#
# ****************DO NOT MOVE OR CHANGE LINES ABOVE THIS*********************
#
# The first set of lines runs perl from any shell. The second set of lines 
# identifies the rest of the file as PERL for EMACS autoformatting. 
# See end of copyright for more information.
#
# 
# -------------------------------------------------------------------
#                                   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: XB_Zebra.pm,v $
#
# $Revision: 1.15 $
#   $Author: pingali $
#     $Date: 2005/03/31 07:04:01 $
#    $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Runfang Zhou
# Description: Functions for manuplating Zebra ripd configure file

package XB_Zebra;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(zebra_control check_interface add_interface 
                get_config delete_interface);

use strict;
use Tie::File;
use Data::Dumper;

use XB_Log; 
use XB_Params;
use XB_Utils;

my $modname = "XB_Zebra::";

###############################################################################
# GENERIC EXPORTED API 
###############################################################################

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

# Description:
# 	Get differnt Zebra configure file for different address type 
# Arguments:
#       $add_type  XBone address type, now support  "ipv4" or "ipv6" 
# Returns:
#	ripd_conf_file   if "ipv4" 
#	ripngd_conf_file if "ipv6" 
#       undef,  other
# Exceptions:
#	"XB_Zebra::get_config" on error, nothing to clean up by caller
sub get_config($) {
  my $addr_type = shift;
  my $config = "";
  my $procname = "get_config";

  # print trace line
  XB_Log::log "info", "-> $modname$procname $addr_type";

  if ($addr_type eq "ipv4") {
    $config = $XB_Params::node_opts{zebra_dir}."/ripd.conf";
  } elsif ($addr_type eq "ipv6") {
    $config = $XB_Params::node_opts{zebra_dir}."/ripngd.conf";
  } else {
    XB_Log::log "err", "Unknown address_type $addr_type"; 
  }

  # print trace line
  XB_Log::log "info", "<- $modname$procname ";

  return ($config) unless ($config eq "");

  # pass defined exceptions up to caller
  die "$modname$procname";
}

# Description: 
# 	Start, stop or restart zebra and ripd if their
# 	configure files exits
# Arguments:
#	$command  start, stop or restart
# Returns:
#	1 if successful
#	0 if not
# Exceptions:
#	"XB_Zebra::zebra_control" on error, nothing to clean up by caller
sub zebra_control ($) {

  my $command = shift;
  my $procname = "zebra_control";

  # print trace line
  XB_Log::log "info", "-> $modname$procname $command";
  
  eval {

    # XXX This hardcoded path should be removed
    my @cmd = ("/usr/local/xbone/programs/modules/zebractl", 
		$XB_Params::node_opts{zebra_dir}, $command);
    XB_Log::log "debug3", "@cmd";
    my $rc = 0xff & system (@cmd);
    ($rc == 0) or XB_Log::log "err", "@cmd failed: $!"
	and die "$command";
  };

  # print trace line
  XB_Log::log "info", "<- $modname$procname ";

  return 1 unless $@;
  unless ($@ =~ /^($command)/) {
    #unknown exception caught, log and pass up a defined one
      XB_Log::log "warning","caught unexpected exception $@";
  }
  # pass defined exceptions up to caller
  die "$modname$procname";
}

# Description:
# 	Check interface is already in configure file
# Arguments:
#	$conf_file   configure file
#	$interface
# Returns:
#	1 or 0
# Exception:
#	XB_Zebra::check_interface on error, nothing to clean up by caller
sub check_interface ($$) {
  
  my ($conf_file, $interface) = @_;
  my $line;
  my $configured = 0;
  my $procname = "check_interface";

  # print trace line
  XB_Log::log "info", "-> $modname$procname $conf_file $interface";
  
  eval {
    open (FD, $conf_file) or XB_Log::log "err", "open $conf_file failed: $!"
        and die "open";
    # check every line of the configure file 
    while ($line = <FD>) {
      if ($line =~ /network\s+$interface/) {
	XB_Log::log "debug1", "interface already configured!";
	$configured = 1;
	last;
      }
    }
    close (FD) or XB_Log::log "err", "close $conf_file failed: $!"
      and die "close";
  };

  # print trace line
  XB_Log::log "info", "<- $modname$procname";
  
  return $configured unless $@;
  unless ($@ =~ /^(open|close)/) {
    #unknown exception caught, log and pass up a defined one
    XB_Log::log "warning", "caught unexpected exception $@";
  }
  # pass defined exceptions up to caller
  die "$modname$procname";
}
 
# Description:
# 	Add interface to configure file
# Argument:
#	$conf_file   configure file 
#       $interface   interface name
#       $prefix	     network prefix	 	  
#	$overlay     overlay name 	
# Returns:
#       1 or 0 
# Exception:
#       XB_Zebra::add_interface on error, nothing to clean up by caller
sub add_interface ($) {

  my $inputhash = shift @_;
  my $procname = "add_interface";
  my @array;
  my $tag = 0;
  my $empty = 1;
  
  my $conf_file = $inputhash->{conf_file};
  my $interface = $inputhash->{net_if};
  my $prefix = $inputhash->{prefix};
  my $overlay = $inputhash->{ovlname};
  my $interfacenum = $#{$interface}+1;
  my $addr_type = $inputhash->{addr_type};
  
  # print trace line
  XB_Log::log "info", "-> $modname$procname $inputhash";
 
  XB_Log::log "debug1", "conf_file= $conf_file, interface = $interface->[0],
  prefix = $prefix, overlay= $overlay, interfacenum = $interfacenum 
  addr_type = $addr_type";
	  
  eval {
    XB_Log::log "debug1",Dumper($inputhash);
    $addr_type="" if ($addr_type eq "ipv4");
    tie @array, 'Tie::File', $conf_file or die "tie";
    for (my $i=0; $i<@array; $i++) {
      if (($i+1 == $#array)&& ($empty)) {
        # if nothing there
	for (my $j=0; $j<$interfacenum; $j++) {
          $array[$i].= "\nnetwork $interface->[$j]";
	}  
	$array[$i].= "\n\n";
	for (my $j=0; $j<$interfacenum;$j++) {
	  $array[$i].= "\nno passive-interface $interface->[$j]";
	}
	$array[$i].="\n\n";
	for (my $j=0; $j<$interfacenum; $j++) {
	  $array[$i].= "\ndistribute-list $overlay in $interface->[$j]";
	  $array[$i].= "\ndistribute-list $overlay out $interface->[$j]";
	}
	$array[$i].= "\n\n$addr_type access-list $overlay permit $prefix";
	$array[$i].= "\n$addr_type access-list $overlay deny any";
        last;
      }
      
      if ($array[$i] =~ /^$/) {
	# this is an empty line 
	next;
      }

      if ($array[$i] =~ /^(!)/){
      # if it is a comment line, start a new iteration 
        next;
      }	elsif ($array[$i] =~ /network/ && $array[$i+1] !~ /network/){
	 $empty = 0;
	for (my $j=0; $j<$interfacenum; $j++) {
           $array[$i].= "\nnetwork $interface->[$j]";
	}  
      } elsif ($array[$i] =~ /passive-interface/ && $array[$i+1] !~ 
        /passive-interface/) {
	for (my $j=0; $j<$interfacenum; $j++) {
	   $array[$i].= "\nno passive-interface $interface->[$j]";
	}  
      } elsif ($array[$i] =~ /distribute-list/) {
      	if (($tag != 1) &&($array[$i] =~ /$overlay\s+out/)){
	  for (my $j=0; $j<$interfacenum; $j++) {
	    $array[$i].= "\ndistribute-list $overlay in $interface->[$j]";
	    $array[$i].= "\ndistribute-list $overlay out $interface->[$j]";
	  }  
	  $tag = 1;
	}
	if (($tag != 1) && $array[$i+1] !~ /distribute-list/ &&
	$array[$i+1] !~ /^(!)/) {
	  for (my $j=0; $j<$interfacenum; $j++) {
	    $array[$i].= "\ndistribute-list $overlay in $interface->[$j]";
	    $array[$i].= "\ndistribute-list $overlay out $interface->[$j]";
	  }
	  $tag = 1;	
	}
      } elsif ($array[$i] =~ /access-list/) {
        if ($array[$i] =~ /$overlay\s+permit\s+$prefix/){
	  last;
	} elsif ($array[$i+1] !~ /access-list/){
	  $array[$i].= "\n$addr_type access-list $overlay permit $prefix";
	  $array[$i].= "\n$addr_type access-list $overlay deny any";
	  last;
	}
      }
    }       
    untie @array or die "untie";
  };

  #print trace line
  XB_Log::log "info", "<-$modname$procname"; 
  
  return 1 unless $@; 
  unless ($@ =~ /^(tie|untie)/) {
    #unknown exception caught, log and pass up a defined one
    XB_Log::log "warning", "caught unexpected exception $@";
  }
  #pass defined exceptions up to caller
  die "$modname$procname";
}

# Description:
#	Delete the interfaces from rip configure file
# Arguments:
#	$inputhash
# Returns:
#       1 on success
# Exceptions:
#	"XB_Zebra::delete_interface" on error, nothing to clean up by caller
sub delete_interface ($) {

  my $inputhash = shift @_;
  my $procname = "delete_interface";
  my $conf_file = $inputhash->{conf_file};
  my $interface = $inputhash->{net_if};
  my $prefix = $inputhash->{prefix};
  my $overlay = $inputhash->{ovlname} ;
  my $interfacenum = $#{$interface}+1;
  my @array;
  
  # print trace line
  XB_Log::log "info", "->$modname$procname $inputhash";
  
  XB_Log::log "debug1", "conf_file=$conf_file, interface= $interface->[0],
  prefix=$prefix, overlay=$overlay, interfacenum = $interfacenum";
  
  eval {
    XB_Log::log "debug1", "inputhash=".+Dumper($inputhash);
    tie @array, 'Tie::File', $conf_file or die "tie";
    for (my $i=0; $i<@array; $i++) {
      if ($array[$i] =~ /^(!)/) {
       next;
      }
      if ($array[$i] =~ /^$/){
        splice @array, $i, 1;
	$i--;
	next;
      }	
      if ($array[$i] =~ /network\s+(\w+\d+)/){
	my $if = $1;
	for (my $j=0; $j<$interfacenum; $j++){
	  if ($if eq $interface->[$j]){
            splice @array, $i, 1;
	    $i--;
	    last;
	  }
	}  
      }
      
      elsif ($array[$i] =~ /passive-interface\s+(\w+\d+)/) {
	my $if =$1;
	for (my $j=0; $j<$interfacenum; $j++) {
	  if ($if eq $interface->[$j]){
	    splice @array, $i, 1;
	    $i--;
	    last;
	  }
	}  
      }
      
      elsif ($array[$i] =~ /distribute-list\s+$overlay/) {
        splice @array, $i, 1;
	$i--;
      }

      elsif ($array[$i] =~ /access-list\s+$overlay/) {
        splice @array, $i, 1;
	$i--;
      } 	
    }
    untie @array or die "untie";
  };

  # print trace line
  XB_Log::log "info", "<-$modname$procname";
  
  return 1 unless $@;
  unless ($@ =~ /^(tie|untie)/) {
    #unknown exception caught, log and pass up a defined one
    XB_Log::log "err", "caught unexpected exception $@";
  }
  #pass defined exceptions up to caller
  die "$modname$procname";
}

1;