sim.tcl.in 16.5 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 {}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
54
55
56
57
58
59
60
61
62
63
}

# 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
    $self instvar id_counter
    $self instvar node_list

64
65
    if {($args != {})} {
	punsup "Arguments for node: $args"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
    }
    
    set curnode n[incr id_counter]
    Node $curnode $self
    set node_list($curnode) {}
    set last_class $curnode

    return $curnode
}

# 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
    $self instvar id_counter
    $self instvar lanlink_list
    $self instvar link_map

86
87
    if {($args != {})} {
	punsup "Arguments for duplex-link: $args"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
88
89
90
    }
    set error 0
    if {! [$n1 info class Node]} {
91
	perror "\[duplex-link] $n1 is not a node."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
92
93
94
	set error 1
    }
    if {! [$n2 info class Node]} {
95
	perror "\[duplex-link] $n2 is not a node."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
96
97
98
99
100
101
102
103
104
105
	set error 1
    }
    if {$error} {return}

    set curlink l[incr id_counter]

    # Convert bandwidth and delay
    set rbw [parse_bw $bw]
    set rdelay [parse_delay $delay]
    
106
    Link $curlink $self "$n1 $n2" $rbw $rdelay $type
Leigh B. Stoller's avatar
Leigh B. Stoller committed
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
    set lanlink_list($curlink) {}
    set link_map($n1:$n2) $curlink
    set link_map($n2:$n1) $curlink

    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
    $self instvar id_counter
    $self instvar lanlink_list

124
125
    if {($args != {})} {
	punsup "Arguments for make-lan: $args"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
126
127
128
129
130
131
132
133
    }
    
    set curlan lan[incr id_counter]
    
    # Convert bandwidth and delay
    set rbw [parse_bw $bw]
    set rdelay [parse_delay $delay]
    
134
    Lan $curlan $self $nodelist $rbw $rdelay {}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
135
136
137
138
139
140
141
142
143
144
145
146
147
148
    set lanlink_list($curlan) {}
    set last_class $curlan

    return $curlan
}

# 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
149
    $self instvar event_list
150
    $self instvar prog_list
151
152
    var_import ::GLOBALS::pid
    var_import ::GLOBALS::eid
Leigh B. Stoller's avatar
Leigh B. Stoller committed
153
154
155
156
157
    var_import ::GLOBALS::errors
    var_import ::GLOBALS::irfile
    var_import ::GLOBALS::ran
    var_import ::GLOBALS::DB
    var_import ::GLOBALS::impotent
158
    var_import ::GLOBALS::vtypes
Leigh B. Stoller's avatar
Leigh B. Stoller committed
159
160
161
162
163
164
165
166
167
168
169
170

    # 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]} {
171
	    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
172
173
174
175
	}
    }
    foreach lan [lsort [array names lanlink_list]] {
	if {! [regexp {^[-0-9A-Za-z]+$} $lan]} {
176
	    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
177
178
179
	}
    }

180
181
182
183
184
185
186
    # 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."
	}
    }

187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
    # 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
203
204
205
206
207
208
209
210
211
212
213
214
215
    # 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
    }
216
217
218
    foreach vtype [array names vtypes] {
	$vtype updatedb $DB
    }
219
220
221
    foreach prog [array names prog_list] {
	$prog updatedb $DB
    }
222
223
    
    foreach event $event_list {
224
	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]\")"
225
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
226
227
228
229
230
231
}

# attach-agent <node> <agent>
# This creates an attachment between <node> and <agent>.
Simulator instproc attach-agent {node agent} {
    if {! [$agent info class Agent]} {
232
	perror "\[attach-agent] $agent is not an Agent."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
233
234
235
	return
    }
    if {! [$node info class Node]} {
236
	perror "\[attach-agent] $node is not a Node."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
237
238
	return
    }
239
    $node attach-agent $agent
Leigh B. Stoller's avatar
Leigh B. Stoller committed
240
241
242
243
244
245
246
}

# connect <src> <dst>
# Connects two agents together.
Simulator instproc connect {src dst} {
    set error 0
    if {! [$src info class Agent]} {
247
	perror "\[connect] $src is not an Agent."
248
	set error 1OB
Leigh B. Stoller's avatar
Leigh B. Stoller committed
249
250
    }
    if {! [$dst info class Agent]} {
251
	perror "\[connect] $dst is not an Agent."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
252
253
254
255
256
257
258
	set error 1
    }
    if {$error} {return}
    $src connect $dst
    $dst connect $src
}

