#!/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-create-dynabone.pl,v $
#
# $Revision: 1.10 $
# $Author: pingali $
# $Date: 2005/03/31 07:04:02 $
# $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Lars Eggert
use strict;
use sigtrap;
use lib qw(../lib);
use CGI qw(:standard :html3);
use CGI::Carp qw(fatalsToBrowser);
#####################################
# Bring in the associated API files.
# Bring in the precompiled RecDescent
# parser for the API grammar, create
# an instance of the parser.
#####################################
use Data::Dumper; # Needed only for debugging
use XB_Defs;
use XB_Interface;
use XB_Common;
use XB_API_GUI;
my @os = qw(freebsd linux solaris netbsd);
my %aalgl = ( "undef" => "(None)", "md5" => "MD5", "sha1" => "SHA1" );
my %ealgl = ( "undef" => "(None)", "des" => "DES", "3des" => "3DES" );
my %appll = ( none => "(None)",
anetd => "Active Nets Daemon",
squid => "Squid Web Cache" );
my %nnamesl = ( topology => "Topology-dependent",
colors => "Color Names",
countries => "Country Names",
planets => "Planet Names",
cities => "City Names" );
my %osl = map {
$_ => " " . $XB_Defs::NODEOS_LABEL{$_}
} @XB_Defs::ALLOWED_NODEOS;
my @dn_bw_u = qw(bit Kbit Mbit byte Kbyte Mbyte);
my %dn_bw_ul = (bit => "b/s", Kbit => "Kb/s", Mbit => "Mb/s",
byte => "B/s", Kbyte => "KB/s", Mbyte => "MB/s");
my @dn_q_u = qw(packet byte);
my %dn_q_ul = (packet => "Packets", byte => "Bytes");
my %topsl = ( star => "Star", ring => "Ring", linear => "Linear",
# stag => "Staggered",
# tree => "Spanning Tree"
);
my $topt;
my @top = sort { $a cmp $b } keys %topsl;
while($#top > -1) {
my $row;
for(my $i = 1; $i <= 3; $i++) {
my $item = shift @top;
$row .= td({-class => "bottom"},
$item ? (img({-src => "/images/$item.gif", -height => 50,
-alt => $topsl{$item}, -width => 100}), br,
$topsl{$item}) : " ");
}
$topt .= Tr($row);
}
# get xbone dns suffix from defs, make sure it starts with a dot
my $suffix = $XB_Defs::XBONE_NET;
if($suffix !~ /^\./) { $suffix = ".$suffix"; }
my %default = ( name => "",
mcast_radius => 5,
topology => "star",
dns => 1,
dyn_routing => 0,
app => 0,
app_script => "",
innerlay => 3,
hosts => 1,
host_os => "freebsd",
routers => 1,
router_os => "freebsd",
# dns_dom => $suffix,
ah => "undef",
esp => "undef",
# naming => "topology",
inner_script => "",
outer_script => "",
dn_delay => 100,
dn_bw => 10,
dn_bw_u => "mbit",
dn_q => 100,
dn_q_u => "byte",
dn_plr => 0);
my @missing_params;
my @test_param = param;
my %used_param = map { $_ => 1 } param;
foreach my $v (keys %default) {
if($v ne "dns" and $v ne "app" and $v ne "dyn_routing" and
$v ne "dn_bw_u" and $v ne "dn_plr" and $v ne "esp" and $v ne "ah" and
$v ne "app_script" and $v ne "dn_q_u" and $v ne "dn_bw" and
$v ne "dn_q" and $v ne "dn_delay" and
not exists $used_param{$v}) { push @missing_params, $v; }
}
if($#missing_params == -1)
{
my ($h, $r, $t) = (param("hosts"), param("routers"), param("topology"));
my $dyn_rtn;
# check if user selected correct host/router numbers for topology type
if($t eq "star")
{
# star must have one router
if($r != 1)
{
fail_page "Invalid Star Topology",
p("Must have exactly one router in a star, you specified $r.");
}
}
elsif ($t eq "ring")
{
# ring must have >= 3 routers
if($r < 3)
{
fail_page "Invalid Ring Topology",
p("Must have at least three routers in a ring, you specified " .
$r . ".");
}
}
elsif ($t eq "linear")
{
# line must have two end hosts
if($h < 2)
{
fail_page "Invalid Line Topology",
p("Must have atleast two end hosts in a line, you specified " .
$h . ".");
}
# Not more than two end hosts if zero routers.
if($r == 0 && $h > 2)
{
fail_page "Invalid Line Topology",
p("Can't have more than two hosts in a line without routers, " .
"you specified $h.");
}
}
else
{
# unsupported topology
fail_page "Unsupported Topology",
p("The only topologies currently supported are: ") .
ul(li([map { $topsl{$_} } qw(star ring linear)])) .
p("You picked: ". $topsl{$t});
}
# Temporary check for invalid overlay names
if (param("name") !~ /^[a-z]([a-z0-9\-]*[a-z0-9])?$/i)
{
# This is an invalid DNS name.
fail_page "Invalid Overlay Name",
p("The overlay name \"".param("name") .
"\" is not a well-formed DNS name.");
}
# Dynamic Routing
if (defined param("dyn_routing") && param("dyn_routing") == 1)
{ $dyn_rtn = "1"; }
else
{ $dyn_rtn = "0"; }
#============================================================================
# Dynabone Hack:
# Replace the key values in the template with the new values and loop
# thruogh the number of innerlays specified to create them.
#============================================================================
# HTNO: number of hosts
# RTRNO: number of routers
# INAME: innerlay base name
# INO: innerlay number
# TOPO: topology
# FILE: application deployment script
# file://home/yushunwa/xbone/apps/innerlay
# file://home/yushunwa/xbone/apps/outerlay
my $dynabone_template =
"( xbone 1.5 2.0 ".
" (create_overlay ".
" (auth_type x509) ".
" (creator_name 'CNAME') ".
" (creator_email CMAIL) ".
" (two_phase no) ".
" (dns yes) ".
" (hosts HTNO) ".
" (host_os kame|cairn|freebsd) ".
" (authentication none) ".
" (encryption none) ".
" (dynamic_routing no) ".
" (overlay_name INAME-INO.xbone.net) ".
" (routers RTRNO) ".
" (router_os kame|cairn|freebsd) ".
" (search_radius 5) ".
" (topology TOPO) ".
" (user_id CMAIL) ".
" (program ".
" (xol ".
" (overlay (name INAME-INO.xbone.net) ".
" (addresstype ipv4 ) ".
" (security (creator_name 'CNAME') ".
" (creator_email CMAIL) ".
" (authentication none) ".
" (encryption none) ".
" ) ".
" (services (manager www.xbone.net) ".
" (name_server dns1.xbone.net) ".
" (applications ".
" (application URL FILE) ".
" ) ".
" ) ".
" (interfaces (INAME-INO.xbone.net0)) ".
" (topology ".
" (hosts ".
" (_hst_0_ (interfaces (_hst_0_0)) ".
" (os kame|cairn|freebsd) ) ".
" (_hst_1_ (interfaces (_hst_1_0)) ".
" (os kame|cairn|freebsd) ) ".
" ) ".
" (routers ".
" (_rtr_0_ (interfaces (_rtr_0_0)(_rtr_0_1)) ".
" (os kame|cairn|freebsd) ) ".
" (_rtr_1_ (interfaces (_rtr_1_0)(_rtr_1_1)) ".
" (os kame|cairn|freebsd) ) ".
" ) ".
" (links (link0) (link1) (link2)) ".
" (netlist (link0 _rtr_0_:_rtr_0_1 _rtr_1_:_rtr_1_1) ".
" (link1 _hst_0_:_hst_0_0 _rtr_0_:_rtr_0_0) ".
" (link2 _hst_1_:_hst_1_0 _rtr_1_:_rtr_1_0) ".
" ) ".
" ) ".
" ) ".
" ) ".
" ) ".
" ) ".
") ".
"XboneEOC";
# HTNO: number of hosts
# RTRNO: number of routers
# INAME: innerlay base name
# INO: innerlay number
# TOPO: topology
# FILE: application deployment script
my $ilay_script = "file://home/yushunwa/xbone/apps/innerlay";
my $olay_script = "file://home/yushunwa/xbone/apps/outerlay";
my @cookies;
foreach my $v (keys %default){
push @cookies, cookie(-name => $v, -expires => "+1y",
-value => [param($v)], -path => "/cgi-bin/");
}
# Move the below part inside for.
#
print header("-cookie" => \@cookies),
start_html(-title => "DynaBone Overlay Creation: Return Status",
-style => { -src =>"/xbone.css" }
),
h1("Dynabone Create Results");
my $total = param('innerlay');
my $iscript = param('inner_script');
my $oscript = param('outer_script');
my $cname = param('c_name');
my $cmail = param('c_mail');
for (my $i = 1; $i < $total+1; $i++) {
my $new_cmd = $dynabone_template;
my $oname = param("name");
# Replace the keywords in the template with values:
$new_cmd =~ s/HTNO/$h/g;
$new_cmd =~ s/RTRNO/$r/g;
$new_cmd =~ s/INAME/$oname/g;
$new_cmd =~ s/INO/$i/g;
$new_cmd =~ s/TOPO/$t/g;
$new_cmd =~ s/CNAME/$cname/g;
$new_cmd =~ s/CMAIL/$cmail/g;
if($i < $total){
if($iscript){
$new_cmd =~ s/FILE/$iscript/g;
}else{
$new_cmd =~ s/FILE/$ilay_script/g;
}
}else{
if($oscript){
$new_cmd =~ s/FILE/$oscript/g;
}else{
$new_cmd =~ s/FILE/$olay_script/g;
}
}
# Call my interface to the overlay manager
my $result = XB_Interface::OverlayManagerInterface ($new_cmd);
my $section = XB_Interface::parse_result_short($result);
print $section, p;
STDOUT->autoflush(1);
}
print p("Back to the ", a({-href => "/"}, "main X-Bone page") . ".");
print end_html;
} else {
# init state from 1. CGI param, 2. cookie, 3. defaults
my @cookies;
foreach my $v (keys %default) {
if($v ne "name" and not exists $used_param{$v}) {
# we have no CGI param of that name, try to init from cookie
if(cookie($v)) { param(-name => $v, -value => [cookie($v)]); }
else { param(-name => $v, -value => [$default{$v}]); }
}
# while we're at it, also create a cookie to pass back
push @cookies, cookie(-name => $v, -expires => "+1y",
-value => [param($v)], -path => "/cgi-bin/");
}
# these override any cookie state
param(-name => "c_name", -value => $ENV{SSL_CLIENT_S_DN_CN});
param(-name => "c_mail", -value => $ENV{SSL_CLIENT_S_DN_Email});
# the os vars can have IPsec flavors of OS in them, reset those to
# plain names
foreach my $v (qw(host_os router_os)) {
my %os;
foreach my $s (param($v)) {
if($s =~ /^(kame|cairn|freebsd)$/) { $os{freebsd} = 1; }
elsif($s =~ /^(linux|nist)$/) { $os{linux} = 1; }
elsif($s =~ /^(solaris)$/) { $os{solaris} = 1; }
}
param(-name => $v, -value => [keys %os]);
}
print header("-cookie" => \@cookies),
start_html(-title => "DynaBone Overlay Creation",
-style => { -src =>"/xbone.css" } ),
h1("DynaBone Overlay Creation"), user_info,
p("This page allows you to create a new overlay. Please fill out " .
span({-class => "redbg"}, "all remaining red fields") . "."),
start_form(-method => "POST", -action => "/cgi-bin/xb-create-dynabone.pl"),
table(
hidden(-name => "c_name"), hidden(-name => "c_mail"),
Tr(th({-colspan => 3}, "Overlay-Wide Properties")),
Tr(my_th("name", "Name"),
td(textfield(-name => "name")),
td("Name of the new overlay. ".
"Suffix \"$suffix\" will be added automatically. ".
"If \"use DNS\" is checked below, ".
"the overlay name will also become part of the DNS names ".
"of your overlay nodes.")),
Tr(th("DNS"),
td(checkbox(-name => "dns", -label => " use DNS", -value => 1)),
# popup_menu(-name => "dns_dom", -value => [$suffix])),
td("If you check \"use ".
"DNS\", the overlay manager will assign DNS names in the ".
"OM's domain to the nodes of the new overlay. ".
"If unchecked, no DNS entries are ".
"created, and you will need to use IP ".
"addresses directly to reach overlay nodes.")),
# Tr(th("Node Naming"),
# td(popup_menu(-name => "naming", -value => [keys %nnamesl],
# -labels => \%nnamesl)),
# td("If \"use DNS\" is checked above, nodes in the new " .
# "overlay will be assigned names from the chosen set of ".
# "name candidates. If \"use DNS\" is unchecked, this ".
# "option has no effect.",
# p(#{-class => "redbg"},
# i("Currently unsupported, selection has no effect.")))),
Tr(my_th("mcast_radius", "Search Radius"),
td(textfield(-name => "mcast_radius")),
td("Multicast search radius limiting the region in which " .
"the overlay manager " .
"will look for X-Bone hosts willing to participate in " .
"setting up the new overlay.")),
Tr(th("Topology"),
td(popup_menu(-name => "topology", -value => [keys %topsl],
-labels => \%topsl)),
td(p("These topologies are available for new overlays:",
table($topt) #,
# p(#{-class => "redbg"},
# i("\"Staggered\" and \"Spanning Tree\" topologies ".
# "are currently unsupported."))
))),
Tr(th("Number of Parallel Overlay Transits"),
td(textfield(-name => "innerlay")),
td("Number of parallel overlay transit (\"<b>Innerlays</b>\") ".
"under the upper overlay (\"<b>Outerlay</b>\"). ")),
Tr(th("Innerlay Script <BR>[URL]"),
td( textfield(-name => "inner_script")),
td("Script to prepare the innerlay IP addresses for constructing ".
"the BARP table. Specify the complete URL, e.x. http://, ".
" file://, or (anonymous) ftp://." )),
Tr(th("Outerlay Script <BR>[URL]"),
td( textfield(-name => "outer_script")),
td("Script to construct the BARP table and create the outerlay. ".
"Specify the complete URL, e.x. http://, file://, or ".
"(anonymous) ftp://." )),
Tr(td(br, br)),
Tr(th({-colspan => 3}, "Host Properties")),
Tr(my_th("hosts", "Number of Hosts"),
td(textfield(-name => "hosts")),
td("Number of hosts in the overlay. (Hosts are overlay " .
"nodes that do not route packets.)")),
Tr(my_th("host_os", "Host Operating System"),
td(checkbox_group(-name => "host_os", -linebreak => 1,
-labels => \%osl, -value => \@os)),
td("Operating system requirements for the hosts. Only ".
"hosts of the checked operating systems will be picked ".
"for the new overlay.")),
Tr(td(br, br)),
Tr(th({-colspan => 3}, "Router Properties")),
Tr(my_th("routers", "Number of Routers"),
td(textfield(-name => "routers")),
td("Number of routers in the overlay. (Routers are overlay " .
"nodes that route packets.)")),
Tr(my_th("router_os", "Router Operating System"),
td(checkbox_group(-name => "router_os", -linebreak => 1,
-labels => \%osl, -value => \@os)),
td("Operating system requirements for the routers. Only ".
"routers of the checked operating systems will be picked ".
"for the new overlay.")),
Tr(td(br, br))),
submit({-class => "black", -value => "Create This Overlay"}),
" ", CGI::reset({-class => "black"}, "Undo Changes"),
p({-class => "small"},
"A cookie with the above information will be created.", br,
"It will be used to initialize the form when you revisit ".
"this page."), end_form,
p("Back to the ",
a({-href => "/"}, "main X-Bone page") . "."),
end_html;
}
syntax highlighted by Code2HTML, v. 0.9.1