#!/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-destroy.pl,v $
#
# $Revision: 1.17 $
# $Author: pingali $
# $Date: 2005/04/10 01:26:55 $
# $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Lars Eggert
use strict;
use sigtrap;
my $arch;
BEGIN {
use Config;
my $osvers = $Config{osvers};
$osvers =~ s/(\d+\.\d+).*/$1/;
$arch = "$Config{archname}-$osvers";
};
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_Common;
use XB_XML_Interface;
use XB_XML_GUI;
use XB_XML_scan;
use Data::Dumper;
XB_XML_Interface::init();
####################################################
# Example message.
####################################################
my $canned_destroy_overlay_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>
<destroy_overlay_reply>
<property prop=\"overlay_name\" value=\"testnet\"/>
</destroy_overlay_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-destroy.pl";
my $indexurl = "/cgi-bin/xb-xml-index.pl";
####################################################
# make sure that the manager is defined.
###################################################
if (not defined param("manager")){
XB_XML_Interface::show_error "Please specify a manager", "", $indexurl;
}
####################################################
# Construct the user info. it will handy later on.
###################################################
my %user = XB_XML_Interface::user_info();
######################################
# Generate API destroy overlay message
######################################
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} = $userid;
$hash{user_name} = $user{Name};
$hash{user_email} = $user{Email};
$cmdref = XB_XML_GUI::XB_build_destroy_overlay_msg (\%hash);
}
else
{
my %hash = ();
$hash{auth_type} = $authtype;
$hash{user_id} = $userid;
$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 =~ s/XBoneEOC//g;
#$result = $canned_list_overlays_reply;
#########################################
# parse the result of communication with the
# OM. This will be useful for
# - initial gathering of the overlays
# - destroy 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" .
"<a href=\"http://www.isi.edu/xbone\">" .
"X-Bone Support</a>", "", $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")) {
# show the default page with the overlays.
# 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 $host = `uname -n`;
chomp($host);
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/destroy-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 .= " <destroy>\n";
foreach my $ovl (@overlays) {
$msg .= " <ovlname>$ovl</ovlname>\n";
}
$msg .= " </destroy>\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 destory failed!", $errmsg, $myurl;
}
# if not error, make sure the message is a create message.
if (not defined $hashresult->{command}{destroy_overlay_reply}){
XB_XML_Interface::show_error "Dont know how to parse the OM reply!", "", $myurl;
}
$section = "Overlay delete operation successful!";
XB_XML_Interface::show_success($section, "", $myurl);
1;
syntax highlighted by Code2HTML, v. 0.9.1