259
260
261
262
263
264
265
# at <time> <event>
# Known events:
#   <traffic> start
#   <traffic> stop
#   <link> up
#   <link> down
#   ...
266
Simulator instproc at {time eventstring} {
267
268
269
270
271
    # Check that time is float
    if {[regexp {(^[0-9]+(\.[0-9]+)?$)|(^\.[0-9]+$)} $time] == 0} {
	perror "Invalid time spec: $time"
	return
    }
272
    $self instvar event_list
273
    $self instvar event_count
274

275
276
277
278
    if {$event_count > 4000} {
	perror "Too many events in your NS file!"
	exit 1
    }
279
    set eventlist [split $eventstring ";"]
280

281
  foreach event $eventlist {
282
283
284
    # Check otype/command
    set obj [lindex $event 0]
    set cmd [lindex $event 1]
285
    set atstring "$event"
286
    set args {}
287
288
289
290
291
    set okargs 0
    switch -- [$obj info class] {
	"Application/Traffic/CBR" {
	    set otype TRAFGEN
	    switch -- $cmd {
292
293
294
295
296
297
298
299
		"start" {
                    set params [$obj get_params]
		    set etype START
		    set args  $params
		}
		"stop" {
		    set etype STOP
		}
300
301
                "set" {
		    if {[llength $event] < 4} {
302
			perror "Wrong number of arguments: at $time $event"
303
304
305
306
307
308
309
310
311
			return
		    }
		    set etype MODIFY
	            set arg [lindex $event 3]
                    switch -- [lindex $event 2] {
                        "packetSize_" {
	                    set args  "PACKETSIZE=$arg"
                        }
                        "rate_" {
312
313
			    set bw [parse_bw $arg]
	                    set args  "RATE=$bw"
314
315
316
317
318
319
320
321
322
323
                        }
                        "interval_" {
	                    set args  "INTERVAL=$arg"
                        }
			unknown {
		            punsup "at $time $event"
		            return
			}
		    }
                }
324
325
326
327
328
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
329
330
	    set vnode [$obj get_node]
	    set vname $obj
331
	}
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
	"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
	}
352
353
354
	"Link" {
	    set otype LINK
	    switch -- $cmd {
355
356
357
358
		"up"	    {set etype UP}
		"down"	    {set etype DOWN}
		"bandwidth" {
		    if {[llength $event] < 4} {
359
			perror "Wrong number of arguments: at $time $event"
360
361
			return
		    }
362
                    set arg   [lindex $event 2]
363
364
		    set bw [parse_bw $arg]
                    set args  "BANDWIDTH=$bw"
365
366
367
368
		    set etype MODIFY
		}
		"delay" {
		    if {[llength $event] < 3} {
369
			perror "Wrong number of arguments: at $time $event"
370
371
372
373
			return
		    }
                    set arg   [lindex $event 2]
                    set args  "DELAY=$arg"
374
375
		    set etype MODIFY
		}
376
377
		"plr" {
		    if {[llength $event] < 3} {
378
			perror "Wrong number of arguments: at $time $event"
379
380
381
382
			return
		    }
                    if {[scan [lindex $event 2] "%f" plr] != 1 ||
                        $plr < 0 || $plr > 1} {
383
			perror "Improper argument: at $time $event"
384
385
386
387
388
			return
                    }
                    set args  "PLR=$plr"
		    set etype MODIFY
		}
389
390
391
392
393
394
395
396
397
398
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
	    set vnode {}
	    set vname $obj
	}
	"Queue" {
	    set otype LINK
399
	    set pipe [$obj get_pipe]
400
401
402
	    set obj [$obj get_link]
	    switch -- $cmd {
                "set" {
403
		    if {[llength $event] < 4} {
404
			perror "Wrong number of arguments: at $time $event"
405
406
407
			return
		    }
		    set etype MODIFY
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
	            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
430
	                    set args  "Q_WEIGHT=$w"
431
432
433
434
435
                        }
			unknown {
		            punsup "at $time $event"
		            return
			}
436
		    }
437
                }
438
439
440
441
442
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
443
	    set args "PIPE=$pipe $args"
444
445
446
	    set vnode {}
	    set vname $obj
	}
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
	"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
	}
477
478
479
	"Simulator" {
	    switch -- $cmd {
		"bandwidth" {
480
		    set otype LINK
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
		    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
	}
    }
497
    set event_count [expr $event_count + 1]
498
    lappend event_list [list $time $vnode $vname $otype $etype $args $atstring]
499
  }
500
501
}

502
503
504
505
506
507
508
509
510
511
512
513
#
# Routing control. Right now, we do not support much at all.
#
Simulator instproc rtproto {type args} {
    var_import ::GLOBALS::default_ip_routing_type

    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
514
515
    } elseif {($type == "Manual")} {
	set default_ip_routing_type "manual"
516
517
518
519
520
521
    } else {
	punsup "rtproto: unsupported routing protocol ignored: $type"
	return
    }
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
522
523
524
525
526
527
528
# 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
529
    punsup "Object $m"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
    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
    unset node_list($old)
    set node_list($new) {}
}

558
559
560
561
562
563
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
564
565
566
567
568
569
570
571
572
573
574
575
# 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 ""
    }
}

576
577
Simulator instproc link {src dst} {
    set reallink [$self find_link $src $dst]
578
579
580
581
582
583
584
585
586
587
588
	
    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]
589
590
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
591
592
593
594
595
596
597
598
599
600
601
602
603
604
# 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
	}
    }
605
    perror "Ran out of subnets."
Leigh B. Stoller's avatar
Leigh B. Stoller committed
606
607
608
609
610
611
612
613
}

# 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) {}
614
}
615

616
617
618
# add_program
# Link to a new program object.
Simulator instproc add_program {prog} {
619
    $self instvar prog_list
620
    set prog_list($prog) {}
621
}