# -*- perl -*-
#
# DO NOT MOVE THE FIRST LINE
# It identifies the rest of the file as PERL for EMACS autoformatting
# put perl options at the end of that line, e.g., -p
#
#
# -------------------------------------------------------------------
# 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_CTL_parser.pm,v $
#
# $Revision: 1.26 $
# $Author: pingali $
# $Date: 2005/03/31 07:03:53 $
# $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Yu-Shun Wang
# Description:
# This is the parser generator for the XBone Control Protocol messages.
package XB_CTL_parser;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(xb_ctl_grammar parser);
use strict;
#use Net::IP;
use Parse::RecDescent;
use Data::Dumper;
$Data::Dumper::Indent = 1;
# TODO Order of some fields should not matter, need to relax them.
# TODO some msgs need credential, some don't; have no way to check yet
#=> set it for standalone testing
$XB_CTL_parser::standalone = 0;
#=> debugging variables
$::RD_ERRORS = undef; # undefined implies no error printing
$::RD_HINT = 1; # the next four decarations for debugging
$::RD_WARN = 1;
#$::RD_TRACE = 1;
#=> define the grammar
# TODO add (node $nodename) to all ACK-* messages, easier to debug!
$XB_CTL_parser::xb_ctl_grammar = <<'GRAMMAR_RULES';
<autotree>
xb_ctl :
'(' /(xbonecontrol|xbone-ctl)/ /\S+/ /\S+/ seq(?) credential(?) command ')'
END_OF_CTL
{
my %ctl = ();
$ctl{version} = $item[3];
$ctl{release} = $item[4];
$ctl{sequence} = $item[5];
$ctl{credential} = $item[6];
$ctl{command} = $item{command};
$return = \%ctl;
}
seq : /\d+/ { $return = $item[1]; }
credential : '(' 'credential' username useremail authtype ')'
{
my %credential = ();
$credential{user_name} = $item{username};
$credential{user_email} = $item{useremail};
$credential{auth_type} = $item{authtype};
$return = \%credential;
}
command : simple_cmd { $return = $item[1]; } |
invite { $return = $item[1]; } |
ack_invite { $return = $item[1]; } |
select { $return = $item[1]; } |
dispatch { $return = $item[1]; } |
ack_dispatch { $return = $item[1]; } |
config { $return = $item[1]; } |
ack_status { $return = $item[1]; } |
refresh { $return = $item[1]; } |
discover { $return = $item[1]; } |
ack_disc { $return = $item[1]; } |
addr_req { $return = $item[1]; } |
error { $return = $item[1]; }
simple_cmd : '(' /(ack-(select|config|stop)|stop|status|release)/
app_type app_name level nodename(?) ')'
{
my %cmd = ();
$cmd{command} = $item[2];
$cmd{app_type} = $item{app_type};
$cmd{app_name} = $item{app_name};
$cmd{level} = $item{level};
$cmd{hostname} = $item[6];
if(@{$cmd{hostname}} == 1){
$cmd{hostname} = $cmd{hostname}[0];
}else{
delete $cmd{hostname};
}
$return = \%cmd;
}
invite : '(' 'invite' app_type app_name app_vers level routing ipsec_opt
qos_opt addr_type node_req(3) app_deploy(s?) ')'
{
my %cmd = ();
$cmd{command} = $item[2];
$cmd{app_type} = $item{app_type};
$cmd{app_name} = $item{app_name};
$cmd{app_vers} = $item{app_vers};
$cmd{level} = $item{level};
$cmd{routing} = $item{routing};
$cmd{ipsec} = $item{ipsec_opt};
$cmd{qos} = $item{qos_opt};
$cmd{addr_type} = $item{addr_type};
my $nodes = $item[11];
for my $n (@{$nodes}){
unless (exists $cmd{$n->{type}}){
$cmd{$n->{type}}=$n;
delete $cmd{$n->{type}}->{type};
}else{
#error die!
}
}
for my $h (@{$item[12]}){
while(my ($k, $v) = each %{$h}){
$cmd{app_deploy}{$k} = $v;
}
}
$return = \%cmd;
}
ack_invite : '(' 'ack-invite' app_type app_name app_vers level nodetype
nodename addr_type ctl_addr app_addr any_pair(s)
app_deploy(s?) ')'
{
my %cmd = ();
$cmd{command} = 'ack-invite';
$cmd{app_type} = $item{app_type};
$cmd{app_name} = $item{app_name};
$cmd{app_vers} = $item{app_vers};
$cmd{level} = $item{level};
$cmd{node_type} = $item{nodetype};
$cmd{hostname} = $item{nodename};
$cmd{addr_type} = $item{addr_type};
$cmd{ctl_addr} = $item{ctl_addr};
$cmd{app_addr} = $item{app_addr};
my $arr = $item[12];
my ($k, $v);
for my $h (@{$arr}){ while(($k, $v) = each %{$h}){ $cmd{$k} = $v; }}
for my $h (@{$item[13]}){
while(my ($k, $v) = each %{$h}){
$cmd{app_deploy}{$k} = $v;
}
}
$return = \%cmd;
}
select : '(' 'select' app_type app_name level connection nodetype(?) ')'
{
my %cmd = ();
$cmd{command} = 'select';
$cmd{app_type} = $item{app_type};
$cmd{app_name} = $item{app_name};
$cmd{level} = $item{level};
$cmd{persistent_connection} = $item{connection};
$cmd{node_type} = $item[7];
$return = \%cmd;
}
dispatch : '(' 'dispatch' app_type app_name app_vers level retry
connection app_cmd ')'
{
my %cmd = ();
$cmd{command} = $item[2];
$cmd{app_type} = $item{app_type};
$cmd{app_name} = $item{app_name};
$cmd{app_vers} = $item{app_vers};
$cmd{level} = $item{level};
$cmd{retry} = $item{retry};
$cmd{application} = $item{app_cmd};
$return = \%cmd;
}
ack_dispatch : '(' 'ack-dispatch' app_type app_name level addr_range(s?)
exp_iface(s?) ')'
{
my %cmd = ();
$cmd{command} = 'ack-dispatch';
$cmd{app_type} = $item{app_type};
$cmd{app_name} = $item{app_name};
$cmd{level} = $item{level};
$cmd{addr_range} = $item[6];
my $export_ifs = $item[7];
for my $i (@{$export_ifs}){
while (my ($k, $v) = each %{$i}){ $cmd{export_ifs}{$k} = $v; }
}
$return = \%cmd;
}
config : '(' 'config' app_type app_name app_vers level node_cmds(s) ')'
{
my %cmd = ();
$cmd{command} = $item[2];
$cmd{app_type} = $item{app_type};
$cmd{app_name} = $item{app_name};
$cmd{app_vers} = $item{app_vers};
$cmd{level} = $item{level};
my (%ncmds, $k, $v);
my $ncmd_array = $item[7];
for my $n (@{$ncmd_array}){
while (($k, $v) = each %{$n}){ $ncmds{$k} = $v; }
}
$cmd{node_cmds} = \%ncmds;
$return = \%cmd;
}
ack_status : '(' 'ack-status' app_type app_name level nodename node_state(s)
')'
{
my %cmd = ();
$cmd{command} = $item[2];
$cmd{app_type} = $item{app_type};
$cmd{app_name} = $item{app_name};
$cmd{level} = $item{level};
my (%ncmds, $k, $v);
my $ncmd_array = $item[7];
for my $n (@{$ncmd_array}){
while (($k, $v) = each %{$n}){ $ncmds{$k} = $v; }
}
$cmd{vnodes} = \%ncmds;
$return = \%cmd;
}
error : '(' 'error' command app_type app_name level msg ')'
{
my %cmd;
$cmd{command} = 'error';
$cmd{err_cmd} = $item{command};
$cmd{app_type} = $item{app_type};
$cmd{app_name} = $item{app_name};
$cmd{level} = $item{level};
$cmd{message} = $item{msg};
$return = \%cmd;
}
refresh : '(' 'refresh' any_pair(s) ')'
{
my %cmd;
$cmd{command} = 'refresh';
$cmd{applist} = $item[3];
$return = \%cmd;
}
discover : '(' 'discover' ')'
{ my %cmd = ('command'=>'discover'); $return = \%cmd; }
ack_disc : '(' 'ack-discover' any_pair(s) ')'
{
my %cmd = ();
$cmd{command} = 'ack-discover';
my $arr = $item[3];
my ($k, $v);
for my $h (@{$arr}){ while(($k, $v) = each %{$h}){ $cmd{$k} = $v; }}
$return = \%cmd;
}
addr_req : '(' /address_(request|reply|release)/ app_type app_name
level nodename addr_blk(s) ')'
{
my %cmd;
$cmd{command} = $item[2];
$cmd{app_type} = $item{app_type};
$cmd{app_name} = $item{app_name};
$cmd{level} = $item{level};
$cmd{hostname} = $item{nodename};
my $addr_blks = $item[7];
for my $a (@{$addr_blks}){
for my $k (keys %{$a}){
$cmd{blocks}{$k} = $a->{$k};
}
}
$return = \%cmd;
}
#- credential -------------------------------------------------------------
username : '(' 'user_name' STRING ')' { $return = $item[3]; }
useremail : '(' 'user_email' STRING ')' { $return = $item[3]; }
authtype : '(' 'auth_type' STRING ')' { $return = $item[3]; }
#- common -----------------------------------------------------------------
addr_blk : '(' 'addr-blk' STRING addr_type size(?) addr_range(?) ')'
{
my %cmd;
my $name = $item[3];
$cmd{$name}{addr_type} = $item{addr_type};
my $size = $item[5];
my $blk = $item[6];
if(defined $size && @{$size} == 1){
$cmd{$name}{size} = shift @{$size};
}
if(defined $blk && @{$blk} == 1){
$cmd{$name}{block} = shift @{$blk};
}
$return = \%cmd;
}
addr_pair : '(' /(netaddr|linkaddr|physical)/ ip_addr ip_addr netmask(?)
ipsec(?) qos(?) ')'
{
my %addrpair;
my $type = $item[2];
$addrpair{$type}{local} = $item[3];
$addrpair{$type}{remote} = $item[4];
#$addrpair{$type}{netmask} = $item[5];
if(@{$item[5]} == 1){
if(${$item[5]}[0] =~ /(up|down)/i){
$addrpair{$type}{status} = ${$item[5]}[0];
}else{
$addrpair{$type}{netmask} = ${$item[5]}[0];
}
}
$addrpair{$type}{ipsec} = $item[6];
if(@{$addrpair{$type}{ipsec}} > 0){
$addrpair{$type}{ipsec} = $addrpair{$type}{ipsec}[0];
}else{
delete $addrpair{$type}{ipsec};
}
$addrpair{$type}{qos} = $item[7];
if(@{$addrpair{$type}{qos}} > 0){
$addrpair{$type}{qos} = $addrpair{$type}{qos}[0];
}else{
delete $addrpair{$type}{qos};
}
my $return = \%addrpair;
}
addr_range : '(' 'addr_range' STRING ')' { $return = $item[3]; }
addr_type : '(' 'addr_type' STRING ')' { $return = $item[3]; }
any_pair : '(' STRING STRING ')'
{
my %cmd;
$cmd{$item[2]} = $item[3];
$return = \%cmd;
}
app_addr : '(' 'app_addr' ip_addr ')' { $return = $item[3]; }
app_cmd : STRING { $return = $item[1]; }
app_deploy : '(' 'app-deploy' app_name any_pair(s?) ')'
{
my %cmd;
my $name = $item{app_name};
for my $h (@{$item[4]}){
while(my ($k, $v) = each %{$h}){
if($k =~ /\b(url|chksum|suid|app_verify|action)\b/){
$cmd{$name}{$k} = $v;
}else{
die 'parser';
}
}
}
$return = \%cmd;
}
app_name : '(' 'name' STRING ')' { $return = $item[3]; }
app_type : '(' /app(lication|)/ STRING ')' {$return= $item[3]; }
app_vers : '(' 'version' STRING ')' { $return = $item[3]; }
attr_list : '(' attributes STRING(s) ')'
{
my %cmd;
$cmd{$item[2]} = $item[3];
$return = \%cmd;
}
attributes : /((all_|)(virtual|base)_(ip|hostname)|domain|prefix|om|api)/
{ $return = $item[1]; }
command : '(' 'command' STRING ')' { $return = $item[3]; }
ctl_addr : '(' 'ctl_addr' ip_addr ')' { $return = $item[3]; }
exp_iface : '(' 'export_if' STRING STRING STRING ')'
{
my %h = ();
my $i = $item[3];
$h{$i}{hostname} = $item[4];
$h{$i}{phy_ip} = $item[5];
$return = \%h;
}
ipsec : '(' /ipsec/i STRING ipsec_dir(2) ')'
{
my %ipsec;
$ipsec{spi} = $item[3];
for my $d (@{$item[4]}){
my ($k, $v) = each %{$d};
$ipsec{$k} = $v;
}
$return = \%ipsec;
}
ipsec_key : '(' /(auth|encr)/i STRING STRING ')'
{
my %key;
$key{type} = $item[2];
$key{alg} = $item[3];
$key{key} = $item[4];
$return = \%key;
}
ipsec_dir : '(' /(forward|reverse)/i ipsec_key(..2) ')'
{
my %key;
my $dir = $item[2];
my $arr = $item[3];
for my $k (@{$arr}){
$key{$dir}{$k->{type}}{alg} = $k->{alg};
$key{$dir}{$k->{type}}{key} = $k->{key};
}
$return = \%key;
}
ipsec_opt : '(' /ipsec/i /(yes|no)/i ')' { $return = $item[3]; }
qos : '(' /qos/i qos_args(..4) ')'
{
my %qos;
for my $key (@{$item[3]}){
$qos{$key->{name}}{value} = $key->{value};
if (defined $key->{unit}){
$qos{$key->{name}}{unit} = $key->{unit};
} else {
$qos{$key->{name}}{unit} = "";
}
}
$return = \%qos;
}
qos_args : '(' /(delay|bandwidth|queue|loss_rate)/i STRING STRING(?) ')'
{
my %key;
$key{name} = $item[2];
$key{value} = $item[3];
$key{unit} = ${$item[4]}[0];
$return = \%key;
}
level : '(' 'level' /\d+/ ')' { $return = $item[3]; }
link_cmd : '(' STRING tag addr_pair addr_pair addr_pair ')'
{
my %link;
my $name = $item[2];
my ($h1, $h2, $h3) = ($item[4], $item[5], $item[6]);
for my $h ($h1, $h2, $h3){
while(my ($k, $v) = each %{$h}){ $link{$name}{$k} = $v; }
}
$link{$name}{interface} = $item[3];
$link{$name}{link_up} = 0;
$link{$name}{net_up} = 0;
$return = \%link;
}
link_sec : '(' 'link' link_cmd(s) ')'
{
my $link_array = $item[3];
my %cmd;
my ($k, $v);
for my $l (@{$link_array}){
while(($k, $v) = each %{$l}){ $cmd{$k} = $v; }
}
$return = \%cmd;
}
msg : '(' 'message' STRING ')' { $return = $item[3]; }
node_cmds : '(' 'nodecommand' STRING addr_type link_sec route_sec
app_deploy(s?) ovl_params(?) ')'
{
my %cmd = ();
my $vnode = $item[3];
$cmd{$vnode}{ipproto} = $item[4];
$cmd{$vnode}{links} = $item[5];
$cmd{$vnode}{routes} = $item[6];
for my $h (@{$item[7]}){
while(my ($k, $v) = each %{$h}){
$cmd{$vnode}{app_deploy}{$k} = $v;
}
}
for my $o (@{$item[8]}){ $cmd{$vnode}{ovl_params} = $o; }
$return = \%cmd;
}
node_req : '(' /(host|router|meta)/ /\d+/ STRING ')'
{
my %node = ();
$node{type} = $item[2];
$node{count} = $item[3];
my @os = split /\|/, lc($item[4]);
$node{platform} = \@os;
$return = \%node;
}
node_state : '(' 'vnode' STRING link_sec ')'
{
my %cmd;
$cmd{$item[3]} = $item[4];
$return = \%cmd;
}
nodename : '(' 'hostname' STRING ')' { $return = $item[3]; }
nodetype : '(' 'type' /(host|router|node|both|meta)/i ')'
{ $return = $item[3]; }
ovl_params : '(' 'ovl-parameters' attr_list(s) ')'
{
my %cmd;
for my $h (@{$item[3]}){
for my $k (keys %{$h}){
$cmd{$k} = $h->{$k};
}
}
$return = \%cmd;
}
retry : '(' 'retry' /\d+/ ')' { $return = $item[3]; }
route_cmd : '(' /(host|net)/ ip_addr ip_addr netmask(?) ')'
{
my %rt;
$rt{type} = $item[2];
$rt{dst} = $item[3];
$rt{gw} = $item[4];
$rt{mask} = $item[5];
$rt{up} = 0;
$return = \%rt;
}
route_sec : '(' 'route' /(static|dynamic)/ route_cmd(s?) addr_range(s?) ')'
{
my %rt;
$rt{style} = $item[3];
$rt{routes} = $item[4];
$rt{prefixes} = $item[5];
$return = \%rt;
}
routing : '(' 'routing' /(dynamic|static|1|0|yes|no)/i ')'
{ $return = $item[3]; }
prop : '(' /(routing|IPsec|qos_opt|dns|NODEOS|os_vers|kern_vers)/
STRING ')'
{
my %cmd;
$cmd{$item[2]} = $item[3];
$return = \%cmd;
}
size : '(' 'size' /\d+/ ')' { $return = $item[3]; }
tag : '(' 'interface' STRING ')' { $return = $item[3]; }
# =====================================================================
qos_opt : '(' 'qos' /(yes|no|1|0)/i ')' { $return = $item[3]; }
connection : '(' 'persistent_connection' /(yes|no)/i ')'
{ $return = $item[3]; }
ip_addr : STRING # TODO match/check both IPv4 and IPv6 address formats
{ $return = $item[1]; }
netmask : # TODO should match to netmask format for IPv4 and IPv6
STRING { $return = $item[1]; }
STRING : # a more general definition than /\S+/
/"[^"]+"/ { $item[1] =~ s/"//g; $return = $item[1]; } |
/'[^']+'/ { $item[1] =~ s/'//g; $return = $item[1]; } |
/[^()\s]+/ { $return = $item[1]; }
END_OF_CTL: /\Z/ { $return = $item[1]; }
GRAMMAR_RULES
#=> create a parser file
#Parse::RecDescent->Precompile ($XB_CTL_parser::xb_ctl_grammar,
# "XB_CTL_parser") or die "Bad grammar.";
#exit (1);
#=> create a parser object
$XB_CTL_parser::parser = new Parse::RecDescent($XB_CTL_parser::xb_ctl_grammar);
if($XB_CTL_parser::standalone){
my $ctl_parser = new Parse::RecDescent ($XB_CTL_parser::xb_ctl_grammar)
or die "Bad grammar";
#print ">>>> parser: >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>\n";
#print Dumper($parser);
#print "<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n";
my ($result, $invite, $ack_invite, $select, $ack_select, $release);
my ($stop, $ack_stop, $dispatch, $ack_dispatch, $config, $ack_config);
my ($err_msg, $status, $refresh, $ack_status, $discover, $ack_discover);
my ($new_err, $addr_req, $addr_rep, $addr_rel);
my $current = time;
$invite =
"(xbone-ctl 1.5 2.3 $current\n".
" (credential (user_name 'Yu-Shun Wang')\n".
" (user_email yushunwa\@isi.edu)\n".
" (auth_type x509))\n".
" (invite (application overlay)\n".
" (name touch.overlay.xbone)\n".
" (version 1.5)\n".
" (level 0)\n".
" (routing dynamic)\n".
" (IPsec yes)\n".
" (qos no)\n".
" (addr_type ipv4)\n".
" (host 25 FreeBSD|Solaris)\n".
" (router 30 MacOSX)\n".
" (meta 5 any)\n".
" (app-deploy\n".
" (name test-app)\n".
" (url http://www.isi.edu/xbone/script/test-app)\n".
" (chksum f513efde682155380cca2b09976aa65b)\n".
" (suid root))\n".
" (app-deploy\n".
" (name app2)\n".
" (url http://www.isi.edu/test-app2))\n".
" )\n".
")";
$ack_invite =
"(xbone-ctl 1.5 2.5 $current\n".
" (ack-invite\n".
" (app overlay)\n".
" (name line.overlay.net)\n".
" (version 1.6)\n".
" (level 0)\n".
" (type meta)\n".
" (hostname add.isi.edu)\n".
" (addr_type ipv6)\n".
" (ctl_addr 128.9.160.213)\n".
" (app_addr 128.9.160.222)\n".
" (os FreeBSD)\n".
" (kernel 500001)\n".
" (os_ver 5.1-current)\n".
" (app-deploy (name test-app)\n".
" (app_verify ok))\n".
" )\n".
")\n";
$select = "
(xbonecontrol 1.5 2.5
(select (application overlay)
(name bigO.xbone.overlay)
(level 3)(persistent_connection yes)))";
$ack_select =
"(xbone-ctl 1.5 2.5\n".
" (ack-select\n".
" (application overlay)\n".
" (name small.overlay.net)\n".
" (level 0)\n".
" )\n".
")";
$release = "
(xbonecontrol 1.5 2.5
(release (application overlay)
(name big.overlay.network)
(level 2)))";
$stop = "
(xbonecontrol 1.5 2.5
(stop (application overlay)
(name big.overlay.network)
(level 2)))";
$ack_stop = "
(xbone-ctl 1.5 2.5
(ack-stop (application overlay)
(name small.overlay.net)(level 0)
(hostname tnn.yahoo.com)
)
)";
$dispatch = "
(xbonecontrol 1.5 2.3 $current
(credential (user_name 'Yu-Shun Wang')
(user_email yushunwa\@isi.edu)
(auth_type x509))
(dispatch (application overlay)
(name touch.overlay.xbone)
(version 1.5)
(level 0)
(retry 3)
\"(create_overlay (search_radius 5)
(xol 1.4
(class star
(netprops (IPsec_authentication none) (dns yes)
(dynamic_routing no) (IPsec_encryption none)
(addr_type ipv4) )
(nodelist (node host_0
(nodeprops (os freebsd|kame) )
(interfaces (interface if_0) )
)
(node host_1
(nodeprops (os freebsd|kame) )
(interfaces (interface if_0) )
)
(node router_0
(nodeprops (os linux|kame) )
(interfaces (interface if_0) (interface if_1) )
) )
(linklist (link link_0) (link link_1) )
(netlist (host_0.if_0 link_0 router_0.if_0)
(host_1.if_0 link_1 router_0.if_1) )
(exportlist )
)
(root star test.xbone.net)
)
)\"
)
)";
$ack_dispatch = "
(xbonecontrol 1.5 2.5
(ack-dispatch (application overlay)(name small.overlay.net)(level 0)
(addr_range 10.194.0.0/24)
(addr_range 10.185.0.0/24)
(export_if someif1 amc.isi.edu 128.9.160.170)
(export_if someif2 ifc.isi.edu 128.9.160.180)
(export_if someif3 rfc.isi.edu 128.9.111.222)
))";
$config =
"(xbone-ctl 1.5 2.3\n".
" (credential\n".
" (user_name 'Yu-Shun Wang')\n".
" (user_email yushunwa\@isi.edu)\n".
" (auth_type x509))\n".
" (config\n".
" (application overlay)\n".
" (name touch.overlay.xbone)\n".
" (version 1.5)\n".
" (level 0)\n".
" (nodecommand vnode1\n".
" (addr_type ipv6)\n".
" (link\n".
" (rlink_1\n".
" (interface if1)\n".
" (netaddr 10.1.2.38 10.1.2.37 255.255.255.252)\n".
" (linkaddr 10.7.2.38 10.7.2.37 255.255.255.252)\n".
" (physical router_2 router_1))\n".
" (rlink_2\n".
" (interface if2)\n".
" (netaddr 10.1.2.2 10.1.2.1 255.255.255.252)\n".
" (linkaddr 10.7.2.2 10.7.2.1 255.255.255.252\n".
" (ipsec 0x12204570498\n".
" (forward (auth md5 0x1122334455)\n".
" (encr 3des 0x2b2b9c3bd1))\n".
" (reverse (auth md5 0x1122334455)\n".
" (encr 3des 0x2b2b9c3bd1)))\n".
" (qos\n".
" (delay 100)\n".
" (bandwidth 10 Kbit/s)\n".
" (queue 21 slots)\n".
" (loss_rate 0.3)\n".
" )\n".
" )\n".
" (physical router_2 router_3))\n".
" )\n".
" (route dynamic\n".
" (addr_range 10.194.0.0/24)\n".
" (addr_range 10.185.0.0/24)\n".
" )\n".
" (app-deploy\n".
" (name app-test1)\n".
" (action start))\n".
" (app-deploy\n".
" (name app-test2)\n".
" (action install))\n".
" (ovl-parameters\n".
" (virtual_ip 10.2.3.4 10.5.6.7)\n".
" (base_ip 128.9.160.102)\n".
" (virtual_hostname tnn.line.ovl.net)\n".
" (base_hostname tnn.isi.edu)\n".
" (all_virtual_ip 10.1.1.1 10.2.2.2 10.3.3.3 10.4.4.4)\n".
" (all_base_ip 11.11.11.11 11.22.22.22 11.33.33.33 11.4.4.4)\n".
" (all_virtual_hostname a.ovl.net b.ovl.net c.ovl.net)\n".
" (all_base_hostname tnn.isi.edu amc.usc.edu nik.yahoo.com)\n".
" (domain line.ovl.net)\n".
" (prefix 10.2.3.0/24 10.3.3.0/24 fec3:1::0/32 fec4:2::0/32/)\n".
" (om 128.9.168.57)\n".
" (api 2156)\n".
" )\n".
" )\n".
" )\n".
")";
$ack_config =
"(xbone-ctl 1.5 2.5\n".
" (ack-config\n".
" (application overlay)\n".
" (name small.overlay.net)\n".
" (level 0)\n".
" (hostname amc.yahoo.com)\n".
" )\n".
")";
$err_msg =
"(xbone-ctl 1.5 2.5\n".
" (error\n".
" (command config)\n".
" (application overlay)\n".
" (name m1.xbone.net)\n".
" (level 0)\n".
" (message \"bluh bluh < > ;alkdj;aldj\")\n".
" )\n".
")";
$new_err = "
(xbone-ctl 1.9 2.9
(error
(command stop)
(application overlay)
(name m1.xbone.net)
(level 0)
(message \"[tcp_ssl_sock] create ssl socket to add.isi.edu:5165 failed:\") )
)
\n";
$status =
"(xbone-ctl 1.5 2.4\n".
" (status\n".
" (application overlay)\n".
" (name small.overlay.net)\n".
" (level 0)\n".
" )\n".
")";
$ack_status =
"(xbone-ctl 1.5 2.3\n".
" (ack-status\n".
" (application overlay)\n".
" (name touch.overlay.xbone)\n".
" (level 0)\n".
" (hostname tnn.isi.edu)\n".
" (vnode host_0\n".
" (link\n".
" (rlink_1 (interface if1)\n".
" (netaddr 10.1.2.38 10.1.2.37 up)\n".
" (linkaddr 10.7.2.38 10.7.2.37 down)\n".
" (physical 128.9.160.1 128.9.160.2 up)\n".
" )\n".
" (rlink_2 (interface if2)\n".
" (netaddr 10.1.2.2 10.1.2.1 up)\n".
" (linkaddr 10.7.2.2 10.7.2.1 up)\n".
" (physical 198.2.3.4 112.3.4.5 down)\n".
" )\n".
" )\n".
" )\n".
" )\n".
")\n";
$refresh =
"(xbone-ctl 1.5 2.3.3\n".
" (refresh\n".
" (overlay test.xbone.overlay)\n".
" (overlay r1.line.xbone.net)\n".
" (peernet testpeernet)\n".
" )\n".
")";
$discover =
"(xbone-ctl 1.5 2.3.3\n".
" (credential (user_name 'Yu-Shun Wang')\n".
" (user_email yushunwa\@isi.edu)\n".
" (auth_type x509)\n".
" )\n".
" (discover\n".
" )\n".
")";
$ack_discover =
"(xbone-ctl 1.5 2.5 $current\n".
" (ack-discover\n".
" (version 1.6)\n".
" (type meta)\n".
" (hostname add.isi.edu)\n".
" (addr_type ipv6)\n".
" (ctl_addr 128.9.160.213)\n".
" (app_addr 128.9.160.222)\n".
" (os FreeBSD)\n".
" (kernel 500001)\n".
" (os_ver 5.1-current)\n".
" (routing dynamic)\n".
" (IPsec yes)\n".
" (qos yes)\n".
" (dns yes)\n".
" )\n".
")\n";
$addr_req =
"(xbone-ctl 1.5 2.5\n".
" (address_request\n".
" (application overlay)\n".
" (name line.xb.ovl)\n".
" (level 2)\n".
" (hostname add.isi.edu)\n".
" (addr-blk ovl_link\n".
" (addr_type ipv4)\n".
" (size 28))\n".
" (addr-blk ovl_net\n".
" (addr_type ipv6)\n".
" (size 28))\n".
" )\n".
")\n";
$addr_rep =
"(xbone-ctl 1.5 2.5\n".
" (address_reply\n".
" (application overlay)\n".
" (name line.xb.ovl)\n".
" (level 2)\n".
" (hostname add.isi.edu)\n".
" (addr-blk ovl_link\n".
" (addr_type ipv6)\n".
" (addr_range 10.10.20.0/28))\n".
" (addr-blk ovl_net\n".
" (addr_type ipv4)\n".
" (addr_range 10.10.20.0/28))\n".
" )\n".
")\n";
$addr_rel =
"(xbone-ctl 1.5 2.5\n".
" (address_release\n".
" (application overlay)\n".
" (name line.xb.ovl)\n".
" (level 2)\n".
" (hostname add.isi.edu)\n".
" (addr-blk ovl_link\n".
" (addr_type ipv4)\n".
" (size 28))\n".
" (addr-blk ovl_net\n".
" (addr_type ipv6)\n".
" (size 28))\n".
" )\n".
")\n";
my $message = $config;
print "================================================================\n";
print "MSG>>> $message\n";
print "================================================================\n";
$result = $ctl_parser->xb_ctl($message);
#$result = $parser->XOL_PROGRAM($$msgref);
#$result = $parser->NET_SERVICES("(services (manager www.xbone.net)
# (name_server rum.isi.edu) )");
if (!defined ($result))
{
print "\nSYNTACTIC ERROR\n\n";
print "Bad program\n";
exit (1);
}else{
print "GOOD PROGRAM\n";
$result = Dumper($result);
print "$result\n\n";
}
} # else done!
1; # Insure TRUE return if module is interpreted.
syntax highlighted by Code2HTML, v. 0.9.1