lanlink.tcl 14 KB
Newer Older
1
# -*- tcl -*-
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
3
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5
6
7
# All rights reserved.
#

Leigh B. Stoller's avatar
Leigh B. Stoller committed
8
9
10
11
12
13
14
15
16
17
18
19
20
######################################################################
# 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
21
Class Queue -superclass NSObject
22
23
24
# 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
25
26
# Ditto, another hack class.
Class LLink -superclass NSObject
Leigh B. Stoller's avatar
Leigh B. Stoller committed
27

28
29
30
31
32
33
34
35
36
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]
}
37
38
39
40
41
42
43
44
45
46
47
48
LLink instproc init {lan node} {
    $self set mylan  $lan
    $self set mynode $node
}
LLink instproc queue {} {
    $self instvar mylan
    $self instvar mynode

    set port [$mylan get_port $mynode]
    
    return [$mylan set linkq([list $mynode $port])]
}
49
50
51
52
# 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} {
53
54
    $self set mylink $link
    
55
56
57
58
59

    # 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

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
    # 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"} {
90
	    punsup "Link type $type, using DropTail!"
91
92
93
94
	}
    }
}

95
96
97
98
99
100
101
102
103
104
105
106
Queue instproc rename_lanlink {old new} {
    $self instvar mylink

    set mylink $new
}

Queue instproc get_link {} {
    $self instvar mylink

    return $mylink
}

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
# 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
}

122
123
124
125
126
127
128
129
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
130

131
132
133
134
135
136
137
138
    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
139
140
141
}

LanLink instproc init {s nodes bw d type} {
142
143
    var_import GLOBALS::new_counter

Leigh B. Stoller's avatar
Leigh B. Stoller committed
144
145
146
147
148
149
    # This is a list of {node port} pairs.
    $self set nodelist {}

    # The simulator
    $self set sim $s

150
151
152
    # By default, a local link
    $self set widearea 0

153
154
155
156
157
158
159
160
161
    # Allow user to control whether link gets a linkdelay, if link is shaped.
    # If not shaped, and user sets this variable, a link delay is inserted
    # anyway on the assumption that user wants later control over the link.
    # Both lans and links can get linkdelays.     
    $self set uselinkdelay 0

    # Allow user to control if link is emulated. Only links, not lans.
    $self set emulated 0

162
    # Allow user to turn off actual bw shaping on emulated links. Not lans.
163
164
    $self set nobwshaping 0

165
166
167
    # Allow user to turn on veth devices on emulated links. Not lans.
    $self set useveth 0

168
169
170
171
172
173
174
175
176
177
178
179
    # A simulated lanlink unless we find otherwise
    $self set simulated 1
    # Figure out if this is a lanlink that has at least
    # 1 non-simulated node in it. 
    foreach node $nodes {
	if { [$node set simulated] == 0 } {
	    $self set simulated 0
	    break
	}
    }
    

180
181
182
183
184
    # Make sure BW is reasonable. 
    # XXX: Should come from DB instead of hardwired max.
    # Measured in kbps
    set maxbw 100000

185
186
187
188
    # XXX skip this check for a simulated lanlink even if it
    # causes nse to not keep up with real time. The actual max
    # for simulated links will be added later
    if { [$self set simulated] != 1 && $bw > $maxbw } {
189
190
191
192
	perror "Bandwidth requested ($bw) exceeds maximum of $maxbw kbps!"
	return
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
193
194
    # Now we need to fill out the nodelist
    $self instvar nodelist
195
196

    # r* indicates the switch->node chars, others are node->switch
Leigh B. Stoller's avatar
Leigh B. Stoller committed
197
    $self instvar bandwidth
198
    $self instvar rbandwidth
Leigh B. Stoller's avatar
Leigh B. Stoller committed
199
    $self instvar delay
200
    $self instvar rdelay
Leigh B. Stoller's avatar
Leigh B. Stoller committed
201
    $self instvar loss
202
    $self instvar rloss
203
    $self instvar cost
204
    $self instvar linkq
205

Leigh B. Stoller's avatar
Leigh B. Stoller committed
206
207
208
    foreach node $nodes {
	set nodepair [list $node [$node add_lanlink $self]]
	set bandwidth($nodepair) $bw
209
	set rbandwidth($nodepair) $bw
210
	set delay($nodepair) [expr $d / 2.0]
211
	set rdelay($nodepair) [expr $d / 2.0]
Leigh B. Stoller's avatar
Leigh B. Stoller committed
212
	set loss($nodepair) 0
213
	set rloss($nodepair) 0
214
	set cost($nodepair) 1
Leigh B. Stoller's avatar
Leigh B. Stoller committed
215
	lappend nodelist $nodepair
216
217
218
219

	set lq q[incr new_counter]
	Queue lq$lq $self $type to
	set linkq($nodepair) lq$lq
Leigh B. Stoller's avatar
Leigh B. Stoller committed
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
    }
}

# 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
245
    $self instvar widearea
246
    set isremote 0
Leigh B. Stoller's avatar
Leigh B. Stoller committed
247
248
249
250
251
252
253
254

    # 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]
255
	set isremote [expr $isremote + [$node set isremote]]
Leigh B. Stoller's avatar
Leigh B. Stoller committed
256
	if {$ip != {}} {
257
	    if {$isremote} {
258
		perror "Not allowed to specify IP subnet of a remote link!"
259
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
260
261
262
263
	    set subnet [join [lrange [split $ip .] 0 2] .]
	    set ips($ip) 1
	}
    }
264
265
266
267
    if {$isremote && [$self info class] != "Link"} {
	perror "Not allowed to use a remote node in lan $self!"
	return
    }
268
    set widearea $isremote
Leigh B. Stoller's avatar
Leigh B. Stoller committed
269
270
271

    # If we couldn't find a subnet we ask the Simulator for one.
    if {$subnet == {}} {
272
273
274
275
276
	if {$isremote} {
	    set subnet [$sim get_subnet_remote]
	} else {
	    set subnet [$sim get_subnet]
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
    }

    # 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 == {}} {
295
		perror "Ran out of IP addresses in subnet $subnet."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
296
297
298
299
300
301
302
		set ip "255.255.255.255"
	    }
	    $node ip $port $ip
	}
    }
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
303
304
305
306
307
308
309
310
311
312
313
314
315
#
# 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]
}

