Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
emulab
emulab-devel
Commits
b8d0d2aa
Commit
b8d0d2aa
authored
Mar 15, 2001
by
Christopher Alfeld
Browse files
Shark support!
See www/tutorial/shark_howto.html.
parent
5b814b91
Changes
4
Hide whitespace changes
Inline
Side-by-side
tbsetup/ir/assign_wrapper.in
View file @
b8d0d2aa
...
...
@@ -133,8 +133,8 @@ foreach (split("\n",$raw)) {
}
$delay
=~
s/[mM][sS]$//
;
$bw
=~
s/[mM][bB]$//
;
printdb
"
lans{
$lan
} = [
$nodes_raw
,
$bw
,
$delay
,
$loss
"
.
(
defined
$links_raw
?
"
,
$links_
raw
"
:
"")
.
"
]
\n
";
printdb
"
lans{
$lan
} = [
$nodes_raw
,
$bw
,
$delay
,
$loss
,
"
.
join
("
",
@
$links_
tmp
)
.
"
]
\n
";
$lans
{
$lan
}
=
[
$nodes_tmp
,
$bw
,
$delay
,
$loss
,
$links_tmp
];
}
...
...
@@ -148,6 +148,108 @@ sub min {
}
return
$min
;
};
# Shark shelf
# We need to find LANs with sharks in them, check to see all's ok and
# convert them in to shark shelves, splitting the LAN if necessary. The
# following conditions must be checked:
# Foreach lan with sharks
# 1. 10 MB, 0 latency, no loss
# 2. <= 8 sharks in LAN
# 3. <= 1 external link.
# Foreach shark
# 1. In LAN
# 2. No other links
# %sharkshelves is indexed by sharkshelf name (ss-<lan>) and contains
# a list of the sharks in it.
foreach
$lan
(
keys
(
%lans
))
{
(
$lnodes
,
$bw
,
$delay
,
$loss
,
$llinks
)
=
@
{
$lans
{
$lan
}};
@sharks
=
();
@others
=
();
foreach
$node
(
@$lnodes
)
{
if
(
$nodetypes
{
$node
}
eq
"
shark
")
{
push
(
@sharks
,
$node
);
}
else
{
push
(
@others
,
$node
);
}
}
# Skip if nothing more to do
if
(
$#sharks
==
-
1
)
{
next
;}
# Check LAN
if
((
$bw
!=
10
)
||
(
$delay
!=
0
)
||
(
$loss
!=
0
))
{
print
STDERR
"
$lan
has sharks but is not 10Mb/0 delay/0 loss.
\n
";
exit
(
1
);
}
if
(
$#sharks
>=
8
)
{
print
STDERR
"
$lan
has too many sharks. Max 8.
\n
";
exit
(
1
);
}
printdb
"
shark-lan
$lan
\n
";
# Check sharks and remove them from consideration if they are OK
foreach
$shark
(
@sharks
)
{
if
(
@
{
$nodes
{
$shark
}})
{
print
STDERR
"
Shark
$shark
has links.
\n
";
exit
(
1
);
}
delete
$nodes
{
$shark
};
delete
$nodetypes
{
$shark
};
}
# Final checks
@lanlinks
=
@$llinks
;
if
(
@others
)
{
print
STDERR
"
Shark lan
$lan
has non-sharks.
\n
";
exit
(
1
);
}
if
(
$#lanlinks
>
0
)
{
print
STDERR
"
Shark lan
$lan
has more than one outside link.
\n
";
exit
(
1
);
}
# Generate the shark shelf node
$ssnode
=
"
ss-
$lan
";
$nodetypes
{
$ssnode
}
=
"
shark-shelf
";
printdb
"
nodetypes{
$ssnode
} = shark-shelf
\n
";
$sharkshelves
{
$ssnode
}
=
[]
;
push
(
@
{
$sharkshelves
{
$ssnode
}},
@sharks
);
printdb
"
sharkshelves{
$ssnode
} =
"
.
join
("
",
@
{
$sharkshelves
{
$ssnode
}})
.
"
\n
";
if
(
$#lanlinks
==
0
)
{
printdb
"
Setting up link
\n
";
$extlink
=
$lanlinks
[
0
];
(
$src
,
$dst
,
$bw
,
$delay
,
$loss
)
=
@
{
$links
{
$extlink
}};
if
(
$src
eq
"
$lan
")
{
$rdst
=
$dst
;
}
else
{
$rdst
=
$src
;
}
$nodes
{
$ssnode
}
=
["
$ssnode
-
$extlink
"];
printdb
"
nodes{
$ssnode
} =
$ssnode
-
$extlink
\n
";
$links
{"
$ssnode
-
$extlink
"}
=
[
$ssnode
,
$rdst
,
$bw
,
$delay
,
$loss
];
printdb
"
links{
$ssnode
-
$extlink
} = [
$ssnode
,
$rdst
,
$bw
,
$delay
,
$loss
]
\n
";
delete
$links
{
$extlink
};
}
else
{
$nodes
{
$ssnode
}
=
[]
;
printdb
"
nodes{
$ssnode
} = []
\n
";
}
# Remove the original LAN
delete
$lans
{
$lan
};
}
# Check all remaining nodes to make sure none are sharks
foreach
$node
(
keys
(
%nodes
))
{
printdb
"
Checking
$node
for sharkness (
$nodetypes
{
$node
})
\n
";
if
(
$nodetypes
{
$node
}
eq
"
shark
")
{
print
STDERR
"
$node
is s shark but not in a LAN.
\n
";
exit
(
1
);
}
}
# LAN conversion
# We now need to turn LANs into links and nodes. Each lan gets a central
...
...
@@ -645,7 +747,13 @@ open(IRFILE,">>$irfile") || do {
print
IRFILE
"
START virtual
\n
";
print
IRFILE
"
START nodes
\n
";
foreach
$vnode
(
keys
(
%v2pmap
))
{
if
(
!
defined
(
$lans
{
$vnode
}))
{
if
(
defined
(
$sharkshelves
{
$vnode
}))
{
$i
=
1
;
foreach
$vshark
(
@
{
$sharkshelves
{
$vnode
}})
{
print
IRFILE
"
$vshark
$v2pmap
{
$vnode
}-
$i
\n
";
$i
++
;
}
}
elsif
(
!
defined
(
$lans
{
$vnode
}))
{
print
IRFILE
"
$vnode
$v2pmap
{
$vnode
}
\n
";
}
}
...
...
tbsetup/ir/handle_ip.in
View file @
b8d0d2aa
...
...
@@ -81,6 +81,17 @@ foreach (split("\n",&ir_get("/virtual/nodes"))) {
$rvnodemap
{
$physical
}
=
$virtual
;
}
# Read in nodes
&ir_exists
("
/topology/nodes
")
||
do
{
print
STDERR
"
IR does not contain topology/nodes section.
\n
";
exit
(
1
);
};
foreach
(
split
("
\n
",
&ir_get
("
/topology/nodes
")))
{
@t
=
split
;
(
$node
,
$type
)
=
@t
;
$nodetypes
{
$node
}
=
$type
;
}
# Read in the links
&ir_exists
("
/topology/links
")
||
do
{
print
STDERR
"
IR does not contain topology/links section.
\n
";
...
...
@@ -92,17 +103,6 @@ foreach (split("\n",&ir_get("/topology/links"))) {
$links
{
$link
}
=
[
$src
,
$dst
];
}
# Get an idea of what LANs there are
&ir_exists
("
/topology/lans
")
||
do
{
print
STDERR
"
IR does not contain topology/lans section.
\n
";
exit
(
1
);
};
foreach
(
split
("
\n
",
&ir_get
("
/topology/lans
")))
{
(
$lan
,
$nodesraw
)
=
/^([^ ]+) "([^\"]+)"/
;
my
(
@nodes
)
=
split
("
",
$nodesraw
);
$lans
{
$lan
}
=
[
$lan
,
\
@nodes
];
}
# Pull the MAC table from the database.
# MACTABLE is indexed by virtual node name and contains a reference
# to a list of MACs.
...
...
@@ -122,6 +122,35 @@ while (@row = $sth->fetchrow_array) {
}
$sth
->
finish
;
# Get an idea of what LANs there are
&ir_exists
("
/topology/lans
")
||
do
{
print
STDERR
"
IR does not contain topology/lans section.
\n
";
exit
(
1
);
};
foreach
(
split
("
\n
",
&ir_get
("
/topology/lans
")))
{
(
$lan
,
$nodesraw
,
$linksraw
)
=
/^([^ ]+) "([^\"]+)" [^ ]+ [^ ]+ [^ ]+ (.+)$/
;
my
(
@nodes
)
=
split
("
",
$nodesraw
);
$lans
{
$lan
}
=
[
$lan
,
\
@nodes
];
# Check for sharkshelf
if
(
$nodetypes
{
$nodes
[
0
]}
==
"
shark
")
{
# We need to fill in the MACs for the vlan map for this lan
# since there is no actual VLAN for it.
$vlanmap
{
$lan
}
=
[]
;
foreach
$shark
(
@nodes
)
{
push
(
@
{
$vlanmap
{
$lan
}},
@
{
$MACTABLE
{
$shark
}});
}
# Linksraw only has a single link otherwise assign_wrapper would have
# generated an error.
(
$src
,
$dst
)
=
@
{
$links
{
$linksraw
}};
if
(
$src
eq
$lan
)
{
$other
=
$dst
;
}
else
{
$other
=
$src
;
}
push
(
@
{
$vlanmap
{
$lan
}},
@
{
$MACTABLE
{
$other
}});
}
}
# This is a list of error messages
@ERRORS
=
();
...
...
tbsetup/ir/handle_os.in
View file @
b8d0d2aa
...
...
@@ -62,13 +62,7 @@ foreach (split("\n",$raw)) {
$type
=
$info
[
1
];
$nodetype
{
$node
}
=
$type
;
if
(
!
defined
(
$ostype
{
$type
}))
{
# Special case - shark shelf
if
(
$type
eq
"
shark-shelf
")
{
$subtype
=
"
shark
";
}
else
{
$subtype
=
$type
;
}
$sth
=
$dbh
->
prepare
("
SELECT image_id from node_types where type =
\"
$subtype
\"
");
$sth
=
$dbh
->
prepare
("
SELECT image_id from node_types where type =
\"
$type
\"
");
$rr
=
$sth
->
execute
;
if
(
$rr
==
0
)
{
push
(
@ERRORS
,"
Invalid type
$type
");
...
...
@@ -96,13 +90,7 @@ foreach (split("\n",$raw)) {
# assume to be a delay node
$os
{
$physical
}
=
$delayos
;
}
else
{
if
(
$nodetype
{
$virtual
}
ne
"
shark-shelf
")
{
$os
{
$physical
}
=
$ostype
{
$nodetype
{
$virtual
}};
}
else
{
for
(
$i
=
1
;
$i
<=
8
;
$i
++
)
{
$os
{"
$physical
-
$i
"}
=
$ostype
{"
shark-shelf
"};
}
}
$os
{
$physical
}
=
$ostype
{
$nodetype
{
$virtual
}};
}
}
# Now we parse the tbcmd file
...
...
@@ -122,46 +110,6 @@ while (<TBCMD>) {
}
last
SWITCH
;
};
/^tb-set-dnard-os$/
&&
do
{
if
(
$#line
!=
3
)
{
push
(
@ERRORS
,"
Syntax: tb-set-dnard-os shelf n os
");
}
else
{
(
$shelf
,
$n
,
$label
)
=
@line
[
1
..
3
];
if
(
!
defined
(
$nodemap
{
$shelf
}))
{
push
(
@ERRORS
,"
Unknown node
$shelf
\n
");
last
SWITCH
;
}
if
(
!
((
$n
=~
/[0-9]-[0-9]/
)
||
(
$n
=~
/[0-9]/
)))
{
push
(
@ERRORS
,"
n must either be a number or a range start-end
\n
");
last
SWITCH
;
}
# The label should either be in the images table or
# in the DB.
if
(
!
defined
(
$images
{
$label
}))
{
# Check DB
$sth
=
$dbh
->
prepare
("
SELECT image_id from disk_images where image_id =
\"
$label
\"
");
$rr
=
$sth
->
execute
;
if
(
$rr
==
0
)
{
# Bad OS
$sth
->
finish
;
push
(
@ERRORS
,"
Unknown OS label
$label
");
last
SWITCH
;
}
$sth
->
finish
;
}
$prefix
=
$nodemap
{
$shelf
};
if
(
$n
=~
/[0-9]-[0-9]/
)
{
(
$start
,
$end
)
=
split
("
-
",
$n
);
foreach
(
$start
..
$end
)
{
$os
{"
$prefix
-
$_
"}
=
$label
;
}
}
else
{
$os
{"
$prefix
-
$n
"}
=
$label
;
}
}
last
SWITCH
;
};
/^tb-set-node-os$/
&&
do
{
if
(
$#line
!=
2
)
{
push
(
@ERRORS
,"
Syntax: tb-set-node-os nodespec os
");
...
...
@@ -190,10 +138,7 @@ while (<TBCMD>) {
}
foreach
(
keys
(
%nodemap
))
{
if
(
eval
("
/^
$nodespec
"
.
'
$
'
.
"
/
"))
{
# Special case, make sure we aren't talking about sharks
if
(
$nodetype
{
$_
}
eq
"
shark-shelf
")
{
push
(
@ERRORS
,"
Use set-dnard-os for setting os of shark shelf
$_
\n
");
}
elsif
((
$valid_type
ne
"")
&&
if
((
$valid_type
ne
"")
&&
(
$nodetype
{
$_
}
ne
$valid_type
))
{
push
(
@ERRORS
,"
$_
is of type
$nodetype
(
$_
), OS
$label
is of type
$valid_type
");
$os
{
$nodemap
{
$_
}}
=
"
INVALID
";
...
...
@@ -206,10 +151,6 @@ while (<TBCMD>) {
last
SWITCH
;
};
/^tb-set-dnard-deltas$/
&&
do
{
# PLACE HOLDER
last
SWITCH
;
};
/^tb-set-node-deltas$/
&&
do
{
# PLACE HOLDER
last
SWITCH
;
...
...
tbsetup/ns2ir/tb_compat.tcl.in
View file @
b8d0d2aa
...
...
@@ -78,16 +78,10 @@ proc tb-set-lan-loss {lan rate} {
global TBCMD nodeid_map prefix
puts $TBCMD "tb-set-lan-loss $prefix-$nodeid_map($lan) $rate"
}
proc tb-set-dnard-os {shelf number os} {
global TBCMD nodeid_map
puts $TBCMD "tb-set-dnard-os $nodeid_map($shelf) $number $os"
}
# The following commands are not clearly defined and probably will be
# changed or removed
proc tb-set-dnard-ip {shelf number ip} {}
proc tb-set-node-deltas {node deltas} {}
proc tb-set-dnard-deltas {shelf number deltas} {}
# Show that we have loaded
set TB_COMPACT 1
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment