sim.tcl.in 21.6 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

    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 {
225
	    append modified_nodelist "$node "
226
227
228
	    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
287
    var_import ::TBCOMPAT::uselatestwadata
Leigh B. Stoller's avatar
Leigh B. Stoller committed
288
289
290
291
292
293
294
295
296
297
298
299

    # 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]} {
300
	    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
301
302
303
304
	}
    }
    foreach lan [lsort [array names lanlink_list]] {
	if {! [regexp {^[-0-9A-Za-z]+$} $lan]} {
305
	    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
306
307
308
	}
    }

309
310
311
312
313
314
315
    # 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."
	}
    }

316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
    # 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
332
333
334
335
336
337
338
339
340
341
342
343
344
    # 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
    }
345
346
347
    foreach vtype [array names vtypes] {
	$vtype updatedb $DB
    }
348
349
350
    foreach prog [array names prog_list] {
	$prog updatedb $DB
    }
351
352
353

    sql exec $DB "update experiments set uselatestwadata=$uselatestwadata where pid='$pid' and eid='$eid'"
    sql endquery $DB
354
355
    
    foreach event $event_list {
356
	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]\")"
357
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
358
359
360
361
362
}

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

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

    # 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 ""
    }

383
    $node attach-agent $agent
Leigh B. Stoller's avatar
Leigh B. Stoller committed
384
385
386
387
388
389
390
}

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

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

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

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

427
428
429
430
    if {$event_count > 4000} {
	perror "Too many events in your NS file!"
	exit 1
    }
431
    set eventlist [split $eventstring ";"]
432

433
  foreach event $eventlist {
434
435
436
    # Check otype/command
    set obj [lindex $event 0]
    set cmd [lindex $event 1]
437
    set atstring "$event"
438
    set args {}
439
440
441
442
443
    set okargs 0
    switch -- [$obj info class] {
	"Application/Traffic/CBR" {
	    set otype TRAFGEN
	    switch -- $cmd {
444
445
446
447
448
449
450
451
		"start" {
                    set params [$obj get_params]
		    set etype START
		    set args  $params
		}
		"stop" {
		    set etype STOP
		}
452
453
454
		"reset" {
		    set etype RESET
		}
455
456
                "set" {
		    if {[llength $event] < 4} {
457
			perror "Wrong number of arguments: at $time $event"
458
459
460
461
462
463
464
465
466
			return
		    }
		    set etype MODIFY
	            set arg [lindex $event 3]
                    switch -- [lindex $event 2] {
                        "packetSize_" {
	                    set args  "PACKETSIZE=$arg"
                        }
                        "rate_" {
467
468
			    set bw [parse_bw $arg]
	                    set args  "RATE=$bw"
469
470
471
472
473
474
475
476
477
478
                        }
                        "interval_" {
	                    set args  "INTERVAL=$arg"
                        }
			unknown {
		            punsup "at $time $event"
		            return
			}
		    }
                }
479
480
481
482
483
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
484
485
	    set vnode [$obj get_node]
	    set vname $obj
486
	}
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
	"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
	}
507
508
509
	"Link" {
	    set otype LINK
	    switch -- $cmd {
510
511
512
513
		"up"	    {set etype UP}
		"down"	    {set etype DOWN}
		"bandwidth" {
		    if {[llength $event] < 4} {
514
			perror "Wrong number of arguments: at $time $event"
515
516
			return
		    }
517
                    set arg   [lindex $event 2]
518
519
		    set bw [parse_bw $arg]
                    set args  "BANDWIDTH=$bw"
520
521
522
523
		    set etype MODIFY
		}
		"delay" {
		    if {[llength $event] < 3} {
524
			perror "Wrong number of arguments: at $time $event"
525
526
527
528
			return
		    }
                    set arg   [lindex $event 2]
                    set args  "DELAY=$arg"
529
530
		    set etype MODIFY
		}
531
532
		"plr" {
		    if {[llength $event] < 3} {
533
			perror "Wrong number of arguments: at $time $event"
534
535
536
537
			return
		    }
                    if {[scan [lindex $event 2] "%f" plr] != 1 ||
                        $plr < 0 || $plr > 1} {
538
			perror "Improper argument: at $time $event"
539
540
541
542
543
			return
                    }
                    set args  "PLR=$plr"
		    set etype MODIFY
		}
544
545
546
547
548
549
550
551
552
553
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
	    set vnode {}
	    set vname $obj
	}
	"Queue" {
	    set otype LINK
554
	    set pipe [$obj get_pipe]
555
556
557
	    set obj [$obj get_link]
	    switch -- $cmd {
                "set" {
558
		    if {[llength $event] < 4} {
559
			perror "Wrong number of arguments: at $time $event"
560
561
562
			return
		    }
		    set etype MODIFY
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
	            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
585
	                    set args  "Q_WEIGHT=$w"
586
587
588
589
590
                        }
			unknown {
		            punsup "at $time $event"
		            return
			}
591
		    }
592
                }
593
594
595
596
597
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
598
	    set args "PIPE=$pipe $args"
599
600
601
	    set vnode {}
	    set vname $obj
	}
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
628
629
630
631
	"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
	}
632
633
634
	"Simulator" {
	    switch -- $cmd {
		"bandwidth" {
635
		    set otype LINK
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
		    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
	}
    }
652
    set event_count [expr $event_count + 1]
653
    lappend event_list [list $time $vnode $vname $otype $etype $args $atstring]
654
  }
655
656
}

657
#
658
# Routing control.
659
660
661
#
Simulator instproc rtproto {type args} {
    var_import ::GLOBALS::default_ip_routing_type
662
663
664
665
666
667
668
    var_import ::GLOBALS::simulated
    var_import ::GLOBALS::curnsenode

    # ignore at statement for simulated case
    if { $simulated == 1 } {
	return
    }
669
670
671
672
673
674
675

    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
676
677
    } elseif {($type == "Manual")} {
	set default_ip_routing_type "manual"
678
679
    } elseif {($type == "Static")} {
	set default_ip_routing_type "static"
680
681
682
683
684
685
    } else {
	punsup "rtproto: unsupported routing protocol ignored: $type"
	return
    }
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
686
687
688
689
690
691
692
# 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
693
    punsup "Object $m"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
    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
718
719
720
721
722
723

    # 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
724
725
}

726
727
728
729
730
731
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
732
733
734
735
736
737
738
739
740
741
742
743
# 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 ""
    }
}

744
745
Simulator instproc link {src dst} {
    set reallink [$self find_link $src $dst]
746
747
748
749
750
751
752
753
754
755
756
	
    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]
757
758
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
759
760
761
762
763
764
765
766
767
768
769
770
771
772
# 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
	}
    }
773
    perror "Ran out of subnets."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
774
775
}

776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
# get_subnet_remote
# 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_remote {} {
    var_import ::GLOBALS::DB
    var_import ::GLOBALS::pid
    var_import ::GLOBALS::eid

    sql exec $DB "insert into ipsubnets values ('$pid','$eid', NULL)"
    sql endquery $DB
    sql query $DB "select LAST_INSERT_ID() from ipsubnets"
    set row [sql fetchrow $DB]
    sql endquery $DB

    set b [expr [expr $row & 0xff00] >> 8]
    set c [expr $row & 0xff]
    return 10.$b.$c
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
795
796
797
798
799
800
# 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) {}
801
}
802

803
804
805
# add_program
# Link to a new program object.
Simulator instproc add_program {prog} {
806
    $self instvar prog_list
807
    set prog_list($prog) {}
808
}
809
810
811
812
813
814
815

# 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
}