lanlink.tcl 10.4 KB
Newer Older
1
# -*- tcl -*-
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
3
4
5
6
7
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2002 University of Utah and the Flux Group.
# 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
Leigh B. Stoller's avatar
Leigh B. Stoller committed
25

26
27
28
29
30
31
32
33
34
35
36
37
38
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} {
39
40
    $self set mylink $link
    
41
42
43
44
45

    # 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

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
    # 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"} {
76
	    punsup "Link type $type, using DropTail!"
77
78
79
80
	}
    }
}

81
82
83
84
85
86
87
88
89
90
91
92
Queue instproc rename_lanlink {old new} {
    $self instvar mylink

    set mylink $new
}

Queue instproc get_link {} {
    $self instvar mylink

    return $mylink
}

93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
# 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
}

108
109
110
111
112
113
114
115
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
116

117
118
119
120
121
122
123
124
    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
125
126
127
}

LanLink instproc init {s nodes bw d type} {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
128
129
130
131
132
133
    # This is a list of {node port} pairs.
    $self set nodelist {}

    # The simulator
    $self set sim $s

134
135
136
    # By default, a local link
    $self set widearea 0

Leigh B. Stoller's avatar
Leigh B. Stoller committed
137
138
    # Now we need to fill out the nodelist
    $self instvar nodelist
139
140

    # r* indicates the switch->node chars, others are node->switch
Leigh B. Stoller's avatar
Leigh B. Stoller committed
141
    $self instvar bandwidth
142
    $self instvar rbandwidth
Leigh B. Stoller's avatar
Leigh B. Stoller committed
143
    $self instvar delay
144
    $self instvar rdelay
Leigh B. Stoller's avatar
Leigh B. Stoller committed
145
    $self instvar loss
146
    $self instvar rloss
147
    $self instvar cost
148

Leigh B. Stoller's avatar
Leigh B. Stoller committed
149
150
151
    foreach node $nodes {
	set nodepair [list $node [$node add_lanlink $self]]
	set bandwidth($nodepair) $bw
152
	set rbandwidth($nodepair) $bw
153
	set delay($nodepair) [expr $d / 2.0]
154
	set rdelay($nodepair) [expr $d / 2.0]
Leigh B. Stoller's avatar
Leigh B. Stoller committed
155
	set loss($nodepair) 0
156
	set rloss($nodepair) 0
157
	set cost($nodepair) 1
Leigh B. Stoller's avatar
Leigh B. Stoller committed
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
	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
184
    $self instvar widearea
185
    set isremote 0
Leigh B. Stoller's avatar
Leigh B. Stoller committed
186
187
188
189
190
191
192
193

    # 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]
194
	set isremote [expr $isremote + [$node set isremote]]
Leigh B. Stoller's avatar
Leigh B. Stoller committed
195
	if {$ip != {}} {
196
	    if {$isremote} {
197
		perror "Not allowed to specify IP subnet of a remote link!"
198
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
199
200
201
202
	    set subnet [join [lrange [split $ip .] 0 2] .]
	    set ips($ip) 1
	}
    }
203
204
205
206
    if {$isremote && [$self info class] != "Link"} {
	perror "Not allowed to use a remote node in lan $self!"
	return
    }
207
    set widearea $isremote
Leigh B. Stoller's avatar
Leigh B. Stoller committed
208
209
210

    # If we couldn't find a subnet we ask the Simulator for one.
    if {$subnet == {}} {
211
212
213
214
215
	if {$isremote} {
	    set subnet [$sim get_subnet_remote]
	} else {
	    set subnet [$sim get_subnet]
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
    }

    # 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 == {}} {
234
		perror "Ran out of IP addresses in subnet $subnet."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
235
236
237
238
239
240
241
		set ip "255.255.255.255"
	    }
	    $node ip $port $ip
	}
    }
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
242
243
244
245
246
247
248
249
250
251
252
253
254
#
# 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]
}

255
256
257
258
259
260
261
262
263
264
265
266
267
#
# 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
    }
}


268
269
270
271
272
273
274
275
276
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
277
278
279
280
281
282
283
# 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
    }
284
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
285
286
287
288
289
290
291
    [$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
292
293
294
    $self instvar rbandwidth
    $self instvar rdelay
    $self instvar rloss
Leigh B. Stoller's avatar
Leigh B. Stoller committed
295
296
297
298
299
300
301
302
303
304
305
306
307
    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)
308
309
310
	set rbandwidth($newnodeport) $rbandwidth($nodeport)
	set rdelay($newnodeport) $rdelay($nodeport)
	set rloss($newnodeport) $rloss($nodeport)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
311
312
313
	unset bandwidth($nodeport)
	unset delay($nodeport)
	unset loss($nodeport)
314
315
316
	unset rbandwidth($nodeport)
	unset rdelay($nodeport)
	unset rloss($nodeport)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
317
318
319
320
    }
    set nodelist $newnodelist
}

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
365
366
367
368
369
370
371
372
373
374
375
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
376
377
378
379
380
# updatedb DB
# This adds a row to the virt_lans table.
LanLink instproc updatedb {DB} {
    $self instvar nodelist
    $self instvar bandwidth
381
    $self instvar rbandwidth
Leigh B. Stoller's avatar
Leigh B. Stoller committed
382
    $self instvar delay
383
    $self instvar rdelay
Leigh B. Stoller's avatar
Leigh B. Stoller committed
384
    $self instvar loss
385
    $self instvar rloss
386
    $self instvar cost
387
    $self instvar widearea
Leigh B. Stoller's avatar
Leigh B. Stoller committed
388
389
390
391
392
    var_import ::GLOBALS::pid
    var_import ::GLOBALS::eid

    foreach nodeport $nodelist {
	set nodeportraw [join $nodeport ":"]
393
	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
394
395
    }
}