File: test-suite-message.tcl

package info (click to toggle)
ns2 2.35%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 78,120 kB
  • sloc: cpp: 172,923; tcl: 107,127; perl: 6,391; sh: 6,143; ansic: 5,846; makefile: 812; awk: 525; csh: 355
file content (227 lines) | stat: -rw-r--r-- 6,767 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
# Copyright (c) 1995 The Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#	This product includes software developed by the Computer Systems
#	Engineering Group at Lawrence Berkeley Laboratory.
# 4. Neither the name of the University nor of the Laboratory may be used
#    to endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# Test message passing developed by Tim.
#
# Each agent keeps track of what messages it has seen
# and only forwards those which it hasn't seen before.

# Each message is of the form "ID:DATA" where ID is some arbitrary
# message identifier and DATA is the payload.  In order to reduce
# memory usage, the agent stores only the message ID.

# Note that I have not put in any mechanism to expire old message IDs
# from the list of seen messages.  There also isn't any standard mechanism
# for assigning message IDs.  An actual assignment may wish to have the
# students come up with solutions for these problems.

set MESSAGE_PORT 42

# subclass Agent/MessagePassing to make it do flooding

Class Agent/MessagePassing/Flooding -superclass Agent/MessagePassing

Agent/MessagePassing/Flooding instproc send_message {size msgid msg} {
    $self instvar messages_seen node_
    global MESSAGE_PORT

    #$ns trace-annotate "Node [$node_ node-addr] is sending {$msgid:$msg}"
    puts "Node [$node_ node-addr] is sending {$msgid:$msg}"

    lappend messages_seen $msgid
    $self send_to_neighbors -1 $MESSAGE_PORT $size "$msgid:$msg"
}

Agent/MessagePassing/Flooding instproc send_to_neighbors {skip port size data} {
    $self instvar node_

	foreach x [$node_ neighbors] {
	    set addr [$x set address_]
	    if {$addr != $skip} {
		$self sendto $size $data $addr $port
	    }
	}
}

Agent/MessagePassing/Flooding instproc recv {source sport size data} {
    $self instvar messages_seen node_
    global ns

    # extract message ID from message
    set message_id [lindex [split $data ":"] 0]

    if {[lsearch $messages_seen $message_id] == -1} {
	lappend messages_seen $message_id
	    puts "Node [$node_ node-addr] received {$data}"
	    #$ns trace-annotate "Node [$node_ node-addr] received {$data}"
	$self send_to_neighbors $source $sport $size $data
    } else {
	    puts "Node [$node_ node-addr] received redundant copy of message #$message_id"
	#$ns trace-annotate "Node [$node_ node-addr] received redundant copy of message #$message_id"
    }
}

Class TestSuite

TestSuite instproc init { name } {
	$self instvar ns_ testname_ group_size num_groups num_nodes n a
	global MESSAGE_PORT

	set testname_ $name
	set ns_ [new Simulator]

	# parameters for topology generator
	set group_size 7
	set num_groups 5
	set num_nodes [expr $group_size * $num_groups]
	# create a bunch of nodes
	for {set i 0} {$i < $num_nodes} {incr i} {
		set n($i) [$ns_ node]
	}

	# attach a new Agent/MessagePassing/Flooding to each node on port $MESSAGE_PORT
	for {set i 0} {$i < $num_nodes} {incr i} {
		set a($i) [new Agent/MessagePassing/Flooding]
		$n($i) attach  $a($i) $MESSAGE_PORT
		$a($i) set messages_seen {}
	}	
}

TestSuite instproc finish args {
	$self instvar traceFile_ ns_
	$ns_ flush-trace
	close $traceFile_
	exit 0
}

TestSuite instproc openTrace { stopTime } {
	$self instvar ns_ traceFile_

	set traceFile_ [open flooding.tr w]
	$ns_ trace-all $traceFile_

	$ns_ at $stopTime "$self finish"
}

proc usage {} {
	global argv0
	puts stderr "usage: ns $argv0 <tests> \[<quiet>\]"
	puts stderr "Valid tests are:\t[get-subclasses TestSuite Test/]"
	exit 1
}

proc isProc? {cls prc} {
	if [catch "Object info subclass $cls/$prc" r] {
		global argv0
		puts stderr "$argv0: no such $cls: $prc"
		usage
	}
}

proc get-subclasses {cls pfx} {
	set ret ""
	set l [string length $pfx]

	set c $cls
	while {[llength $c] > 0} {
		set t [lindex $c 0]
		set c [lrange $c 1 end]
		if [string match ${pfx}* $t] {
			lappend ret [string range $t $l end]
		}
		eval lappend c [$t info subclass]
	}
	set ret
}

TestSuite proc runTest {} {
	global argc argv quiet

	set quiet false
	switch $argc {
		1 {
			set test $argv
			isProc? Test $test
			set topo ""
		}
		2 {
			set test [lindex $argv 0]
			isProc? Test $test
			set extra [lindex $argv 1]
			if {$extra == "QUIET"} {
				set quiet true
			}
		}
		default {
			usage
		}
	}
	set t [new Test/$test $test]
	$t run
}

# First case: in a wired network
Class Test/wired -superclass TestSuite

Test/wired instproc init args {
	eval $self next $args
	$self openTrace 1.0
	$self create-topo
}

Test/wired instproc create-topo args {
	$self instvar ns_ n num_groups group_size

	# create links between the nodes
	for {set g 0} {$g < $num_groups} {incr g} {
		for {set i 0} {$i < $group_size} {incr i} {
			$ns_ duplex-link $n([expr $g*$group_size+$i]) $n([expr $g*$group_size+($i+1)%$group_size]) 2Mb 15ms DropTail
		}
		$ns_ duplex-link $n([expr $g*$group_size]) $n([expr (($g+1)%$num_groups)*$group_size+2]) 2Mb 15ms DropTail
		if {$g%2} {
			$ns_ duplex-link $n([expr $g*$group_size+3]) $n([expr (($g+3)%$num_groups)*$group_size+1]) 2Mb 15ms DropTail
		}
	}
}

Test/wired instproc run {} {
	$self instvar ns_ a
	
	# now set up some events
	$ns_ at 0.0 "$a(5) send_message 900 1 {first message}"
	$ns_ at 0.3 "$a(17) send_message 700 2 {another one}"
	$ns_ at 0.6 "$a(24) send_message 500 abc {yet another one}"
	
	
	$ns_ run
}

TestSuite runTest