### 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_VN_Graph.pm,v $
#
# $Revision: 1.5 $
#   $Author: pingali $
#     $Date: 2005/03/31 07:04:00 $
#    $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Greg Finn
#                 Yu-Shun Wang
# Description:    Functions to compute static routes for any given topology
#                 using Perl Graph module

package XB_VN_Graph;

require Exporter;
@ISA       = qw(Exporter);
@EXPORT    = qw();
@EXPORT_OK = qw(compute_routes);

use strict;
use sigtrap;

use FindBin;
use Data::Dumper;

#use Graph::Base;
use Graph;
use Graph::Undirected;

use XB_Log;

my $modname = "XB_VN_Graph::";

###############################################################################
# UTILITY FUNCTIONS
###############################################################################


# Description: 
#     Returns the number of interfaces that node has within the 'nodes'
#     hash pointed to by nodeshptr. It is assumed that the nodes hash
#     is properly constructed. It must have a node property and, in turn,
#     that value have an 'interfaces'operty.
# Arguments:
#     -
# Returns:
#     -
# Exceptions:
#     -
sub XB_node_interfaces ($$){
  my ($node, $nodeshptr) = @_;
  my ($nodehptr, $ifshptr, $ifcount);

  $nodehptr = $nodeshptr->{$node};
  $ifshptr = $nodehptr->{interfaces};
  $ifcount = keys (%$ifshptr);

  return ($ifcount);
}


# Description:
#     Returns the number of interfaces associated with the 'nodes' hash
#     pointed to by nodeshptr. It is assumed that the nodes hash is
#     properly constructed. It must have a node property and, in turn,
#     that value have an 'interfaces' property.
# Arguments:
#     -
# Returns:
#     -
# Exceptions:
#     -
sub XB_net_interfaces ($$){
  my ($nodeshptr) = @_;
  my ($node, $nodehptr, $ifshptr, $ifcount);

  $ifcount = 0;

  foreach $node (keys (%$nodeshptr))
    {
      $nodehptr = $nodeshptr->{$node};
      $ifshptr = $nodehptr->{interfaces};
      $ifcount += keys (%$ifshptr);
    };

  return ($ifcount);
}


# Description:
#     Returns a list of vertices in Graph object netgraph minus basenode.
# Arguments:
#     -
# Returns:
#     -
# Exceptions:
#     -
sub XB_other_vertices ($$){
  my ($basenode, $netgraph) = @_;
  my (@V, $ix, $vertex);

  @V = $netgraph->vertices;

  $ix = 0;
  foreach $vertex (@V){
    if ($basenode eq $vertex){
      splice (@V, $ix, 1);
      last;
    }
    $ix++;
  }

  return (\@V);
}


# Description:
#     Generates the next-hop destinations for a routing table for node
#     basenode in the network represented by the Graph object netgraph.
#     The Dijkstra shortest-path algorithm is used. Returns a pointer
#     to a hash, whose keys are next-hop node names. If that hash has
#     only one key, basenode is acting as a simple host in this network.
#     Otherwise, basenode acts as a router.  A key's associated value is
#     a string of nodes " a0 a1 ... an".
# Arguments:
#     -
# Returns:
#     -
# Exceptions:
#     -
sub XB_generate_next_hops ($$)
{
  my ($basenode, $netgraph) = @_;
  my (@V, $spgraph, $node, @path, %nxthops);

  %nxthops = ();

  #######################################
  # Shortest path algorithm is expensive.
  # Call it for routers only.
  #######################################

  if ($netgraph->out_degree($basenode) == 1){
      my ($vertices, $vertex, $router);

      $vertices = XB_other_vertices ($basenode, $netgraph);

      @V = $netgraph->neighbors($basenode);
      $router = shift (@V);

      foreach $vertex (@$vertices)
      { $nxthops{$router} .= " $vertex"; };
  }else{
      # shortest-paths from basenode
      $spgraph = $netgraph->SSSP_Dijkstra ($basenode);
      ###################################
      # Get next hop for each node in net
      ###################################

      foreach $node ($netgraph->vertices){
	  if ($node eq $basenode)	      # Loopback is of no interest
	    { next; }
	  else
	    {
	      @path = $spgraph->get_attribute ('path', $node);
	      $nxthops{$path[0][1]} .= " $node";
	    };
	};
      };

  return (\%nxthops);
}


