#!/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: xb-xml-status.pl,v $
#
# $Revision: 1.18 $
#   $Author: pingali $
#     $Date: 2005/04/10 01:26:56 $
#    $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Lars Eggert

use strict;
use sigtrap;

use CGI qw(:standard :html3);
use CGI::Carp qw(fatalsToBrowser);

# set library search path
BEGIN {
  use strict;
  use sigtrap;
  use FindBin;
  use Config; 
  delete $ENV{PATH};

  my $version = $Config{'version'}; 
  my $arch = $Config{'archname'}; 
  #my $ldir = $FindBin::RealBin;
  my $ldir = "/usr/local/www/xbone/s-cgi-bin"; 
  foreach my $p ($ldir, 
		 "$ldir/../lib", 
                 "$ldir/../cpan",
                 "$ldir/../cpan/lib/perl5/$version",
                 "$ldir/../cpan/lib/perl5/$version/$arch",
                 "$ldir/../cpan/lib/perl5/site_perl/mach",
                 "$ldir/../cpan/lib/perl5/site_perl/mach/$arch",
                 "$ldir/../cpan/lib/perl5/site_perl/$version",
                 "$ldir/../cpan/lib/perl5/site_perl/$version/$arch",
                 "$ldir/../cpan/lib/perl5/site_perl/$version/mach",
                 "$ldir/../cpan/lib/perl5/site_perl/$version/mach/$arch",
                ) {
    if(-d $p) { unshift @INC, $p; }
  }

  # untaint the resulting include path so "use" works
  foreach my $i (@INC) { if($i =~ /(.*)/) { $i = $1;} }
};


use XB_XML_Interface;
use XB_XML_GUI;
use XB_XML_scan;

use Data::Dumper;

my $host = `uname -n`; 
chomp($host); 

XB_XML_Interface::init(); 

####################################################
# Example message.
####################################################
my $canned_overlay_status_reply =
'<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE xbone SYSTEM "http://www.isi.edu/xbone/software/xbone/api-1.0.dtd">
<xbone version="" release="">
    <command>
        <overlay_status_reply>
            <property  prop="overlay_name"  value="aaaa.xbone.overlay"/>
            <property  prop="dns"  value="yes"/>
            <property  prop="routing"  value="static"/>
            <property  prop="IPsec_encryption"  value="none"/>
            <property  prop="IPsec_authentication"  value="none"/>
            <node>
                <property  prop="status"  value="up"/>
                <property  prop="ip"  value="128.9.112.69"/>
                <property  prop="class"  value="simple"/>
                <property  prop="type"  value="router"/>
                <property  prop="hostname"  value="e.postel.org"/>
                <property  prop="os"  value="freebsd"/>
                <property  prop="vname"  value="router_0"/>
                <tunnel>
                    <property  prop="remote_ip_address"  value="172.26.0.14"/>
                    <property  prop="status"  value="up"/>
                    <property  prop="local_ip_address"  value="172.26.0.13"/>
                </tunnel>
                <tunnel>
                    <property  prop="remote_ip_address"  value="172.26.0.10"/>
                    <property  prop="status"  value="up"/>
                    <property  prop="local_ip_address"  value="172.26.0.9"/>
                </tunnel>
            </node>
            <node>
                <property  prop="status"  value="up"/>
                <property  prop="ip"  value="128.9.160.31"/>
                <property  prop="class"  value="simple"/>
                <property  prop="type"  value="host"/>
                <property  prop="hostname"  value="tlc.isi.edu"/>
                <property  prop="os"  value="freebsd"/>
                <property  prop="vname"  value="host_0"/>
                <tunnel>
                    <property  prop="remote_ip_address"  value="172.26.0.13"/>
                    <property  prop="status"  value="up"/>
                    <property  prop="local_ip_address"  value="172.26.0.14"/>
                </tunnel>
            </node>
            <node>
                <property  prop="status"  value="up"/>
                <property  prop="ip"  value="128.9.112.68"/>
                <property  prop="class"  value="simple"/>
                <property  prop="type"  value="host"/>
                <property  prop="hostname"  value="d.postel.org"/>
                <property  prop="os"  value="freebsd"/>
                <property  prop="vname"  value="host_1"/>
                <tunnel>
                    <property  prop="remote_ip_address"  value="172.26.0.9"/>
                    <property  prop="status"  value="up"/>
                    <property  prop="local_ip_address"  value="172.26.0.10"/>
                </tunnel>

            </node>
        </overlay_status_reply>
    </command>
