lanlink.tcl 10.2 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1 2 3 4 5 6 7 8 9 10 11 12 13
######################################################################
# lanlink.tcl
#
# This defines the LanLink class and its two children Lan and Link.  
# Lan and Link make no changes to the parent and exist purely to
# distinguish between the two in type checking of arguments.  A LanLink
# contains a number of node:port pairs as well as the characteristics
# bandwidth, delay, and loss rate.
######################################################################

Class LanLink -superclass NSObject
Class Link -superclass LanLink
Class Lan -superclass LanLink
14
Class Queue -superclass NSObject
15 16 17
# This class is a hack.  It's sole purpose is to associate to a Link
# and a direction for accessing the Queue class.
Class SimplexLink -superclass NSObject
Leigh B. Stoller's avatar
Leigh B. Stoller committed
18

19 20 21 22 23 24 25 26 27 28 29 30 31
SimplexLink instproc init {link dir} {
    $self set mylink $link
    $self set mydir $dir
}
SimplexLink instproc queue {} {
    $self instvar mylink
    $self instvar mydir
    return [$mylink set ${mydir}queue]
}
# Don't need any rename procs since these never use their own name and
# can not be generated during Link creation.

Queue instproc init {link type dir} {
32 33
    $self set mylink $link
    
34 35 36 37 38

    # direction is either "to" indicating src to dst or "from" indicating
    # the dst to src.  I.e. to dst or from dst.
    $self set direction $dir

39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
    # These control whether the link was created RED or GRED. It
    # filters through the DB.
    $self set gentle_ 0
    $self set red_ 0

    #
    # These are NS variables for queues (with NS defaults).
    #
    $self set limit_ 50
    $self set maxthresh_ 15
    $self set thresh_ 5
    $self set q_weight_ 0.002
    $self set linterm_ 10
    $self set queue-in-bytes_ 0
    $self set bytes_ 0
    $self set mean_pktsize_ 500
    $self set wait_ 1
    $self set setbit_ 0
    $self set drop-tail_ 1

    if {$type != {}} {
	$self instvar red_
	$self instvar gentle_
	
	if {$type == "RED"} {
	    set red_ 1
	} elseif {$type == "GRED"} {
	    set red_ 1
	    set gentle_ 1
	} elseif {$type != "DropTail"} {
69
	    punsup "Link type $type, using DropTail!"
70 71 72 73
	}
    }
}

74 75 76 77 78 79 80 81 82 83 84 85
Queue instproc rename_lanlink {old new} {
    $self instvar mylink

    set mylink $new
}

Queue instproc get_link {} {
    $self instvar mylink

    return $mylink
}

86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
# Hacky. Need to create an association bewteen the queue direction
# and a dummynet pipe. This should happen later on, but I do not
# have time right now to make all the changes. Instead, convert
# "to" to "pipe0" and "from" to "pipe1".
Queue instproc get_pipe {} {
    $self instvar direction

    if {$direction == "to"} {
	set pipe "pipe0"
    } else {
	set pipe "pipe1"
    }
    return $pipe
}

101 102 103 104 105 106 107 108
Link instproc init {s nodes bw d type} {
    $self next $s $nodes $bw $d $type

    set src [lindex $nodes 0]
    set dst [lindex $nodes 1]

    $self set src_node $src
    $self set dst_node $dst
109

110 111 112 113 114 115 116 117
    var_import GLOBALS::new_counter
    set q1 q[incr new_counter]
    
    Queue to$q1 $self $type to
    Queue from$q1 $self $type from

    $self set toqueue to$q1
    $self set fromqueue from$q1
118 119 120
}

LanLink instproc init {s nodes bw d type} {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
121 122 123 124 125 126
    # This is a list of {node port} pairs.
    $self set nodelist {}

    # The simulator
    $self set sim $s

127 128 129
    # By default, a local link
    $self set widearea 0

Leigh B. Stoller's avatar
Leigh B. Stoller committed
130 131
    # Now we need to fill out the nodelist
    $self instvar nodelist
132 133

    # r* indicates the switch->node chars, others are node->switch
Leigh B. Stoller's avatar
Leigh B. Stoller committed
134
    $self instvar bandwidth
135
    $self instvar rbandwidth
Leigh B. Stoller's avatar
Leigh B. Stoller committed
136
    $self instvar delay
137
    $self instvar rdelay
Leigh B. Stoller's avatar
Leigh B. Stoller committed
138
    $self instvar loss
139
    $self instvar rloss
140
    $self instvar cost
141

Leigh B. Stoller's avatar
Leigh B. Stoller committed
142 143 144
    foreach node $nodes {
	set nodepair [list $node [$node add_lanlink $self]]
	set bandwidth($nodepair) $bw
145
	set rbandwidth($nodepair) $bw
146
	set delay($nodepair) [expr $d / 2.0]
147
	set rdelay($nodepair) [expr $d / 2.0]
Leigh B. Stoller's avatar
Leigh B. Stoller committed
148
	set loss($nodepair) 0
149
	set rloss($nodepair) 0
150
	set cost($nodepair) 1
Leigh B. Stoller's avatar
Leigh B. Stoller committed
151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
	lappend nodelist $nodepair
    }
}