316
317
318
319
320
321
322
323
324
325
326
327
328
#
# 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
    }
}


329
330
331
332
333
334
335
336
337
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
338
339
340
341
342
343
344
# 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
    }
345
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
346
347
348
349
350
351
352
    [$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
353
354
355
    $self instvar rbandwidth
    $self instvar rdelay
    $self instvar rloss
Leigh B. Stoller's avatar
Leigh B. Stoller committed
356
357
358
359
360
361
362
363
364
365
366
367
368
    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)
369
370
371
	set rbandwidth($newnodeport) $rbandwidth($nodeport)
	set rdelay($newnodeport) $rdelay($nodeport)
	set rloss($newnodeport) $rloss($nodeport)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
372
373
374
	unset bandwidth($nodeport)
	unset delay($nodeport)
	unset loss($nodeport)
375
376
377
	unset rbandwidth($nodeport)
	unset rdelay($nodeport)
	unset rloss($nodeport)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
378
379
380
381
    }
    set nodelist $newnodelist
}

382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
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_]
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
	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\""
    }
}

Lan instproc updatedb {DB} {
    $self next $DB
    $self instvar nodelist
    $self instvar linkq
    var_import ::GLOBALS::pid
    var_import ::GLOBALS::eid

    foreach nodeport $nodelist {
	set linkqueue $linkq($nodeport)
	set limit_ [$linkqueue set limit_]
	set maxthresh_ [$linkqueue set maxthresh_]
	set thresh_ [$linkqueue set thresh_]
	set q_weight_ [$linkqueue set q_weight_]
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
	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
485
486
487
488
489
# updatedb DB
# This adds a row to the virt_lans table.
LanLink instproc updatedb {DB} {
    $self instvar nodelist
    $self instvar bandwidth
490
    $self instvar rbandwidth
Leigh B. Stoller's avatar
Leigh B. Stoller committed
491
    $self instvar delay
492
    $self instvar rdelay
Leigh B. Stoller's avatar
Leigh B. Stoller committed
493
    $self instvar loss
494
    $self instvar rloss
495
    $self instvar cost
496
    $self instvar widearea
497
498
    $self instvar uselinkdelay
    $self instvar emulated
499
    $self instvar nobwshaping
500
    $self instvar useveth
Leigh B. Stoller's avatar
Leigh B. Stoller committed
501
502
503
504
505
    var_import ::GLOBALS::pid
    var_import ::GLOBALS::eid

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