File: ns-rtProtoLS.tcl

package info (click to toggle)
ns2 2.35%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 78,796 kB
  • sloc: cpp: 172,923; tcl: 107,130; perl: 6,391; sh: 6,143; ansic: 5,846; makefile: 816; awk: 525; csh: 355
file content (302 lines) | stat: -rw-r--r-- 9,324 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
228
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
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
# 
#  Copyright (c) 2000 by the University of Southern California
#  All rights reserved.
# 
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License,
#  version 2, as published by the Free Software Foundation.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License along
#  with this program; if not, write to the Free Software Foundation, Inc.,
#  59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
#
#  The copyright of this module includes the following
#  linking-with-specific-other-licenses addition:
#
#  In addition, as a special exception, the copyright holders of
#  this module give you permission to combine (via static or
#  dynamic linking) this module with free software programs or
#  libraries that are released under the GNU LGPL and with code
#  included in the standard release of ns-2 under the Apache 2.0
#  license or under otherwise-compatible licenses with advertising
#  requirements (or modified versions of such code, with unchanged
#  license).  You may copy and distribute such a system following the
#  terms of the GNU GPL for this module and the licenses of the
#  other code concerned, provided that you include the source code of
#  that other code when and as the GNU GPL requires distribution of
#  source code.
#
#  Note that people who make modified versions of this module
#  are not obligated to grant this special exception for their
#  modified versions; it is their choice whether to do so.  The GNU
#  General Public License gives permission to release a modified
#  version without this exception; this exception also makes it
#  possible to release a modified version which carries forward this
#  exception.

#  Copyright (C) 1998 by Mingzhou Sun. All rights reserved.
#
#  This software is developed at Rensselaer Polytechnic Institute under 
#  DARPA grant No. F30602-97-C-0274
#  Redistribution and use in source and binary forms are permitted
#  provided that the above copyright notice and this paragraph are
#  duplicated in all such forms and that any documentation, advertising
#  materials, and other materials related to such distribution and use
#  acknowledge that the software was developed by Mingzhou Sun at the
#  Rensselaer  Polytechnic Institute.  The name of the University may not 
#  be used to endorse or promote products derived from this software 
#  without specific prior written permission.
#
# Link State Routing Agent
#
# $Header: /cvsroot/nsnam/ns-2/tcl/rtglib/ns-rtProtoLS.tcl,v 1.4 2005/09/16 03:05:46 tomh Exp $

#
# XXX These default values have to stay here because link state module
# may be disabled during configuration time. If these stay in ns-default.tcl,
# Agent/rtProto/LS may be unknown when ns-default.tcl is loaded.
#
Agent/rtProto/LS set UNREACHABLE  [rtObject set unreach_]
Agent/rtProto/LS set preference_        120
Agent/rtProto/LS set INFINITY           [Agent set ttl_]
Agent/rtProto/LS set advertInterval     1800

# like DV's, except $self cmd initialize and cmd setNodeNumber
Agent/rtProto/LS proc init-all args {
	if { [llength $args] == 0 } {
		set nodeslist [[Simulator instance] all-nodes-list]
	} else { 
		eval "set nodeslist $args"
	}
	Agent set-maxttl Agent/rtProto/LS INFINITY
	eval rtObject init-all $nodeslist
	foreach node $nodeslist {
		set proto($node) [[$node rtObject?] add-proto LS $node]
	}
	foreach node $nodeslist {
		foreach nbr [$node neighbors] {
			set rtobj [$nbr rtObject?]
			if { $rtobj == "" } {
				continue
			}
			set rtproto [$rtobj rtProto? LS]
			if { $rtproto == "" } {
				continue
			}
			$proto($node) add-peer $nbr \
					[$rtproto set agent_addr_] \
					[$rtproto set agent_port_]
		}
	}

	# -- LS stuffs --
	set first_node [lindex $nodeslist 0 ]
	foreach node $nodeslist {
		set rtobj [$node rtObject?]
		if { $rtobj == "" } {
			continue
		}
		set rtproto [$rtobj rtProto? LS]
		if { $rtproto == "" } {
			continue
		}
		$rtproto cmd initialize
		if { $node == $first_node } {
			$rtproto cmd setNodeNumber \
				[[Simulator instance] get-number-of-nodes]
		}
	}
}

# like DV's , except LS_ready
Agent/rtProto/LS instproc init node {
	global rtglibRNG

	$self next $node
	$self instvar ns_ rtObject_ ifsUp_ rtsChanged_ rtpref_ nextHop_ \
		nextHopPeer_ metric_ multiPath_
	Agent/rtProto/LS instvar preference_ 
	
	;# -- LS stuffs -- 
	$self instvar LS_ready
	set LS_ready 0
	set rtsChanged_ 1

	set UNREACHABLE [$class set UNREACHABLE]
	foreach dest [$ns_ all-nodes-list] {
		set rtpref_($dest) $preference_
		set nextHop_($dest) ""
		set nextHopPeer_($dest) ""
		set metric_($dest)  $UNREACHABLE
	}
	set ifsUp_ ""
	set multiPath_ [[$rtObject_ set node_] set multiPath_]
	set updateTime [$rtglibRNG uniform 0.0 0.5]
	$ns_ at $updateTime "$self send-periodic-update"
}

