sim.tcl.in 21.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
    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]
195
196
197
	set vportlist [$simnode set nsenode_vportlist]
	lappend vportlist $vport
	$simnode set nsenode_vportlist $vportlist
198
199
    }
	
Leigh B. Stoller's avatar
Leigh B. Stoller committed
200
201
202
203
204
205
206
207
208
209
    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
210
211
    var_import ::GLOBALS::simulated
    var_import ::GLOBALS::curnsenode
Leigh B. Stoller's avatar
Leigh B. Stoller committed
212
213
214
    $self instvar id_counter
    $self instvar lanlink_list

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

    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 {
227
	    append modified_nodelist "$node "
228
229
230
	    set realnode_present 1
	}
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
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
262
263
    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
264

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

# 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
279
    $self instvar event_list
280
    $self instvar prog_list
281
282
    var_import ::GLOBALS::pid
    var_import ::GLOBALS::eid
Leigh B. Stoller's avatar
Leigh B. Stoller committed
283
284
285
286
287
    var_import ::GLOBALS::errors
    var_import ::GLOBALS::irfile
    var_import ::GLOBALS::ran
    var_import ::GLOBALS::DB
    var_import ::GLOBALS::impotent
288
    var_import ::GLOBALS::vtypes
289
    var_import ::GLOBALS::uselatestwadata
Leigh B. Stoller's avatar
Leigh B. Stoller committed
290
291
292
293
294
295
296
297
298
299
300
301

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

778
779
780
781
782
783
784
# 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
785
786
787
788
789
790
791
    var_import ::GLOBALS::impotent

    # If we are running in impotent mode, then no need for unique subnets
    if {$impotent == 1} {
	set subnet [$self get_subnet]
	return $subnet
    }
792
793
794
795
796
797
798
799
800
801
802
803

    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
804
805
806
807
808
809
# 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) {}
810
}
811

812
813
814
# add_program
# Link to a new program object.
Simulator instproc add_program {prog} {
815
    $self instvar prog_list
816
    set prog_list($prog) {}
817
}
818
819
820
821
822
823
824

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