</xbone>';

my $canned_list_overlays_reply =
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<!DOCTYPE xbone SYSTEM \"http://www.isi.edu/xbone/software/xbone/api-1.0.dtd\">
<xbone version=\"\" release=\"\">
    <command>
        <list_overlays_reply>
            <property  prop=\"overlay_name\"  value=\"mango apple banana\"/>
        </list_overlays_reply>
    </command>
</xbone>";

my $myurl ="/cgi-bin/xb-xml-status.pl";
my $indexurl ="/cgi-bin/xb-xml-index.pl";

# make sure that the manager is selected
if (not defined param("manager")){
  XB_XML_Interface::show_error("Please specify the overlay manager.", "", $indexurl);
}


####################################################
# Construct the user info. it will handy later on.
###################################################

my %user = XB_XML_Interface::user_info();


######################################
# Generate API overlay status query
######################################


my ($cmdref, $userid, $authtype, $result, $section);

if (CGI::https())
  {  
    $userid = $ENV{SSL_CLIENT_EMAILADDRESS};  
    $authtype = 'x509';  
  }
else
  { 
    # shouldnt come here in the first place. 
    $userid = $ENV{REMOTE_ADDR};  
    $authtype = 'ipaddr';  
  };

if (defined (param ('XboneOverlayName')))
  {
    my %hash = ();
    $hash{auth_type} =  $authtype;
    $hash{overlay_name} = param ('XboneOverlayName');
    $hash{user_id} = $user{Email};
    $hash{user_name} = $user{Name};
    $hash{user_email} = $user{Email};
    $cmdref = XB_XML_GUI::XB_build_overlay_status_msg (\%hash);
  }
else
  {
    my %hash = ();
    $hash{auth_type} =  $authtype;
    $hash{user_id} = $user{Email};
    $hash{user_name} = $user{Name};
    $hash{user_email} = $user{Email};
    $cmdref = XB_XML_GUI::XB_build_list_overlays_msg ( \%hash);
  };

$result = XB_XML_Interface::OverlayManagerInterface
                                 (param("manager"), $$cmdref);

#$result = $canned_list_overlays_reply;
#$result = $canned_overlay_status_reply;

$result =~ s/XBoneEOC//g;


#########################################
# parse the result of communication with the
# OM. This will be useful for
#   - initial gathering of the overlays
#   - status command reply
#########################################

# the result is an XML message. parse it to see if it fine.
my $parseresult = XB_XML_scan::XB_XML_parse (\$result);
if ( $parseresult ne "")
  {
    XB_XML_Interface::show_error ("Error while parsing the reply of the OM", $parseresult, $myurl );
  };


# construct a hash to simplify the processing later on.
my $hashresult = XB_XML_scan::XB_XML_hash (\$result);

# Check to make sure that the the parser was able to parse the
# message.
if (! $hashresult) {
  XB_XML_Interface::show_error "Invalid response from the Overlay Manager. Please contact" .
	       "&lt;a href=\"http://www.isi.edu/xbone\"&gt;" .
	       "X-Bone Support&lt;/a&gt;", "", $myurl;
}

# fix the properties list
XB_XML_scan::XB_XOL_xbone_list_sub ($hashresult);

# test the hash
if (!$hashresult or ! $hashresult->{command}){
  XB_XML_Interface::show_error "Reply from OM could not be parsed.", "", $myurl;
}