# like DV's
Agent/rtProto/LS instproc add-peer {nbr agentAddr agentPort} {
	$self instvar peers_
	$self set peers_($nbr) [new rtPeer $agentAddr $agentPort $class]
}

# like DV's, except cmd sendUpdates, instead of not send-updates
Agent/rtProto/LS instproc send-periodic-update {} {
	global rtglibRNG
	
	$self instvar ns_

	# -- LS stuffs --
	$self cmd sendUpdates

	set updateTime [expr [$ns_ now] + ([$class set advertInterval] * \
			[$rtglibRNG uniform 0.5 1.5])]
	$ns_ at $updateTime "$self send-periodic-update"
}

# like DV's, except cmd computeRoutes
Agent/rtProto/LS instproc compute-routes {} {
	$self instvar node_
	#puts "Node [$node_ id]: Agent/rtProto/LS compute-routes"
	$self cmd computeRoutes
	$self install-routes
}

# like DV's, except cmd intfChanged(), comment out DV stuff
Agent/rtProto/LS instproc intf-changed {} {
	$self instvar ns_ peers_ ifs_ ifstat_ ifsUp_ nextHop_ \
			nextHopPeer_ metric_
	set INFINITY [$class set INFINITY]
	set ifsUp_ ""
	foreach nbr [lsort -dictionary [array names peers_]] {
		set state [$ifs_($nbr) up?]
		if {$state != $ifstat_($nbr)} {
			set ifstat_($nbr) $state
		}
	}
	# -- LS stuffs --
	$self cmd intfChanged
	$self route-changed
}

;# called by C++ whenever a LSA or Topo causes a change in the routing table
Agent/rtProto/LS instproc route-changed {} {
	$self instvar node_ 
	#puts "At [[Simulator instance] now] node [$node_ id]: Agent/rtProto/LS route-changed"

	$self instvar rtObject_  rtsChanged_
	$self install-routes
	set rtsChanged_ 1
	$rtObject_ compute-routes
}

# put the routes computed in C++ into tcl space
Agent/rtProto/LS instproc install-routes {} {
	$self instvar ns_ ifs_ rtpref_ metric_ nextHop_ nextHopPeer_
	$self instvar peers_ rtsChanged_ multiPath_
	$self instvar node_  preference_ 
    
	set INFINITY [$class set INFINITY]
	set MAXPREF  [rtObject set maxpref_]
	set UNREACH  [rtObject set unreach_]
	set rtsChanged_ 1 
	
	foreach dst [$ns_ all-nodes-list] {
		# puts "installing routes for $dst"
		if { $dst == $node_ } {
			set metric_($dst) 32  ;# the magic number
			continue
		}
		#  puts " [$node_ id] looking for route to [$dst id]"
		set path [$self cmd lookup [$dst id]]
		# puts "$path" ;# debug
		if { [llength $path ] == 0 } {
			# no path found in LS
			set rtpref_($dst) $MAXPREF
			set metric_($dst) $UNREACH
			set nextHop_($dst) ""
			continue
		}
		set cost [lindex $path 0]
		set rtpref_($dst) $preference_
		set metric_($dst) $cost
		
		if { ! $multiPath_ } {
			set nhNode [$ns_ get-node-by-id [lindex $path 1]]
			set nextHop_($dst) $ifs_($nhNode)
			continue
		}
		set nextHop_($dst) ""
		set nh ""
		set count [llength $path]
		foreach nbr [lsort -dictionary [array names peers_]] {
			foreach nhId [lrange $path 1 $count ] {
				if { [$nbr id] == $nhId } {
					lappend nextHop_($dst) $ifs_($nbr)
					break
				}
			}
		}
	}
}

Agent/rtProto/LS instproc send-updates changes {
	$self cmd send-buffered-messages
}

Agent/rtProto/LS proc compute-all {} {
	# Because proc methods are not inherited from the parent class.
}

Agent/rtProto/LS instproc get-node-id {} {
	$self instvar node_
	return [$node_ id]
}

Agent/rtProto/LS instproc get-links-status {} {
	$self instvar ifs_ ifstat_ 
	set linksStatus ""
	foreach nbr [array names ifs_] {
		lappend linksStatus [$nbr id]
		if {[$ifs_($nbr) up?] == "up"} {
			lappend linksStatus 1
		} else {
			lappend linksStatus 0
		}
		lappend linksStatus [$ifs_($nbr) cost?]
	}
	set linksStatus
}

Agent/rtProto/LS instproc get-peers {} {
	$self instvar peers_
	set peers ""
	foreach nbr [lsort -dictionary [array names peers_]] {
		lappend peers [$nbr id]
		lappend peers [$peers_($nbr) addr?]
		lappend peers [$peers_($nbr) port?]
	}
	set peers
}

# needed to calculate the appropriate timeout value for retransmission 
# of unack'ed LSA or Topo messages
Agent/rtProto/LS instproc get-delay-estimates {} {
	$self instvar ifs_ ifstat_ 
	set total_delays ""
	set packet_size 8000.0 ;# bits
	foreach nbr [array names ifs_] {
		set intf $ifs_($nbr)
		set q_limit [ [$intf queue ] set limit_]
		set bw [bw_parse [ [$intf link ] set bandwidth_ ] ]
		set p_delay [time_parse [ [$intf link ] set delay_] ]
		set total_delay [expr $q_limit * $packet_size / $bw + $p_delay]
		$self cmd setDelay [$nbr id] $total_delay
	}
}