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
302
		"reset" {
		    set etype RESET
		}
303
304
                "set" {
		    if {[llength $event] < 4} {
305
			perror "Wrong number of arguments: at $time $event"
306
307
308
309
310
311
312
313
314
			return
		    }
		    set etype MODIFY
	            set arg [lindex $event 3]
                    switch -- [lindex $event 2] {
                        "packetSize_" {
	                    set args  "PACKETSIZE=$arg"
                        }
                        "rate_" {
315
316
			    set bw [parse_bw $arg]
	                    set args  "RATE=$bw"
317
318
319
320
321
322
323
324
325
326
                        }
                        "interval_" {
	                    set args  "INTERVAL=$arg"
                        }
			unknown {
		            punsup "at $time $event"
		            return
			}
		    }
                }
327
328
329
330
331
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
332
333
	    set vnode [$obj get_node]
	    set vname $obj
334
	}
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
	"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
	}
355
356
357
	"Link" {
	    set otype LINK
	    switch -- $cmd {
358
359
360
361
		"up"	    {set etype UP}
		"down"	    {set etype DOWN}
		"bandwidth" {
		    if {[llength $event] < 4} {
362
			perror "Wrong number of arguments: at $time $event"
363
364
			return
		    }
365
                    set arg   [lindex $event 2]
366
367
		    set bw [parse_bw $arg]
                    set args  "BANDWIDTH=$bw"
368
369
370
371
		    set etype MODIFY
		}
		"delay" {
		    if {[llength $event] < 3} {
372
			perror "Wrong number of arguments: at $time $event"
373
374
375
376
			return
		    }
                    set arg   [lindex $event 2]
                    set args  "DELAY=$arg"
377
378
		    set etype MODIFY
		}
379
380
		"plr" {
		    if {[llength $event] < 3} {
381
			perror "Wrong number of arguments: at $time $event"
382
383
384
385
			return
		    }
                    if {[scan [lindex $event 2] "%f" plr] != 1 ||
                        $plr < 0 || $plr > 1} {
386
			perror "Improper argument: at $time $event"
387
388
389
390
391
			return
                    }
                    set args  "PLR=$plr"
		    set etype MODIFY
		}
392
393
394
395
396
397
398
399
400
401
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
	    set vnode {}
	    set vname $obj
	}
	"Queue" {
	    set otype LINK
402
	    set pipe [$obj get_pipe]
403
404
405
	    set obj [$obj get_link]
	    switch -- $cmd {
                "set" {
406
		    if {[llength $event] < 4} {
407
			perror "Wrong number of arguments: at $time $event"
408
409
410
			return
		    }
		    set etype MODIFY
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
	            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
433
	                    set args  "Q_WEIGHT=$w"
434
435
436
437
438
                        }
			unknown {
		            punsup "at $time $event"
		            return
			}
439
		    }
440
                }
441
442
443
444
445
		unknown {
		    punsup "at $time $event"
		    return
		}
	    }
446
	    set args "PIPE=$pipe $args"
447
448
449
	    set vnode {}
	    set vname $obj
	}
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
477
478
479
	"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
	}
480
481
482
	"Simulator" {
	    switch -- $cmd {
		"bandwidth" {
483
		    set otype LINK
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
		    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
	}
    }
500
    set event_count [expr $event_count + 1]
501
    lappend event_list [list $time $vnode $vname $otype $etype $args $atstring]
502
  }
503
504
}

505
506
507
508
509
510
511
512
513
514
515
516
#
# 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
517
518
    } elseif {($type == "Manual")} {
	set default_ip_routing_type "manual"
519
520
521
522
523
524
    } else {
	punsup "rtproto: unsupported routing protocol ignored: $type"
	return
    }
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
525
526
527
528
529
530
531
# 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
532
    punsup "Object $m"
Leigh B. Stoller's avatar
Leigh B. Stoller committed
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
558
559
560
    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) {}
}

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

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

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

# 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) {}
617
}
618

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