# Description:
#     nodeshptr points to the 'nodes' hash within the 'main_overlay' body
#     that comprises a network. ipnet is a Netaddr::IP object. It is assumed
#     that that object has sufficient addresses in its masked region to
#     assign an address to each interface in the network. Addresses are
#     assigned from bottom of range upwards by incrementation. Upon return,
#     the 'interfaces' keys for each node will have a value that is their
#     assigned address.
# Arguments:
#     -
# Returns:
#     -
# Exceptions:
#     -
sub XB_assign_addresses ($$)
{
  my ($nodeshptr, $ipnet) = @_;
  my ($node, $nodehptr, $iface, $ifshptr, $ipaddr);

  my ($iface_array);

  foreach $node (keys (%$nodeshptr))
    {
      $nodehptr = $nodeshptr->{$node};
      $ifshptr = $nodehptr->{interfaces};
      $iface_array = $nodehptr->{interfaces};

      foreach $iface (@{$iface_array})
      {
        $ipaddr = $ipnet++;
        $iface->{address} = $ipaddr->addr;
        #$ifshptr->{$iface} = $ipaddr->addr;
        #print "iface >>> ", Dumper($iface), "\n";
      };
    };
}

# Description: 
#       -
# Arguments:
#       -
# Returns:
#       - 
# Exceptions:
#       - 
#


###############################################################################
# EXPORTED API
###############################################################################


# Description:
#     [VN] Compute static routes for each node of a given topology
#          specified in an XBone overlay object
# Arguments:
#     $ovl      (ref) hash of an overlay object
#     $alg      algorithm for shortest routes (not yet)
# Returns:
#     1 on success
# Exceptions:
#     -
#
sub compute_routes($){

  my ($ovl) = @_;
  my $procname = "compute_routes";

  XB_Log::log "info", "-> $modname$procname $ovl";

  my ($linkshptr, @links, $link, $graph, $nodeshptr, @nodes, $node,
      @vertices, $routeshptr, $nodehptr);

  eval{

    #-> create a Graph object that represents the network
    #   assume all links have equal weight of one unit
    $graph = new Graph::Undirected;

    $linkshptr = $ovl->{links};  # Get the links hash
    @links = keys (%$linkshptr);     # and the individual link hashes within it
    foreach $link (@links){
      unless($linkshptr->{$link}{type} eq "host"){
        $graph->add_weighted_edge ($linkshptr->{$link}->{right_node}, 1,
                                   $linkshptr->{$link}->{left_node} );
      }
    }

    #-> for each node, find shortest paths to all other nodes in the graph
    $nodeshptr = $ovl->{nodes};
    @nodes = keys (%$nodeshptr);

    foreach $node (@nodes){
      unless($nodeshptr->{$node}{properties}{type} eq "host"){
        #my ($nexthop, @nexthops, @destinations);
        $routeshptr = XB_generate_next_hops ($node, $graph); 
        # install 'routes' into the hash for this node
        $nodehptr = $nodeshptr->{$node};
        #$nodehptr->{routes} = [];
        $nodehptr->{routes} = ();

        foreach my $nexthop (keys (%$routeshptr)){
          $_ = $routeshptr->{$nexthop};
          my @destinations = split;
          my %rh;
          $rh{destinations} = \@destinations;
          #push (@{$nodehptr->{routes}}, [ $nexthop, [@destinations] ]);
          #push @{$nodehptr->{routes}}, \%rh;
          $nodehptr->{routes}{$nexthop} = \%rh;
        }
      }
    }

    $_ = Dumper ($ovl->{nodes});
    #print "\n\nResulting nodes:\n\n$_\n\n";
  };
  XB_Log::log "info", "<- $modname$procname";
  return 1 unless $@;
  unless($@ =~ /\S+/){ # probably won't ever die, but you never know
    XB_Log::log "warning", "   ! $procname caught unknown exception: $@";
  }
  die "$modname$procname";
}


1;