test-utils/dtn-topology.tcl
changeset 0 2b3e5ec03512
equal deleted inserted replaced
-1:000000000000 0:2b3e5ec03512
       
     1 #
       
     2 #    Copyright 2005-2006 Intel Corporation
       
     3 # 
       
     4 #    Licensed under the Apache License, Version 2.0 (the "License");
       
     5 #    you may not use this file except in compliance with the License.
       
     6 #    You may obtain a copy of the License at
       
     7 # 
       
     8 #        http://www.apache.org/licenses/LICENSE-2.0
       
     9 # 
       
    10 #    Unless required by applicable law or agreed to in writing, software
       
    11 #    distributed under the License is distributed on an "AS IS" BASIS,
       
    12 #    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
       
    13 #    See the License for the specific language governing permissions and
       
    14 #    limitations under the License.
       
    15 #
       
    16 
       
    17 #
       
    18 # Default config shared by all these topologies
       
    19 #
       
    20 
       
    21 namespace eval dtn {
       
    22 
       
    23 set router_type "static"
       
    24 
       
    25 set eid_pattern {dtn://host-$id}
       
    26 
       
    27 proc get_eid {id} {
       
    28     return [subst $dtn::eid_pattern]
       
    29 }
       
    30 
       
    31 proc config_topology_common {with_routes} {
       
    32     global dtn::router_type dtn::local_eid_pattern
       
    33     
       
    34     foreach id [net::nodelist] {
       
    35 	conf::add dtnd $id "route set type $router_type"
       
    36 	conf::add dtnd $id "route local_eid [get_eid $id]"
       
    37 	conf::add dtnd $id "route set add_nexthop_routes $with_routes"
       
    38     }
       
    39 }
       
    40 
       
    41 #
       
    42 # Generate a unique link name
       
    43 #
       
    44 proc new_link_name {cl src dst} {
       
    45     global dtn::link_names
       
    46 
       
    47     set name "$cl-link:$src-$dst"
       
    48     if {![info exists link_names($name)] } {
       
    49 	set link_names($name) 1
       
    50 	return $name
       
    51     }
       
    52 
       
    53     set i 2
       
    54     while {1} {
       
    55 	set name "$cl-link.$i:$src-$dst"
       
    56 	if {![info exists link_names($name)]} {
       
    57 	    set link_names($name) 1
       
    58 	    return $name
       
    59 	}
       
    60 	incr i
       
    61     }
       
    62 }
       
    63 
       
    64 #
       
    65 # Return the name of a link between a and b (if it's been configured)
       
    66 #
       
    67 proc get_link_name {cl src dst} {
       
    68     global dtn::link_names
       
    69     
       
    70     set name "$cl-link:$src-$dst"
       
    71     if {![info exists link_names($name)] } {
       
    72 	return ""
       
    73     }
       
    74     return $name
       
    75 }
       
    76 
       
    77 #
       
    78 # Add a link and optionally a route from a to b.
       
    79 #
       
    80 proc config_link {id peerid type cl link_args} {
       
    81     global dtn::link_names net::internal_host bluez::btaddr
       
    82     
       
    83     set peeraddr $net::internal_host($peerid)
       
    84     set peerport [dtn::get_port $cl $peerid]
       
    85     set localaddr [info hostname]
       
    86     set localport [dtn::get_port $cl $id]
       
    87 
       
    88     set link [new_link_name $cl $id $peerid]
       
    89     set peer_eid  [get_eid $peerid]
       
    90 
       
    91     # For bidirectional convergence layers, we configure an ONDEMAND
       
    92     # or ALWAYSON link in only one direction, since the other side
       
    93     # gets created in response to the connection establishment, and
       
    94     # hence is OPPORUNISTIC.
       
    95     if {[dtn::is_bidirectional $cl] && \
       
    96 	    ([string toupper $type] == "ONDEMAND" || \
       
    97              [string toupper $type] == "ALWAYSON") && \
       
    98 	    [get_link_name $cl $peerid $id] != ""} {
       
    99 	set type OPPORTUNISTIC
       
   100     }
       
   101 
       
   102     set nexthop $peeraddr:$peerport
       
   103 
       
   104     if {$cl == "bt"} {
       
   105         puts "% bt link nexthop $bluez::btaddr($peerid) -> $peer_eid"
       
   106     set nexthop $bluez::btaddr($peerid)  
       
   107     } 
       
   108     
       
   109     if {$cl == "ltp"} {
       
   110     set nexthop $localaddr:$peerport
       
   111     conf::add dtnd $id [join [list \
       
   112             link add $link $nexthop $type $cl \
       
   113             local_addr=$localaddr local_port=$localport \
       
   114             remote_eid=$peer_eid $link_args]]
       
   115             }
       
   116 
       
   117     if {$cl == "tcp" || $cl == "udp"} { 
       
   118     conf::add dtnd $id [join [list \
       
   119 	    link add $link $nexthop $type $cl \
       
   120 	    remote_eid=$peer_eid $link_args]]
       
   121     }
       
   122     return $link
       
   123 
       
   124 }
       
   125 #
       
   126 # Set up a linear topology using TCP, UDP or LTP
       
   127 #
       
   128 proc config_linear_topology {type cl with_routes {link_args ""}} {
       
   129     dtn::config_topology_common $with_routes
       
   130     
       
   131     set last [expr [net::num_nodes] - 1]
       
   132     
       
   133     foreach id [net::nodelist] {
       
   134 
       
   135 	# link to next hop in chain (except for last one) and routes
       
   136 	# to non-immediate neighbors
       
   137 	if { $id != $last } {
       
   138 	    set link [config_link $id [expr $id + 1] $type $cl $link_args]
       
   139 
       
   140             if {$with_routes} {
       
   141                 for {set dest [expr $id + 2]} {$dest <= $last} {incr dest} {
       
   142                     conf::add dtnd $id \
       
   143                             "route add [get_eid $dest]/* $link"
       
   144                 }
       
   145             }
       
   146 	}
       
   147 	
       
   148 	# and previous a hop in chain as well
       
   149 	if { $id != 0 } {
       
   150 	    set link [config_link $id [expr $id - 1] $type $cl $link_args]
       
   151             
       
   152 	    if {$with_routes} {
       
   153 		for {set dest [expr $id - 2]} {$dest >= 0} {incr dest -1} {
       
   154 		    conf::add dtnd $id \
       
   155 			    "route add [get_eid $dest]/* $link"
       
   156 		}
       
   157 	    }
       
   158 	}
       
   159     }
       
   160 }
       
   161 
       
   162 
       
   163 #
       
   164 # Set up a ltp schedule on linear topology using LTP
       
   165 # Fist node is the receiver, middle node is a router and 
       
   166 # last is the sender
       
   167 #
       
   168 proc config_ltp_schedule {cl sched} {
       
   169     set last [expr [net::num_nodes] - 1]
       
   170     foreach id [net::nodelist] {
       
   171 
       
   172         if { $id == $last } {
       
   173 	set distdir test/schedule/ltp-schedule/sender
       
   174     	dbg "% copying files"
       
   175         set hostname $net::host($id)
       
   176         set targetdir [dist::get_rundir $hostname $id]
       
   177 
       
   178         dbg "% $distdir -> $hostname:$targetdir"
       
   179 
       
   180         if [net::is_localhost $hostname] {
       
   181             testlog "distributing $distdir/$sched to $targetdir/$sched on sending node $hostname"
       
   182             exec cp -r $distdir/$sched $targetdir/$sched
       
   183         } else {
       
   184 	    testlog "distributing $distdir/$sched to $hostname:$targetdir/$sched"
       
   185             exec scp -C -r $distdir/$sched $hostname:$targetdir/$sched
       
   186         }
       
   187 
       
   188 
       
   189         } elseif { $id == 0 } {
       
   190         set distdir test/schedule/ltp-schedule/receiver
       
   191         dbg "% copying files"
       
   192         set hostname $net::host($id)
       
   193         set targetdir [dist::get_rundir $hostname $id]
       
   194 
       
   195         dbg "% $distdir -> $hostname:$targetdir"
       
   196 
       
   197         if [net::is_localhost $hostname] {
       
   198             testlog "distributing $distdir/$sched to $targetdir/$sched on receiving node $hostname"
       
   199             exec cp -r $distdir/$sched $targetdir/$sched
       
   200         } else {
       
   201             testlog "distributing $distdir/$sched to $hostname:$targetdir/$sched"
       
   202             exec scp -C -r $distdir/$sched $hostname:$targetdir/$sched
       
   203         }
       
   204 	} else {
       
   205         set distdir test/schedule/ltp-schedule/router
       
   206         dbg "% copying files"
       
   207         set hostname $net::host($id)
       
   208         set targetdir [dist::get_rundir $hostname $id]
       
   209 
       
   210         dbg "% $distdir -> $hostname:$targetdir"
       
   211 
       
   212         if [net::is_localhost $hostname] {
       
   213             testlog "distributing $distdir/$sched to $targetdir/$sched on router node $hostname"
       
   214             exec cp -r $distdir/$sched $targetdir/$sched
       
   215         } else {
       
   216             testlog "distributing $distdir/$sched to $hostname:$targetdir/$sched"
       
   217             exec scp -C -r $distdir/$sched $hostname:$targetdir/$sched
       
   218         }
       
   219 	}
       
   220 	}
       
   221 }
       
   222 
       
   223 
       
   224 #
       
   225 # Set up a mesh topology with TCP or UDP
       
   226 #
       
   227 proc config_mesh_topology {type cl with_routes {link_args ""}} {
       
   228     dtn::config_topology_common $with_routes
       
   229     
       
   230     set last [expr [net::num_nodes] - 1]
       
   231     
       
   232     foreach a [net::nodelist] {
       
   233         foreach b [net::nodelist] {
       
   234             if {$a != $b} {
       
   235                 set link [config_link $a $b $type $cl $link_args]
       
   236             }
       
   237 
       
   238             if {$with_routes} {
       
   239 		conf::add dtnd $id \
       
   240 			"route add [get_eid $dest]/* $link"
       
   241 	    }
       
   242 	}
       
   243     }
       
   244 }
       
   245 
       
   246 #
       
   247 # Set up a tree-based routing topology on nodes 0-254
       
   248 #
       
   249 #                                 0
       
   250 #                                 |
       
   251 #           /--------------/-----/|\----\--------------\
       
   252 #          1              2     .....    8              9
       
   253 #   /---/-----\---\      /-\            /-\      /---/-----\---\
       
   254 #  10  11 ... 18  19     ...            ...     90  91 ... 98  99
       
   255 #  |   |  ...  |   |                            |   |       |   |
       
   256 # 110 111     118 119                          190 191     198 199
       
   257 #  |   |       |   |  
       
   258 # 210 211     218 219
       
   259 #
       
   260 proc config_tree_topology {type cl {link_args ""}} {
       
   261     global hosts ports num_nodes id route_to_root
       
   262 
       
   263     error "XXX/demmer fixme"
       
   264 
       
   265     # the root has routes to all 9 first-hop descendents
       
   266     if { $id == 0 } {
       
   267 	for {set child 1} {$child <= 9} {incr child} {
       
   268 	    set childaddr $hosts($child)
       
   269 	    set childport $ports($cl,$child)
       
   270 	    eval link add link-$child $childaddr:$childport \
       
   271 		    $type $cl $link_args
       
   272 	    
       
   273 	    route add [get_eid $child]/* link-$child
       
   274 	}
       
   275     }
       
   276 
       
   277     # otherwise, the first hop nodes have routes to the root and their
       
   278     # 9 second tier descendents
       
   279     if { $id >= 1 && $id <= 9 } {
       
   280 	set parent 0
       
   281 	set parentaddr $hosts($parent)
       
   282 	set parentport $ports($cl,$parent)
       
   283 	eval link add link-$parent $parentaddr:$parentport \
       
   284 		$type $cl $link_args
       
   285 	
       
   286 	route add [get_eid $parent]/* link-$parent
       
   287 	set route_to_root [get_eid $parentaddr]
       
   288 	
       
   289 	for {set child [expr $id * 10]} \
       
   290 		{$child <= [expr ($id * 10) + 9]} \
       
   291 		{incr child}
       
   292 	{
       
   293 	    set childaddr $hosts($child)
       
   294 	    set childport $ports($cl,$child)
       
   295 	    eval link add link-$child $childaddr:$childport \
       
   296 		    $type $cl $link_args
       
   297 	    
       
   298 	    route add [get_eid $child]/* link-$child
       
   299 	}
       
   300     }
       
   301 
       
   302     # for third-tier nodes 100-199, set their upstream route. for
       
   303     # 100-154, can also set a fourth-tier route to 200-254
       
   304     if { $id >= 100 && $id <= 199 } {
       
   305 	set parent [expr $id / 10]
       
   306 	set parentaddr $hosts($parent)
       
   307 	set parentport $ports($cl,$parent)
       
   308 	eval link add link-$parent $parentaddr:$parentport \
       
   309 		$type $cl $link_args
       
   310 	
       
   311 	route add [get_eid $parent]/* link-$parent
       
   312 	set route_to_root [get_eid $parentaddr]
       
   313 
       
   314 	if {$id <= 154} {
       
   315 	    set child [expr $id + 100]
       
   316 	    set childaddr $hosts($child)
       
   317 	    set childport $ports($cl,$child)
       
   318 	    eval link add link-$child $childaddr:$childport \
       
   319 		    $type $cl $link_args
       
   320 	    
       
   321 	    route add [get_eid $child]/* link-$child
       
   322 	}
       
   323     }
       
   324 
       
   325     # finally, the fourth tier nodes 200-254 just set a route to their parent
       
   326     if { $id >= 200 && $id <= 255 } {
       
   327 	set parent [expr $id - 100]
       
   328 	set parentaddr $hosts($parent)
       
   329 	set parentport $ports($cl,$parent)
       
   330 	eval link add link-$parent $parentaddr:$parentport \
       
   331 		$type $cl $link_args
       
   332 	
       
   333 	route add [get_eid $parent]/* link-$parent
       
   334 	set route_to_root [get_eid $parentaddr]
       
   335     }
       
   336 }
       
   337 
       
   338 # A two level tree with a single root and N children
       
   339 #            0
       
   340 #      /  / ...  \  \
       
   341 #     1     ...      n
       
   342 #
       
   343 proc config_twolevel_topology {type cl with_routes {link_args ""}} {
       
   344     dtn::config_topology_common $with_routes
       
   345  
       
   346     foreach id [net::nodelist] {
       
   347 	if { $id != 0 } {
       
   348 	    config_link 0   $id $type $cl $link_args
       
   349 	    config_link $id 0   $type $cl $link_args
       
   350 	}
       
   351     }
       
   352 }
       
   353 
       
   354 # A simple four node diamond topology with multiple
       
   355 # routes of the same priority for two-hop neighbors.
       
   356 #
       
   357 #      0
       
   358 #     / \
       
   359 #    1   2
       
   360 #     \ /
       
   361 #      3
       
   362 proc config_diamond_topology {type cl with_routes {link_args ""}} {
       
   363     dtn::config_topology_common $with_routes
       
   364      
       
   365     config_link 0 1 $type $cl $link_args
       
   366     config_link 0 2 $type $cl $link_args
       
   367 
       
   368     if {$with_routes} {
       
   369         conf::add dtnd 0 "route add [get_eid 3]/* $cl-link:0-1"
       
   370         conf::add dtnd 0 "route add [get_eid 3]/* $cl-link:0-2"
       
   371     }
       
   372     
       
   373     config_link 1 0 $type $cl $link_args
       
   374     config_link 1 3 $type $cl $link_args
       
   375 
       
   376     if {$with_routes} {
       
   377         conf::add dtnd 1 "route add [get_eid 2]/* $cl-link:1-0"
       
   378         conf::add dtnd 1 "route add [get_eid 2]/* $cl-link:1-3"
       
   379     }
       
   380     
       
   381     config_link 2 0 $type $cl $link_args
       
   382     config_link 2 3 $type $cl $link_args
       
   383 
       
   384     if {$with_routes} {
       
   385         conf::add dtnd 2 "route add [get_eid 1]/* $cl-link:2-0"
       
   386         conf::add dtnd 2 "route add [get_eid 1]/* $cl-link:2-3"
       
   387     }
       
   388     
       
   389     config_link 3 1 $type $cl $link_args
       
   390     config_link 3 2 $type $cl $link_args
       
   391 
       
   392     if {$with_routes} {
       
   393         conf::add dtnd 3 "route add [get_eid 0]/* $cl-link:3-1"
       
   394         conf::add dtnd 3 "route add [get_eid 0]/* $cl-link:3-2"
       
   395     }
       
   396 }
       
   397 
       
   398 # namespace dtn
       
   399 }