Commit 76b3f1ad authored by David Anderson's avatar David Anderson
Browse files

updated linktest script to test routing, link connectivity and bandwidth.

also includes updated tb_compat.tcl include file and ns patch.
parent 137d36db
......@@ -5,9 +5,8 @@
*/
/*
* This is a program agent to manage programs from the event system.
* Program to start Linktest scripts.
*
* You can start, stop, and kill (signal) programs.
*/
#include <stdio.h>
#include <ctype.h>
......@@ -25,9 +24,14 @@
#include "log.h"
#include "event.h"
/* (temporarily) hardcoded path until I find a better place to put this
* (such as /var/emulab/somewhere?)*/
#define PATH_LINKTEST "/users/davidand/testbed/event/linktest/linktest.pl"
static void callback(event_handle_t handle,
event_notification_t notification, void *data);
static void start_linktest( char* args);
void
usage(char *progname)
......@@ -180,5 +184,27 @@ callback(event_handle_t handle, event_notification_t notification, void *data)
info("Event: %lu:%d %s %s %s\n", now.tv_sec, now.tv_usec,
objname, event, args);
/*
* Dispatch the event.
*/
if (strcmp(event, TBDB_EVENTTYPE_START) == 0)
start_linktest(args);
else {
error("Invalid event: %s\n", event);
return;
}
}
/*
* Start up the linktest script and wait for it to complete
*/
static void
start_linktest( char* args) {
if( !fork()) {
info ("starting linktest");
execl(PATH_LINKTEST, NULL);
}
wait(NULL);
info ("linktest completed\n");
}
diff -Naur --exclude-from=xfile tcl/lan/vlan.tcl ../fbsd/ns-2.26/tcl/lan/vlan.tcl
--- tcl/lan/vlan.tcl Wed Feb 26 15:09:37 2003
+++ ../fbsd/ns-2.26/tcl/lan/vlan.tcl Wed Oct 1 17:27:06 2003
@@ -138,8 +138,12 @@
$src add-neighbor $self
set sid [$src id]
- set link_($sid:$id_) [new Vlink $ns_ $self $src $self $bw 0]
- set link_($id_:$sid) [new Vlink $ns_ $self $self $src $bw 0]
+ set link_($sid:$id_) [new Vlink $ns_ $self $src $self $bw $delay]
+ set link_($id_:$sid) [new Vlink $ns_ $self $self $src $bw $delay]
+
+ # linktest: add to the linktest set of links.
+ $ns_ addLTLink $sid:$id_
+ $ns_ addLTLink $id_:$sid
$src add-oif [$link_($sid:$id_) head] $link_($sid:$id_)
$src add-iif [[$nif set iface_] label] $link_($id_:$sid)
@@ -382,6 +386,7 @@
set dst_ $dst
set bw_ $b
set delay_ $d
+
}
Vlink instproc src {} { $self set src_ }
Vlink instproc dst {} { $self set dst_ }
@@ -509,6 +514,10 @@
-mactrace $mactrace]
$lan addNode $nodelist $bw $delay $llType $ifqType $macType \
$phyType $mactrace
+
+ # linktest renaming
+ global last_lan
+ set last_lan $lan
return $lan
}
diff -Naur --exclude-from=xfile tcl/lib/ns-lib.tcl ../fbsd/ns-2.26/tcl/lib/ns-lib.tcl
--- tcl/lib/ns-lib.tcl Wed Feb 26 15:09:37 2003
+++ ../fbsd/ns-2.26/tcl/lib/ns-lib.tcl Wed Oct 1 17:29:20 2003
@@ -539,6 +539,11 @@
$node set ns_ $self
$self check-node-num
+
+ # linktest renaming
+ global last_host
+ set last_host $node
+
return $node
}
@@ -1092,6 +1097,26 @@
$n1 set-neighbor [$n2 id]
$n2 set-neighbor [$n1 id]
}
+
+ ### linktest -- set up DupLink class to return
+ set dup [new Duplink]
+ $dup set from $link_($i1:$i2)
+ $dup set to $link_($i2:$i1)
+
+ # add the duplink ref to the simplex links.
+ $link_($i1:$i2) set linkRef_ $dup
+ $link_($i2:$i1) set linkRef_ $dup
+
+ # and add to the linktest list of links.
+ $self addLTLink $i1:$i2
+ $self addLTLink $i2:$i1
+
+ # naming
+ global last_link
+ set last_link $dup
+
+
+ return $dup
}
Simulator instproc duplex-intserv-link { n1 n2 bw pd sched signal adc args } {
diff -Naur --exclude-from=xfile tcl/lib/ns-link.tcl ../fbsd/ns-2.26/tcl/lib/ns-link.tcl
--- tcl/lib/ns-link.tcl Wed Feb 26 15:09:37 2003
+++ ../fbsd/ns-2.26/tcl/lib/ns-link.tcl Wed Oct 1 16:47:32 2003
@@ -192,7 +192,7 @@
set link_ [new $lltype]
$link_ set bandwidth_ $bw
$link_ set delay_ $delay
-
+
$queue_ target $link_
$link_ target [$dst entry]
$queue_ drop-target $drophead_
......@@ -15,7 +15,7 @@ proc tb-set-ip-lan {src lan ip} {}
proc tb-set-hardware {node type args} {}
proc tb-set-node-os {node os} {}
#proc tb-set-link-loss {src args} {}
proc tb-set-lan-loss {lan rate} {}
#proc tb-set-lan-loss {lan rate} {}
proc tb-set-node-rpms {node args} {}
proc tb-set-node-startup {node cmd} {}
proc tb-set-node-cmdline {node cmd} {}
......@@ -31,8 +31,8 @@ proc tb-fix-node {v p} {}
proc tb-make-weighted-vtype {name weight types} {}
proc tb-make-soft-vtype {name types} {}
proc tb-make-hard-vtype {name types} {}
proc tb-set-lan-simplex-params {lan node todelay tobw toloss fromdelay frombw fromloss} {}
proc tb-set-link-simplex-params {link src delay bw loss} {}
#proc tb-set-lan-simplex-params {lan node todelay tobw toloss fromdelay frombw fromloss} {}
#proc tb-set-link-simplex-params {link src delay bw loss} {}
proc tb-set-uselatestwadata {onoff} {}
proc tb-set-usewatunnels {onoff} {}
proc tb-set-wasolver-weights {delay bw plr} {}
......@@ -172,20 +172,24 @@ LTLink instproc set_loss { loss } {
set loss_ $loss
}
#LTLink instproc clone {} {
# $self instvar lanOrLink_ src_ dst_ bw_ delay_ loss_
# set newLink [new LTLink]
# $newLink set_src $src_
# $newLink set_dst $dst_
# $newLink set_bw $bw_
# $newLink set_delay $delay_
# $newLink set_loss $loss_
# return $newLink
#}
# for final printing, always resolve lans to actual lists of hosts.
LTLink instproc toString {} {
$self instvar lanOrLink_ src_ dst_ bw_ delay_ loss_
global hosts lans links
if { 0 == [llength [array get hosts $dst_] ] } {
return "link $lanOrLink_ $hosts($src_) $lans($dst_) $bw_ $delay_ $loss_"
} elseif {
0 == [llength [array get hosts $src_] ]
} {
return "link $lanOrLink_ $lans($src_) $hosts($dst_) $bw_ $delay_ $loss_"
} else {
return "link $lanOrLink_ $hosts($src_) $hosts($dst_) $bw_ $delay_ $loss_"
}
global hosts
return [format "l $hosts($src_) $hosts($dst_) %10.0f %.4f %.4f" $bw_ $delay_ $loss_ ]
}
......@@ -210,7 +214,10 @@ Simulator instproc addLTLink { linkref } {
# lan reference
$newLink set_lanOrLink [$link_($linkref) set lan_ ]
# netbed-specific implementation for lans: add 1/2 the delay
$newLink set_delay [expr [$newLink delay] / 2.0]
} elseif {0 == [string compare [$link_($linkref) info class ] "SimpleLink"]} {
$newLink set_bw [$link_($linkref) bw ]
$newLink set_delay [$link_($linkref) delay ]
......@@ -221,30 +228,76 @@ Simulator instproc addLTLink { linkref } {
} else {
error "unknown link type!"
}
lappend lt_links $newLink
}
# just print the representation to stdout
Simulator instproc run {args} {
join_lans
output
}
# update lt_links such that lans become new links containing destination hosts
# delay: sum both delays
# loss: product both losses
# bandwidth: min of both bandwidths (the bottleneck)
#
proc join_lans {} {
global lt_links lans
set new_links {}
set all_lans [array names lans]
foreach srclink $lt_links {
# dst a lan link?
if { [lsearch $all_lans [$srclink dst]] > -1 } {
set lan [$srclink dst]
# find all of the "receivers" for this lan.
foreach dstlink $lt_links {
if { $lan == [$dstlink src]
&&
[$srclink src] != [$dstlink dst]
} {
set newLink [new LTLink]
$newLink set_src [$srclink src]
$newLink set_dst [$dstlink dst]
$newLink set_bw [expr [$srclink bw] < [$dstlink bw] ? [$srclink bw] : [$dstlink bw]]
$newLink set_delay [expr [$srclink delay ] + [$dstlink delay]]
$newLink set_loss [expr 1.0 - (1.0 - [$srclink loss] ) * (1.0 - [$dstlink loss])]
# puts [$newLink toString]
lappend new_links $newLink
}
}
} elseif {[lsearch $all_lans [$srclink src]] > -1 } {
# puts "ignored"
} else {
lappend new_links $srclink
}
}
set lt_links $new_links
}
proc output {} {
global hosts lans links lt_links
# node names
foreach name [array names hosts] {
puts "node $hosts($name)"
}
foreach name [array names lans] {
puts "lan $name $lans($name)"
}
foreach name [array names links] {
puts "link $name $links($name)"
puts "h $hosts($name)"
}
foreach lt $lt_links {
puts "[$lt toString]"
foreach link $lt_links {
puts "[$link toString]"
}
}
#
# from here on out, ns is not changed, just lt_links.
# from here on out, implement netbed-specific commands against lt_links
#
proc tb-set-link-loss {args} {
global lt_links
......@@ -276,9 +329,15 @@ proc tb-set-link-loss {args} {
proc tb-set-lan-loss {lan rate} {
global lt_links
# netbed-implenetation detail: set loss to 1-sqrt(1-L)
set a [expr 1.0 - $rate]
set b [expr sqrt ($a)]
set newloss [expr 1.0 - $b]
foreach lt $lt_links {
if { $lan == [$lt lanOrLink] } {
$lt set_loss $rate
$lt set_loss $newloss
}
}
}
......@@ -299,4 +358,29 @@ proc tb-set-link-simplex-params {link src delay bw loss} {
}
}
proc tb-set-lan-simplex-params {lan node todelay tobw toloss fromdelay frombw fromloss} {
global lt_links
foreach lt $lt_links {
if {
$lan == [$lt dst]
&&
$node == [$lt src]
} {
$lt set_delay $fromdelay
$lt set_bw $frombw
$lt set_loss $fromloss
}
if {
$lan == [$lt src]
&&
$node == [$lt dst]
} {
$lt set_delay $todelay
$lt set_bw $tobw
$lt set_loss $toloss
}
}
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment