sim.tcl.in 20.8 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
14
15
16
17
######################################################################
# sim.tcl
#
# Defines the Simulator class.  For our purpose a Simulator is a
# topology.  This contains a number nodes, lans, and links.  It
# provides methods for the creation of these objects as well as
# routines to locate the objects.  It also stores common state (such
# as IP subnet usage).  Finally it defines the import 'run' method
# which causes all remaining calculations to be done and updates the
# DB state.
#
# Note: Although NS distinguishs between LANs and Links, we do not.
# We merge both types of objects into a single one called LanLink.  
# See lanlink.tcl and README for more information.
######################################################################

Class Simulator
18
Class Program -superclass NSObject
Leigh B. Stoller's avatar
Leigh B. Stoller committed
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

Simulator instproc init {args} {
    # A counter for internal ids
    $self set id_counter 0

    # A counter for subnets.  This is the lowest unused subnet
    # suffix.
    $self set subnet_counter 1

    # This is the prefix used to fill any unassigned IP addresses.
    $self set subnet_base "@IPBASE@"

    # The following are sets.  I.e. they map to no value, all
    # we care about is membership.
    $self instvar node_list;		# Indexed by node id
    array set node_list {}
    $self instvar lanlink_list;		# Indexed by lanlink id
    array set lanlink_list {}
    $self instvar subnets;		# Indexed by IP subnet
    array set subnets {}

    # link_map is indexed by <node1>:<node2> and contains the
    # id of the lanlink connecting them.  In the case of
    # multiple links between two nodes this contains
    # the last one created.
    $self instvar link_map
    array set link_map {}
46
47
48

    # event list is a list of {time vnode vname otype etype args atstring}
    $self set event_list {}
49
    $self set event_count 0
50
51
52
53

    # Program list.
    $self instvar prog_list;
    array set prog_list {}
54
55
56
57
58
59
60
61
62

    var_import ::GLOBALS::last_class
    set last_class $self
}

# renaming the simulator instance
# needed to find the name of the instance
# for use in NSE code
Simulator instproc rename {old new} {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
63
64
65
66
67
68
69
}

# node
# This method adds a new node to the topology and returns the id
# of the node.
Simulator instproc node {args} {
    var_import ::GLOBALS::last_class
70
71
    var_import ::GLOBALS::simulated
    var_import ::GLOBALS::curnsenode
Leigh B. Stoller's avatar
Leigh B. Stoller committed
72
73
74
    $self instvar id_counter
    $self instvar node_list

75
76
    if {($args != {})} {
	punsup "Arguments for node: $args"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
77
78
79
80
    }
    
    set curnode n[incr id_counter]
    Node $curnode $self
81
82
83
84
85

    # not adding simulated nodes to the node_list
    if { $simulated == 0 } {
	set node_list($curnode) {}
    } 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
86
87
88
89
90
    set last_class $curnode

    return $curnode
}

91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
# nsenode
# this method does pretty much what the node proc does
# with some XXXXX
Simulator instproc nsenode {args} {
    var_import ::GLOBALS::last_class
    var_import ::GLOBALS::simulated
    var_import ::GLOBALS::curnsenode
    $self instvar id_counter
    $self instvar node_list

    if {($args != {})} {
	punsup "Arguments for node: $args"
    }
    
    set curnode n[incr id_counter]
    NSENode $curnode $self

    # not adding simulated nodes to the node_list
    if { $simulated == 0 } {
	set node_list($curnode) {}
    } else {
	$curnode set simulated 1
	$curnode set nsenode $curnsenode
    }
    set last_class $curnode

    return $curnode  
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
120
121
122
123
124
125
# duplex-link <node1> <node2> <bandwidth> <delay> <type>
# This adds a new link to the topology.  <bandwidth> can be in any
# form accepted by parse_bw and <delay> in any form accepted by
# parse_delay.  Currently only the type 'DropTail' is supported.
Simulator instproc duplex-link {n1 n2 bw delay type args} {
    var_import ::GLOBALS::last_class
126
127
    var_import ::GLOBALS::simulated
    var_import ::GLOBALS::curnsenode
Leigh B. Stoller's avatar
Leigh B. Stoller committed
128
129
130
131
    $self instvar id_counter
    $self instvar lanlink_list
    $self instvar link_map

132
133
    if {($args != {})} {
	punsup "Arguments for duplex-link: $args"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
134
135
136
    }
    set error 0
    if {! [$n1 info class Node]} {
137
	perror "\[duplex-link] $n1 is not a node."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
138
139
140
	set error 1
    }
    if {! [$n2 info class Node]} {
141
	perror "\[duplex-link] $n2 is not a node."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
142
143
144
145
146
147
148
149
	set error 1
    }
    if {$error} {return}

    # Convert bandwidth and delay
    set rbw [parse_bw $bw]
    set rdelay [parse_delay $delay]

150
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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
    set n1sim [$n1 set simulated]
    set n2sim [$n2 set simulated]
    set n1node $n1
    set n2node $n2
    set simnode ""

    # If one of the nodes is a real node, we
    # create a link between the real node and
    # the physical node corresponding to the
    # simulated node. If both are simulated
    # nodes, we don't need to do anything
    if { $n1sim == 1 && $n2sim == 0 } {
	set simnode $n1
	set n1node [$n1 set nsenode]
    } elseif { $n1sim == 0 && $n2sim == 1 } {
	set simnode $n2
	set n2node [$n2 set nsenode]
    } elseif { $n1sim == 1 && $n2sim == 1 } {
	return ""
    }

    # At this point we have one of the nodes of
    # the link to be real. We need to make sure
    # that this is not being defined in make-simulated.
    # In other words links or lans from real nodes and
    # simulated nodes should happen outside make-simulated
    if { $simulated == 1 } {
	set simulated 0
	perror "Please define links between real and simulated nodes outside make-simulated"
	set simulated 1
	return ""
    }

    set curlink l[incr id_counter]

    Link $curlink $self "$n1node $n2node" $rbw $rdelay $type	
    set lanlink_list($curlink) {}
    set link_map($n1node:$n2node) $curlink
    set link_map($n2node:$n1node) $curlink

    # get the vport number on nsenode on which we make
    # the link and store it in the simulated node that
    # goes into NSE
    if { $simnode != {} } {
	set vport [[$simnode set nsenode] find_port $curlink]
	$simnode set nsenode_vport $vport
    }
	
Leigh B. Stoller's avatar
Leigh B. Stoller committed
198
199
200
201
202
203
204
205
206
207
    set last_class $curlink
    return $curlink
}

# make-lan <nodelist> <bw> <delay>
# This adds a new lan to the topology. <bandwidth> can be in any
# form accepted by parse_bw and <delay> in any form accepted by
# parse_delay.
Simulator instproc make-lan {nodelist bw delay args} {
    var_import ::GLOBALS::last_class
208
209
    var_import ::GLOBALS::simulated
    var_import ::GLOBALS::curnsenode
Leigh B. Stoller's avatar
Leigh B. Stoller committed
210
211
212
    $self instvar id_counter
    $self instvar lanlink_list

213
214
    if {($args != {})} {
	punsup "Arguments for make-lan: $args"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
215
    }
216
217
218
219
220
221
222
223
224
225
226
227
228

    set modified_nodelist ""
    set realnode_present 0
    set simnode_list ""
    foreach node $nodelist {
	if { [$node set simulated] == 1 } {
	    append modified_nodelist [$node set nsenode]
	    append simnode_list $node
	} else {
	    append modified_nodelist $node
	    set realnode_present 1
	}
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
229
    
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
    if { $realnode_present == 1 } {


	# At this point we have one of the nodes of
	# the lan to be real. We need to make sure
	# that this is not being defined in make-simulated.
	# In other words links or lans from real nodes and
	# simulated nodes should happen outside make-simulated
	if { $simulated == 1 } {
	    set simulated 0
	    perror "Please define links between real and simulated nodes outside make-simulated"
	    set simulated 1
	    return ""
	}

	set curlan lan[incr id_counter]
	
	# Convert bandwidth and delay
	set rbw [parse_bw $bw]
	set rdelay [parse_delay $delay]
	
	Lan $curlan $self $modified_nodelist $rbw $rdelay {}
	set lanlink_list($curlan) {}
	set last_class $curlan
	
	# get the vport number on nsenode on which we make
	# the lan and store it in the simulated node that
	# goes into NSE
 	foreach simnode $simnode_list {
	    set vport [[$simnode set nsenode] find_port $curlan]
	    $simnode set nsenode_vport $vport
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
262

263
264
265
266
	return $curlan
    } else {
	return ""
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
267
268
269
270
271
272
273
274
275
276
}

# run
# This method causes the fill_ips method to be invoked on all 
# lanlinks and then, if not running in impotent mode, calls the
# updatedb method on all nodes and lanlinks.  Invocation of this
# method casues the 'ran' variable to be set to 1.
Simulator instproc run {} {
    $self instvar lanlink_list
    $self instvar node_list
277
    $self instvar event_list
278
    $self instvar prog_list
279
280
    var_import ::GLOBALS::pid
    var_import ::GLOBALS::eid
Leigh B. Stoller's avatar
Leigh B. Stoller committed
281
282
283
284
285
    var_import ::GLOBALS::errors
    var_import ::GLOBALS::irfile
    var_import ::GLOBALS::ran
    var_import ::GLOBALS::DB
    var_import ::GLOBALS::impotent
286
    var_import ::GLOBALS::vtypes
Leigh B. Stoller's avatar
Leigh B. Stoller committed
287
288
289
290
291
292
293
294
295
296
297
298

    # Fill out IPs
    foreach obj [concat [array names lanlink_list]] {
	$obj fill_ips
    }

    # Mark that a run statement exists
    set ran 1

    # Check node names.
    foreach node [lsort [array names node_list]] {
	if {! [regexp {^[-0-9A-Za-z]+$} $node]} {
299
	    perror "\[run] Invalid node name $node.  Can only contain \[-0-9A-Za-z\] due to DNS limitations."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
300
301
302
303
	}
    }
    foreach lan [lsort [array names lanlink_list]] {
	if {! [regexp {^[-0-9A-Za-z]+$} $lan]} {
304
	    perror "\[run] Invalid lan/link name $lan.  Can only contain \[-0-9A-Za-z\] for symmetry with node DNS limitations."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
305
306
307
	}
    }

308
309
310
311
312
313
314
    # Check for one node lans
    foreach lan [array names lanlink_list] {
	if {[llength [$lan set nodelist]] <= 1} {
	    perror "\[run] $lan has only a single node.  LANs must have at least 2 nodes in them."
	}
    }

315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
    # Load even indexes
    sql query $DB "select idx,type from event_objecttypes"
    while {[set row [sql fetchrow $DB]] != ""} {
	set idx [lindex $row 0]
	set type [lindex $row 1]
	set objtypes($type) $idx
    }
    sql endquery $DB
    sql query $DB "select idx,type from event_eventtypes"
    while {[set row [sql fetchrow $DB]] != ""} {
        set idx [lindex $row 0]
        set type [lindex $row 1]
        set eventtypes($type) $idx
    }
    sql endquery $DB

Leigh B. Stoller's avatar
Leigh B. Stoller committed
331
332
333
334
335
336
337
338
339
340
341
342
343
    # If any errors occur stop here.
    if {$errors == 1} {return}

    # If we are running in impotent mode we stop here
    if {$impotent == 1} {return}
    
    # Update the DB
    foreach node [lsort [array names node_list]] {
	$node updatedb $DB
    }
    foreach lan [concat [array names lanlink_list]] {
	$lan updatedb $DB
    }
344
345
346
    foreach vtype [array names vtypes] {
	$vtype updatedb $DB
    }
347
348
349
    foreach prog [array names prog_list] {
	$prog updatedb $DB
    }
350
351
    
    foreach event $event_list {
352
	sql exec $DB "insert into eventlist (pid,eid,time,vnode,vname,objecttype,eventtype,arguments,atstring) values (\"$pid\",\"$eid\",[lindex $event 0],\"[lindex $event 1]\",\"[lindex $event 2]\",$objtypes([lindex $event 3]),$eventtypes([lindex $event 4]),\"[lindex $event 5]\",\"[lindex $event 6]\")"
353
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
354
355
356
357
358
}

# attach-agent <node> <agent>
# This creates an attachment between <node> and <agent>.
Simulator instproc attach-agent {node agent} {
359
360
    var_import ::GLOBALS::simulated

Leigh B. Stoller's avatar
Leigh B. Stoller committed
361
    if {! [$agent info class Agent]} {
362
	perror "\[attach-agent] $agent is not an Agent."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
363
364
365
	return
    }
    if {! [$node info class Node]} {
366
	perror "\[attach-agent] $node is not a Node."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
367
368
	return
    }
369
370
371
372
373
374
375
376
377
378

    # If the node is real and yet this code is in make-simulated
    # we don't allow it
    if { [$node set simulated] == 0 && $simulated == 1 } {
	set simulated 0
	perror "Please attach agents on to real nodes outside make-simulated"
	set simulated 1
	return ""
    }

379
    $node attach-agent $agent
Leigh B. Stoller's avatar
Leigh B. Stoller committed
380
381
382
383
384
385
386
}

# connect <src> <dst>
# Connects two agents together.
Simulator instproc connect {src dst} {
    set error 0
    if {! [$src info class Agent]} {
387
	perror "\[connect] $src is not an Agent."
388
	set error 1
Leigh B. Stoller's avatar
Leigh B. Stoller committed
389
390
    }
    if {! [$dst info class Agent]} {
391
	perror "\[connect] $dst is not an Agent."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
392
393
394
395
396
397
398
	set error 1
    }
    if {$error} {return}
    $src connect $dst
    $dst connect $src
}

399
400
401
402
403
404
405
# at <time> <event>
# Known events:
#   <traffic> start
#   <traffic> stop
#   <link> up
#   <link> down
#   ...
406
Simulator instproc at {time eventstring} {
407
408
409
410
411
412
413
414
    var_import ::GLOBALS::simulated
    var_import ::GLOBALS::curnsenode

    # ignore at statement for simulated case
    if { $simulated == 1 } {
	return
    }

415
416
417
418
419
    # Check that time is float
    if {[regexp {(^[0-9]+(\.[0-9]+)?$)|(^\.[0-9]+$)} $time] == 0} {
	perror "Invalid time spec: $time"
	return
    }
420
    $self instvar event_list
421
    $self instvar event_count
422

423
424
425
426
    if {$event_count > 4000} {
	perror "Too many events in your NS file!"
	exit 1
    }
427
    set eventlist [split $eventstring ";"]
428

429
  foreach event $eventlist {
430
431
432
    # Check otype/command
    set obj [lindex $event 0]
    set cmd [lindex $event 1]
433
    set atstring "$event"
434
    set args {}
435
436
437
438
439
    set okargs 0
    switch -- [$obj info class] {
	"Application/Traffic/CBR" {
	    set otype TRAFGEN
	    switch -- $cmd {
440
441
442
443
444
445
446
447
		"start" {
                    set params [$obj get_params]
		    set etype START
		    set args  $params
		}
		"stop" {
		    set etype STOP
		}
448
449
450
		"reset" {
		    set etype RESET
		}
451
452
                "set" {
		    if {[llength $event] < 4} {
453
			perror "Wrong number of arguments: at $time $event"
454
455
456
457
458
459
460
461
462
			return
		    }
		    set etype MODIFY
	            set arg [lindex $event 3]
                    switch -- [lindex $event 2] {
                        "packetSize_" {
	                    set args  "PACKETSIZE=$arg"
                        }
                        "rate_" {
463
464
			    set bw [parse_bw $arg]
	                    set args  "RATE=$bw"
465
466
467
468
469
470
471
472
473
474
                        }
                        "interval_" {
	                    set args  "INTERVAL=$arg"
                        }
			unknown {
		            punsup "at $time $event"
		            return
			}
		    }
                }
475
476
477
478
479
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
480
481
	    set vnode [$obj get_node]
	    set vname $obj
482
	}
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
	"Agent/TCP/FullTcp" -
	"Agent/TCP/FullTcp/Reno" -
	"Agent/TCP/FullTcp/Newreno" -
	"Agent/TCP/FullTcp/Tahoe" -
	"Agent/TCP/FullTcp/Sack" - 
	"Application/FTP" -
	"Application/Telnet" {
	    # For events sent to NSE, we don't distinguish
	    # between START, STOP and MODIFY coz the entire
	    # string passed to '$ns at' is sent for evaluation to the node
	    # on which NSE is running: fix needed for the
	    # case when the above string has syntax errors. Maybe
	    # just have a way reporting errors back to the
	    # the user from the NSE that finds the syntax errors
	    set otype TRAFGEN
	    set etype MODIFY
	    set args "\$$obj $cmd [lrange $event 2 end]"
	    set vnode [$obj get_node]
	    set vname $obj
	}
503
504
505
	"Link" {
	    set otype LINK
	    switch -- $cmd {
506
507
508
509
		"up"	    {set etype UP}
		"down"	    {set etype DOWN}
		"bandwidth" {
		    if {[llength $event] < 4} {
510
			perror "Wrong number of arguments: at $time $event"
511
512
			return
		    }
513
                    set arg   [lindex $event 2]
514
515
		    set bw [parse_bw $arg]
                    set args  "BANDWIDTH=$bw"
516
517
518
519
		    set etype MODIFY
		}
		"delay" {
		    if {[llength $event] < 3} {
520
			perror "Wrong number of arguments: at $time $event"
521
522
523
524
			return
		    }
                    set arg   [lindex $event 2]
                    set args  "DELAY=$arg"
525
526
		    set etype MODIFY
		}
527
528
		"plr" {
		    if {[llength $event] < 3} {
529
			perror "Wrong number of arguments: at $time $event"
530
531
532
533
			return
		    }
                    if {[scan [lindex $event 2] "%f" plr] != 1 ||
                        $plr < 0 || $plr > 1} {
534
			perror "Improper argument: at $time $event"
535
536
537
538
539
			return
                    }
                    set args  "PLR=$plr"
		    set etype MODIFY
		}
540
541
542
543
544
545
546
547
548
549
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
	    set vnode {}
	    set vname $obj
	}
	"Queue" {
	    set otype LINK
550
	    set pipe [$obj get_pipe]
551
552
553
	    set obj [$obj get_link]
	    switch -- $cmd {
                "set" {
554
		    if {[llength $event] < 4} {
555
			perror "Wrong number of arguments: at $time $event"
556
557
558
			return
		    }
		    set etype MODIFY
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
	            set arg [lindex $event 3]
                    switch -- [lindex $event 2] {
                        "queue-in-bytes_" {
	                    set args  "QUEUE-IN-BYTES=$arg"
                        }
                        "limit_" {
	                    set args  "LIMIT=$arg"
                        }
                        "maxthresh_" {
	                    set args  "MAXTHRESH=$arg"
                        }
                        "thresh_" {
	                    set args  "THRESH=$arg"
                        }
                        "linterm_" {
	                    set args  "LINTERM=$arg"
                        }
                        "q_weight_" {
			    if {[scan $arg "%f" w] != 1} {
				perror "Improper argument: at $time $event"
				return
			    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
581
	                    set args  "Q_WEIGHT=$w"
582
583
584
585
586
                        }
			unknown {
		            punsup "at $time $event"
		            return
			}
587
		    }
588
                }
589
590
591
592
593
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
594
	    set args "PIPE=$pipe $args"
595
596
597
	    set vnode {}
	    set vname $obj
	}
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
	"Program" {
	    set otype PROGRAM
	    set vname $obj
	    set vnode [$obj set node]
    
	    switch -- $cmd {
		"start" {
		    set etype START
		    set arg  [$obj set command]
		    set args "COMMAND=$arg"
		}
		"stop" {
		    set etype STOP
		}
		"kill" {
		    set etype KILL
		    if {[llength $event] < 3} {
			perror "Wrong number of arguments: at $time $event"
			return
		    }
	            set arg [lindex $event 2]
		    set args "SIGNAL=$arg"
		}
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
	    set okargs 1
	}
628
629
630
	"Simulator" {
	    switch -- $cmd {
		"bandwidth" {
631
		    set otype LINK
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
		    set etype MODIFY
		}
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
	    set vnode {}
	    set vname {}
	    set okargs 1
	}
	unknown {
	    punsup "Unknown object type: at $time $event"
	    return
	}
    }
648
    set event_count [expr $event_count + 1]
649
    lappend event_list [list $time $vnode $vname $otype $etype $args $atstring]
650
  }
651
652
}

653
#
654
# Routing control.
655
656
657
#
Simulator instproc rtproto {type args} {
    var_import ::GLOBALS::default_ip_routing_type
658
659
660
661
662
663
664
    var_import ::GLOBALS::simulated
    var_import ::GLOBALS::curnsenode

    # ignore at statement for simulated case
    if { $simulated == 1 } {
	return
    }
665
666
667
668
669
670
671

    if {$args != {}} {
	punsup "rtproto: arguments ignored: $args"
    }

    if {($type == "Session") ||	($type == "ospf")} {
	set default_ip_routing_type "ospf"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
672
673
    } elseif {($type == "Manual")} {
	set default_ip_routing_type "manual"
674
675
    } elseif {($type == "Static")} {
	set default_ip_routing_type "static"
676
677
678
679
680
681
    } else {
	punsup "rtproto: unsupported routing protocol ignored: $type"
	return
    }
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
682
683
684
685
686
687
688
# unknown 
# This is invoked whenever any method is called on the simulator
# object that is not defined.  We interpret such a call to be a
# request to create an object of that type.  We create display an
# unsupported message and create a NullClass to fulfill the request.
Simulator instproc unknown {m args} {
    $self instvar id_counter
689
    punsup "Object $m"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
    NullClass null[incr id_counter] $m
}

# rename_* <old> <new>
# The following two procedures handle when an object is being renamed.
# They update the internal datastructures to reflect the new name.
Simulator instproc rename_lanlink {old new} {
    $self instvar lanlink_list
    $self instvar link_map

    unset lanlink_list($old)
    set lanlink_list($new) {}

    # In the case of a link we need to update the link_map as well.
    if {[$new info class] == "Link"} {
	$new instvar nodelist
	set src [lindex [lindex $nodelist 0] 0]
	set dst [lindex [lindex $nodelist 1] 0]
	set link_map($src:$dst) $new
	set link_map($dst:$src) $new
    }
}
Simulator instproc rename_node {old new} {
    $self instvar node_list
714
715
716
717
718
719

    # simulated nodes won't exist in the node_list
    if { [info exists node_list($old)] } {
	unset node_list($old)
	set node_list($new) {}
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
720
721
}

722
723
724
725
726
727
Simulator instproc rename_program {old new} {
    $self instvar prog_list
    unset prog_list($old)
    set prog_list($new) {}
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
728
729
730
731
732
733
734
735
736
737
738
739
# find_link <node1> <node2>
# This is just an accesor to the link_map datastructure.  If no
# link is known between <node1> and <node2> the empty list is returned.
Simulator instproc find_link {src dst} {
    $self instvar link_map
    if {[info exists link_map($src:$dst)]} {
	return $link_map($src:$dst)
    } else {
	return ""
    }
}

740
741
Simulator instproc link {src dst} {
    set reallink [$self find_link $src $dst]
742
743
744
745
746
747
748
749
750
751
752
	
    if {$src == [$reallink set src_node]} {
	set dir "to"
    } else {
	set dir "from"
    }
    
    var_import GLOBALS::new_counter
    set name sl[incr new_counter]
    
    return [SimplexLink $name $reallink $dir]
753
754
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
755
756
757
758
759
760
761
762
763
764
765
766
767
768
# get_subnet
# This is called by lanlinks.  When called get_subnet will find an available
# IP subnet, mark it as used, and return it to the caller.
Simulator instproc get_subnet {} {
    $self instvar subnet_base
    $self instvar subnets
    $self instvar subnet_counter

    for {set i $subnet_counter} {$i < 255} {incr i} {
	if {! [info exists subnets($subnet_base.$i)]} {
	    set subnet_counter $i
	    return $subnet_base.$i
	}
    }
769
    perror "Ran out of subnets."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
770
771
772
773
774
775
776
777
}

# use_subnet
# This is called by the ip method of nodes.  It marks the passed subnet
# as used and thus should never be returned by get_subnet.
Simulator instproc use_subnet {subnet} {
    $self instvar subnets
    set subnets($subnet) {}
778
}
779

780
781
782
# add_program
# Link to a new program object.
Simulator instproc add_program {prog} {
783
    $self instvar prog_list
784
    set prog_list($prog) {}
785
}
786
787
788
789
790
791
792

# cost
# Set the cost for a link
Simulator instproc cost {src dst c} {
    set reallink [$self find_link $src $dst]
    $reallink set cost([list $src [$reallink get_port $src]]) $c
}