# get_port <node>
# This takes a node and returns the port that the node is connected
# to the LAN with.  If a node is in a LAN multiple times for some
# reason then this only returns the first.
LanLink instproc get_port {node} {
    $self instvar nodelist
    foreach pair $nodelist {
	set n [lindex $pair 0]
	set p [lindex $pair 1]
	if {$n == $node} {return $p}
    }
    return {}
}

# fill_ips
# This fills out the IP addresses (see README).  It determines a
# subnet, either from already assigned IPs or by asking the Simulator
# for one, and then fills out unassigned node:port's with free IP
# addresses.
LanLink instproc fill_ips {} {
    $self instvar nodelist
    $self instvar sim
177
    $self instvar widearea
178
    set isremote 0
Leigh B. Stoller's avatar
Leigh B. Stoller committed
179 180 181 182 183 184 185 186

    # Determined a subnet (if possible) and any used IP addresses in it.
    # ips is a set which contains all used IP addresses in this LanLink.
    set subnet {}
    foreach nodeport $nodelist {
	set node [lindex $nodeport 0]
	set port [lindex $nodeport 1]
	set ip [$node ip $port]
187
	set isremote [expr $isremote + [$node set isremote]]
Leigh B. Stoller's avatar
Leigh B. Stoller committed
188
	if {$ip != {}} {
189 190 191
	    if {$isremote} {
		perror "Not allowed to specify IP subnet of a remote lan!"
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
192 193 194 195
	    set subnet [join [lrange [split $ip .] 0 2] .]
	    set ips($ip) 1
	}
    }
196
    set widearea $isremote
Leigh B. Stoller's avatar
Leigh B. Stoller committed
197 198 199

    # If we couldn't find a subnet we ask the Simulator for one.
    if {$subnet == {}} {
200 201 202 203 204
	if {$isremote} {
	    set subnet [$sim get_subnet_remote]
	} else {
	    set subnet [$sim get_subnet]
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222
    }

    # Now we assign IP addresses to any node:port's without them.
    set ip_counter 2
    foreach nodeport $nodelist {
	set node [lindex $nodeport 0]
	set port [lindex $nodeport 1]
	if {[$node ip $port] == {}} {
	    set ip {}
	    for {set i $ip_counter} {$i < 255} {incr i} {
		if {! [info exists ips($subnet.$i)]} {
		    set ip $subnet.$i
		    set ips($subnet.$i) 1
		    set ip_counter [expr $i + 1]
		    break
		}
	    }
	    if {$ip == {}} {
223
		perror "Ran out of IP addresses in subnet $subnet."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
224 225 226 227 228 229 230
		set ip "255.255.255.255"
	    }
	    $node ip $port $ip
	}
    }
}

231 232 233 234 235 236 237 238 239 240 241 242 243
#
# Return the subnet of a lan. Actually, just return one of the IPs.
#
LanLink instproc get_subnet {} {
    $self instvar nodelist

    set nodeport [lindex $nodelist 0]
    set node [lindex $nodeport 0]
    set port [lindex $nodeport 1]

    return [$node ip $port]
}

244 245 246 247 248 249 250 251 252 253 254 255 256
#
# Set the routing cost for all interfaces on this LAN
#
LanLink instproc cost {c} {
    $self instvar nodelist
    $self instvar cost

    foreach nodeport $nodelist {
	set cost($nodeport) $c
    }
}


257 258 259 260 261 262 263 264 265
Link instproc rename {old new} {
    $self next $old $new

    $self instvar toqueue
    $self instvar fromqueue
    $toqueue rename_lanlink $old $new
    $fromqueue rename_lanlink $old $new
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
266 267 268 269 270 271 272
# The following methods are for renaming objects (see README).
LanLink instproc rename {old new} {
    $self instvar nodelist
    foreach nodeport $nodelist {
	set node [lindex $nodeport 0]
	$node rename_lanlink $old $new
    }
273
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
274 275 276 277 278 279 280
    [$self set sim] rename_lanlink $old $new
}
LanLink instproc rename_node {old new} {
    $self instvar nodelist
    $self instvar bandwidth
    $self instvar delay
    $self instvar loss
281 282 283
    $self instvar rbandwidth
    $self instvar rdelay
    $self instvar rloss
Leigh B. Stoller's avatar
Leigh B. Stoller committed
284 285 286 287 288 289 290 291 292 293 294 295 296
    set newnodelist {}
    foreach nodeport $nodelist {
	set node [lindex $nodeport 0]
	set port [lindex $nodeport 1]
	set newnodeport [list $new $port]
	if {$node == $old} {
	    lappend newnodelist $newnodeport
	} else {
	    lappend newnodelist $nodeport
	}
	set bandwidth($newnodeport) $bandwidth($nodeport)
	set delay($newnodeport) $delay($nodeport)
	set loss($newnodeport) $loss($nodeport)
297 298 299
	set rbandwidth($newnodeport) $rbandwidth($nodeport)
	set rdelay($newnodeport) $rdelay($nodeport)
	set rloss($newnodeport) $rloss($nodeport)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
300 301 302
	unset bandwidth($nodeport)
	unset delay($nodeport)
	unset loss($nodeport)
303 304 305
	unset rbandwidth($nodeport)
	unset rdelay($nodeport)
	unset rloss($nodeport)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
306 307 308 309
    }
    set nodelist $newnodelist
}

310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364
Link instproc updatedb {DB} {
    $self next $DB
    $self instvar toqueue
    $self instvar fromqueue
    $self instvar nodelist
    $self instvar src_node
    var_import ::GLOBALS::pid
    var_import ::GLOBALS::eid

    foreach nodeport $nodelist {
	set node [lindex $nodeport 0]
	if {$node == $src_node} {
	    set linkqueue $toqueue
	} else {
	    set linkqueue $fromqueue
	}
	set limit_ [$linkqueue set limit_]
	set maxthresh_ [$linkqueue set maxthresh_]
	set thresh_ [$linkqueue set thresh_]
	set q_weight_ [$linkqueue set q_weight_]
	set linterm_ [$linkqueue set linterm_]
	set queue-in-bytes_ [$linkqueue set queue-in-bytes_]
	if {${queue-in-bytes_} == "true"} {
	    set queue-in-bytes_ 1
	} elseif {${queue-in-bytes_} == "false"} {
	    set queue-in-bytes_ 0
	}
	set bytes_ [$linkqueue set bytes_]
	if {$bytes_ == "true"} {
	    set bytes_ 1
	} elseif {$bytes_ == "false"} {
	    set bytes_ 0
	}
	set mean_pktsize_ [$linkqueue set mean_pktsize_]
	set red_ [$linkqueue set red_]
	if {$red_ == "true"} {
	    set red_ 1
	} elseif {$red_ == "false"} {
	    set red_ 0
	}
	set gentle_ [$linkqueue set gentle_]
	if {$gentle_ == "true"} {
	    set gentle_ 1
	} elseif {$gentle_ == "false"} {
	    set gentle_ 0
	}
	set wait_ [$linkqueue set wait_]
	set setbit_ [$linkqueue set setbit_]
	set droptail_ [$linkqueue set drop-tail_]
	
	set nodeportraw [join $nodeport ":"]
	sql exec $DB "update virt_lans set q_limit=$limit_, q_maxthresh=$maxthresh_, q_minthresh=$thresh_, q_weight=$q_weight_, q_linterm=$linterm_, q_qinbytes=${queue-in-bytes_}, q_bytes=$bytes_, q_meanpsize=$mean_pktsize_, q_wait=$wait_, q_setbit=$setbit_, q_droptail=$droptail_, q_red=$red_, q_gentle=$gentle_ where pid=\"$pid\" and eid=\"$eid\" and vname=\"$self\" and member=\"$nodeportraw\""
    }
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
365 366 367 368 369
# updatedb DB
# This adds a row to the virt_lans table.
LanLink instproc updatedb {DB} {
    $self instvar nodelist
    $self instvar bandwidth
370
    $self instvar rbandwidth
Leigh B. Stoller's avatar
Leigh B. Stoller committed
371
    $self instvar delay
372
    $self instvar rdelay
Leigh B. Stoller's avatar
Leigh B. Stoller committed
373
    $self instvar loss
374
    $self instvar rloss
375
    $self instvar cost
376
    $self instvar widearea
Leigh B. Stoller's avatar
Leigh B. Stoller committed
377 378 379 380 381
    var_import ::GLOBALS::pid
    var_import ::GLOBALS::eid

    foreach nodeport $nodelist {
	set nodeportraw [join $nodeport ":"]
382
	sql exec $DB "insert into virt_lans (pid,eid,vname,member,delay,rdelay,bandwidth,rbandwidth,lossrate,rlossrate,cost,widearea) values (\"$pid\",\"$eid\",\"$self\",\"$nodeportraw\",$delay($nodeport),$rdelay($nodeport),$bandwidth($nodeport),$rbandwidth($nodeport),$loss($nodeport),$rloss($nodeport),$cost($nodeport),$widearea)"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
383 384
    }
}