if(not defined param("XboneOverlayName")) {

  # see if this is an error. If so, show an error.
  if (defined $hashresult->{command}{error_reply}){
    my $errmsg = $hashresult->{command}{error_reply}{property}{error};
    XB_XML_Interface::show_error 
	"Overlay destroy - Error while retrieving overlay list!",  
	  $errmsg, $indexurl;
  }

  my $overlaylist =
    $hashresult->{command}{list_overlays_reply}{argstring}[0]{value};

  if (not defined $overlaylist){ $overlaylist = ""; }

  my @overlays = split (' ', $overlaylist);

  my $msg = "content-type: text/xml\n\n";
  $msg .= "<?xml version=\"1.0\"?>\n";
  $msg .= "<?xml-stylesheet type=\"text/xsl\" " .
    "href=\"/xml/status-xsl.xml\"?>\n";
  $msg .= "<overlay>\n";
  $msg .= "  <user>\n";
  $msg .= "    <name> $user{User} </name>\n";
  $msg .= "    <location>$user{Location}</location>\n";
  $msg .= "    <org>$user{Organization}</org>\n";
  $msg .= "  </user>\n";
  $msg .= "   <manager>" . param("manager"). "</manager>\n";
  $msg .= "  <overlay_status>\n";
  foreach my $ovl (@overlays) {
    $msg .= "   <ovlname>$ovl</ovlname>\n";
  }
  $msg .= "  </overlay_status>\n";
  $msg .= "<host>$host</host>\n"; 
  $msg .= "</overlay>\n";
  print $msg;
  exit;
};


# see if this is an error. If so, show an error.
if (defined $hashresult->{command}{error_reply}){
  my $errmsg = $hashresult->{command}{error_reply}{property}{error};
  XB_XML_Interface::show_error "Overlay status failed!",  $errmsg, $myurl;
}

# if not error, make sure the message is a create message.
if (not defined $hashresult->{command}{overlay_status_reply}){
  XB_XML_Interface::show_error "Dont know how to parse the OM reply!", "", $myurl;
}

########################################################################
# Construct the output message.
# This is really messy. Basically extracting the content of the XML
# message returned into an internal structure and using the internal
# structure to generate a simple xml message that can be dumped on the
# screen.
########################################################################

my $msg = "content-type: text/xml\n\n";
$msg .= "<?xml version=\"1.0\"?>\n";
$msg .= "<?xml-stylesheet type=\"text/xsl\" href=\"/xml/status-reply-xsl.xml\"?>\n";
$msg .= "<overlay>\n";

# user properties. Ignore the values returned from the reply.
$msg .= "<user>\n";
$msg .= "<name> $user{User} </name>\n";
$msg .= "<location>$user{Location}</location>\n";
$msg .= "<org>$user{Organization}</org>\n";
$msg .= "</user>\n";
$msg .= "   <manager>" . param("manager"). "</manager>\n";

# saves code
my $temp = $hashresult->{command}{overlay_status_reply};


$msg .= "<overlay_status_reply>\n";

#high level properties applicable to the entire overlay.
foreach my $prop (keys %{$temp->{property}}){
  $msg .= "   <$prop>" .
           $temp->{property}{$prop} .
            "</$prop>\n";
}

$msg .=   "   <nodes>\n";
foreach my $node (@{$temp->{node}}){

  # process nodes - one at a time. print the high level properties of
  # the node followed by tunnel details.
  $msg .=    "      <node>\n";
  foreach my $prop (keys %{$node->{property}}){
     $msg .= "         <$prop>";
     $msg .= $node->{property}{$prop};
     $msg .= "</$prop>\n";
  }

  foreach my $tun (@{$node->{tunnel}}){
    $msg .=   "          <tunnel>\n";
    foreach my $prop (keys %{$tun->{property}}){
      $msg .= "              <$prop>" .
              $tun->{property}{$prop} .
              "</$prop>\n";
    }
    $msg .=   "          </tunnel>\n";
  }
  $msg .=    "      </node>\n";
}
$msg .= "    </nodes>\n";
$msg .= "</overlay_status_reply>\n";
$msg .= "<host>$host</host>\n"; 
$msg .= "</overlay>\n";
print $msg;

1;