test-suite-webcache.tcl
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:59k
源码类别:

通讯编程

开发平台:

Visual C++

  1. # Test suite for HTTP server, client, proxy cache.
  2. #
  3. # Also tests TcpApp, which is an Application used to transmit 
  4. # application-level data. Because current TCP isn't capable of this,
  5. # we build this functionality based on byte-stream model of underlying 
  6. # TCP connection.
  7. # $Header: /cvsroot/nsnam/ns-2/tcl/test/test-suite-webcache.tcl,v 1.25 2006/01/24 23:00:08 sallyfloyd Exp $
  8. #----------------------------------------------------------------------
  9. # Related Files
  10. #----------------------------------------------------------------------
  11. source misc.tcl
  12. source topologies.tcl
  13. remove-all-packet-headers       ; # removes all except common
  14. add-packet-header Flags IP TCP HttpInval ; # hdrs reqd for validation test
  15. # FOR UPDATING GLOBAL DEFAULTS:
  16. Agent/TCP set precisionReduce_ false ;   # default changed on 2006/1/24.
  17. Agent/TCP set rtxcur_init_ 6.0 ;      # Default changed on 2006/01/21
  18. Agent/TCP set updated_rttvar_ false ;  # Variable added on 2006/1/21
  19. Agent/TCP set tcpTick_ 0.1
  20. # The default for tcpTick_ is being changed to reflect a changing reality.
  21. Agent/TCP set rfc2988_ false
  22. # The default for rfc2988_ is being changed to true.
  23. Agent/TCP set exitFastRetrans_ false
  24. #
  25. Agent/TCP set useHeaders_ false
  26. # The default is being changed to useHeaders_ true.
  27. Agent/TCP set windowInit_ 1
  28. # The default is being changed to 2.
  29. Agent/TCP set singledup_ 0
  30. # The default is being changed to 1
  31. Agent/TCP set minrto_ 0
  32. # The default is being changed to minrto_ 1
  33. Agent/TCP set timerfix_ false
  34. # The default is being changed to true.
  35. Agent/TCP set syn_ false
  36. Agent/TCP set delay_growth_ false
  37. # In preparation for changing the default values for syn_ and delay_growth_.
  38. #----------------------------------------------------------------------
  39. # Misc setup
  40. #----------------------------------------------------------------------
  41. set tcl_precision 10
  42. #----------------------------------------------------------------------
  43. # Topologies for cache testing
  44. #----------------------------------------------------------------------
  45. # Simplest topology: 1 client + 1 cache + 1 server
  46. Class Topology/cache0 -superclass SkelTopology
  47. Topology/cache0 instproc init ns {
  48. $self next
  49. $self instvar node_
  50. set node_(c) [$ns node]
  51. set node_(e) [$ns node]
  52. set node_(s) [$ns node]
  53. $ns duplex-link $node_(s) $node_(e) 1.5Mb 50ms DropTail
  54. $ns duplex-link $node_(e) $node_(c) 10Mb 2ms DropTail
  55. $ns duplex-link-op $node_(c) $node_(e) orient right
  56. $ns duplex-link-op $node_(e) $node_(s) orient right
  57. }
  58. # Hierarchical cache, 1 server + 7 cache + 4 clients, server linked to 
  59. # a top-level cache
  60. Class Topology/cache2 -superclass SkelTopology
  61. Topology/cache2 instproc init ns {
  62. $self next
  63. $self instvar node_
  64. set node_(c0) [$ns node]
  65. set node_(c1) [$ns node]
  66. set node_(c2) [$ns node]
  67. set node_(c3) [$ns node]
  68. set node_(e0) [$ns node]
  69. set node_(e1) [$ns node]
  70. set node_(e2) [$ns node]
  71. set node_(e3) [$ns node]
  72. set node_(e4) [$ns node]
  73. set node_(e5) [$ns node]
  74. set node_(e6) [$ns node]
  75. set node_(s0) [$ns node]
  76. # between top-level cache: OC3
  77. $ns duplex-link $node_(e0) $node_(e1) 155Mb 100ms DropTail
  78. # server to top-level cache and inside a cache hierarchy: T1
  79. $ns duplex-link $node_(s0) $node_(e0) 1.5Mb 50ms DropTail
  80. $ns duplex-link $node_(e0) $node_(e2) 1.5Mb 50ms DropTail
  81. $ns duplex-link $node_(e0) $node_(e3) 1.5Mb 50ms DropTail
  82. $ns duplex-link $node_(e1) $node_(e4) 1.5Mb 50ms DropTail
  83. $ns duplex-link $node_(e1) $node_(e5) 1.5Mb 50ms DropTail
  84. $ns duplex-link $node_(e2) $node_(e6) 10Mb 2ms DropTail
  85. # client to caches: 10Mb ethernet
  86. $ns duplex-link $node_(e2) $node_(c0) 10Mb 2ms DropTail
  87. $ns duplex-link $node_(e6) $node_(c1) 10Mb 2ms DropTail
  88. $ns duplex-link $node_(e4) $node_(c2) 10Mb 2ms DropTail
  89. $ns duplex-link $node_(e1) $node_(c3) 10Mb 2ms DropTail
  90. $ns duplex-link-op $node_(s0) $node_(e0) orient right
  91. $ns duplex-link-op $node_(e0) $node_(e1) orient right
  92. $ns duplex-link-op $node_(e0) $node_(e2) orient left-down
  93. $ns duplex-link-op $node_(e0) $node_(e3) orient right-down
  94. $ns duplex-link-op $node_(e2) $node_(e6) orient down
  95. $ns duplex-link-op $node_(c0) $node_(e2) orient right
  96. $ns duplex-link-op $node_(c1) $node_(e6) orient right
  97. $ns duplex-link-op $node_(e1) $node_(e4) orient left-down
  98. $ns duplex-link-op $node_(e1) $node_(e5) orient right-down
  99. $ns duplex-link-op $node_(e4) $node_(c2) orient down
  100. $ns duplex-link-op $node_(e1) $node_(c3) orient right
  101. $self checkConfig $class $ns
  102. }
  103. # Hierarchical cache, 1 server + 7 cache + 4 clients, server linked to a 
  104. # second-level cache.
  105. Class Topology/cache3 -superclass SkelTopology
  106. Topology/cache3 instproc init ns {
  107. $self next
  108. $self instvar node_
  109. set node_(c0) [$ns node]
  110. set node_(c1) [$ns node]
  111. set node_(c2) [$ns node]
  112. set node_(c3) [$ns node]
  113. set node_(e0) [$ns node]
  114. set node_(e1) [$ns node]
  115. set node_(e2) [$ns node]
  116. set node_(e3) [$ns node]
  117. set node_(e4) [$ns node]
  118. set node_(e5) [$ns node]
  119. set node_(e6) [$ns node]
  120. set node_(s0) [$ns node]
  121. # between top-level cache: OC3
  122. $ns duplex-link $node_(e0) $node_(e1) 155Mb 100ms DropTail
  123. # server to top-level cache and inside a cache hierarchy: T1
  124. $ns duplex-link $node_(s0) $node_(e5) 1.5Mb 50ms DropTail
  125. $ns duplex-link $node_(e0) $node_(e2) 1.5Mb 50ms DropTail
  126. $ns duplex-link $node_(e0) $node_(e3) 1.5Mb 50ms DropTail
  127. $ns duplex-link $node_(e1) $node_(e4) 1.5Mb 50ms DropTail
  128. $ns duplex-link $node_(e1) $node_(e5) 1.5Mb 50ms DropTail
  129. $ns duplex-link $node_(e2) $node_(e6) 10Mb 2ms DropTail
  130. # client to caches: 10Mb ethernet
  131. $ns duplex-link $node_(e2) $node_(c0) 10Mb 2ms DropTail
  132. $ns duplex-link $node_(e6) $node_(c1) 10Mb 2ms DropTail
  133. $ns duplex-link $node_(e4) $node_(c2) 10Mb 2ms DropTail
  134. $ns duplex-link $node_(e1) $node_(c3) 10Mb 2ms DropTail
  135. $ns duplex-link-op $node_(e5) $node_(s0) orient right
  136. $ns duplex-link-op $node_(e0) $node_(e1) orient right
  137. $ns duplex-link-op $node_(e0) $node_(e2) orient left-down
  138. $ns duplex-link-op $node_(e0) $node_(e3) orient right-down
  139. $ns duplex-link-op $node_(e2) $node_(e6) orient down
  140. $ns duplex-link-op $node_(c0) $node_(e2) orient right
  141. $ns duplex-link-op $node_(c1) $node_(e6) orient right
  142. $ns duplex-link-op $node_(e1) $node_(e4) orient left-down
  143. $ns duplex-link-op $node_(e1) $node_(e5) orient right-down
  144. $ns duplex-link-op $node_(e4) $node_(c2) orient down
  145. $ns duplex-link-op $node_(e1) $node_(c3) orient right
  146. $self checkConfig $class $ns
  147. }
  148. # Two level hierarchical cache. 1 server + 1 TLC + n 2nd caches with one 
  149. # bottleneck link connecting TCL to other caches + n clients
  150. Class Topology/BottleNeck -superclass SkelTopology
  151. Class Topology/BottleNeck -superclass SkelTopology
  152. Topology/BottleNeck instproc init { ns } {
  153. $self next 
  154. $self instvar node_ 
  155. global opts
  156. if [info exists opts(num-2nd-cache)] {
  157. set n $opts(num-2nd-cache)
  158. } else {
  159. error "Topology/BottleNeck requires option num-2nd-cache"
  160. }
  161. set node_(s0) [$ns node]
  162. # TLC is node e0
  163. for {set i 0} {$i <= $n} {incr i} {
  164. set node_(e$i) [$ns node]
  165. }
  166. # We create clients separately so we have consecutive ids for all 
  167. # clients
  168. for {set i 0} {$i < $n} {incr i} {
  169. set node_(c$i) [$ns node]
  170. }
  171. # Between TLC and server: T1
  172. # $ns duplex-link $node_(e$n) $node_(s0) 1.5Mb 100ms DropTail
  173. # Server attached to a client via a LAN
  174. $ns duplex-link $node_(e0) $node_(s0) 1.5Mb 100ms DropTail
  175. #$ns duplex-link $node_(e0) $node_(s0) 10Mb 2ms DropTail
  176. # Bottleneck link
  177. $self instvar dummy_
  178. set dummy_ [$ns node]
  179. $ns duplex-link $node_(e$n) $dummy_ 1.5Mb 50ms DropTail
  180. for {set i 0} {$i < $n} {incr i} {
  181. $ns duplex-link $node_(e$i) $dummy_ 1.5Mb 50ms DropTail
  182. $ns duplex-link $node_(c$i) $node_(e$i) 10Mb 2ms DropTail
  183. }
  184. $self checkConfig $class $ns
  185. }
  186. Topology/BottleNeck instproc start-monitor { ns } {
  187. $self instvar qmon_ node_ dummy_
  188. # Traffic between server and its primary cache
  189. set qmon_(svr_f) [$ns monitor-queue $node_(s0) $node_(e0) ""]
  190. set qmon_(svr_t) [$ns monitor-queue $node_(e0) $node_(s0) ""]
  191. global opts
  192. set n $opts(num-2nd-cache)
  193. # Traffic between TLC and all others
  194. set qmon_(btnk_f) [$ns monitor-queue $node_(e$n) $dummy_ ""]
  195. set qmon_(btnk_t) [$ns monitor-queue $dummy_ $node_(e$n) ""]
  196. # Traffic for all the rest links
  197. for {set i 0} {$i < $n} {incr i} {
  198. set qmon_(e${i}_d_f) [$ns monitor-queue $node_(e$i) $dummy_ ""]
  199. set qmon_(e${i}_d_t) [$ns monitor-queue $dummy_ $node_(e$i) ""]
  200. set qmon_(e${i}_c${i}_f) 
  201. [$ns monitor-queue $node_(e$i) $node_(c$i) ""]
  202. set qmon_(e${i}_c${i}_t) 
  203. [$ns monitor-queue $node_(c$i) $node_(e$i) ""]
  204. }
  205. #puts "Monitors started at time [$ns now]"
  206. }
  207. Topology/BottleNeck instproc mon-stat {} {
  208. $self instvar qmon_
  209. set total_bw 0
  210. foreach n [array names qmon_] {
  211. set total_bw [expr $total_bw + 
  212. double([$qmon_($n) set bdepartures_])]
  213. }
  214. set svr_bw [expr double([$qmon_(svr_f) set bdepartures_]) + 
  215. double([$qmon_(svr_t) set bdepartures_])]
  216. set btnk_bw [expr double([$qmon_(btnk_f) set bdepartures_]) + 
  217. double([$qmon_(btnk_t) set bdepartures_])]
  218. return [list total_bw $total_bw svr_bw $svr_bw btnk_bw $btnk_bw]
  219. }
  220. #
  221. # Three level hierarchical cache, binary tree. 
  222. #
  223. Class Topology/cache4 -superclass SkelTopology
  224. Topology/cache4 instproc init { ns } {
  225. $self next
  226. $self instvar node_
  227. # server attached to a leaf cache
  228. set node_(s0) [$ns node]
  229. # TLC is node e0
  230. for {set i 0} {$i <= 6} {incr i} {
  231. set node_(e$i) [$ns node]
  232. }
  233. # All clients attached to leaf caches
  234. for {set i 0} {$i <= 3} {incr i} {
  235. set node_(c$i) [$ns node]
  236. }
  237. # Bottleneck link between TLC and other caches
  238. set dummy [$ns node]
  239. $ns duplex-link $node_(e0) $dummy 100Mb 1ms DropTail
  240. $ns duplex-link $dummy $node_(e1) 1.5Mb 50ms DropTail
  241. $ns duplex-link $dummy $node_(e2) 1.5Mb 50ms DropTail
  242. $ns duplex-link $node_(e1) $node_(e3) 1.5Mb 10ms DropTail
  243. $ns duplex-link $node_(e1) $node_(e4) 1.5Mb 10ms DropTail
  244. $ns duplex-link $node_(e2) $node_(e5) 1.5Mb 10ms DropTail
  245. $ns duplex-link $node_(e2) $node_(e6) 1.5Mb 10ms DropTail
  246. $ns duplex-link $node_(e3) $node_(c0) 10Mb 1ms DropTail
  247. $ns duplex-link $node_(e4) $node_(c1) 10Mb 1ms DropTail
  248. $ns duplex-link $node_(e5) $node_(c2) 10Mb 1ms DropTail
  249. $ns duplex-link $node_(e6) $node_(c3) 10Mb 1ms DropTail
  250. $ns duplex-link $node_(s0) $node_(e3) 10Mb 10ms DropTail
  251. $ns duplex-link-op $node_(e0) $dummy orient down
  252. $ns duplex-link-op $dummy $node_(e1) orient left-down
  253. $ns duplex-link-op $dummy $node_(e2) orient right-down
  254. $ns duplex-link-op $node_(e1) $node_(e3) orient left-down
  255. $ns duplex-link-op $node_(e1) $node_(e4) orient right-down
  256. $ns duplex-link-op $node_(e2) $node_(e5) orient left-down
  257. $ns duplex-link-op $node_(e2) $node_(e6) orient right-down
  258. $ns duplex-link-op $node_(e3) $node_(c0) orient down
  259. $ns duplex-link-op $node_(e4) $node_(c1) orient down
  260. $ns duplex-link-op $node_(e5) $node_(c2) orient down
  261. $ns duplex-link-op $node_(e6) $node_(c3) orient down
  262. $ns duplex-link-op $node_(s0) $node_(e3) orient right
  263. $self checkConfig $class $ns
  264. }
  265. # Same as Topology/cache4, except adding a dynamic links
  266. Class Topology/cache4d -superclass Topology/cache4
  267. Topology/cache4d instproc init { ns } {
  268. $self next $ns
  269. $self instvar node_
  270. $ns rtmodel-at 500 down $node_(s0) $node_(e3)
  271. $ns rtmodel-at 1000 up $node_(s0) $node_(e3)
  272. $self checkConfig $class $ns
  273. }
  274. # 2-level topology with direct links from server to every client
  275. # Compare invalidation vs ttl with direct request
  276. Class Topology/cache5 -superclass SkelTopology
  277. Topology/cache5 instproc init { ns } {
  278. $self next
  279. $self instvar node_
  280. global opts
  281. if [info exists opts(num-2nd-cache)] {
  282. set n $opts(num-2nd-cache)
  283. } else {
  284. error "Topology/BottleNeck requires option num-2nd-cache"
  285. }
  286. set node_(s0) [$ns node]
  287. # TLC is node e0
  288. for {set i 0} {$i <= $n} {incr i} {
  289. set node_(e$i) [$ns node]
  290. }
  291. # We create clients separately so we have consecutive ids for all 
  292. # clients
  293. for {set i 0} {$i < $n} {incr i} {
  294. set node_(c$i) [$ns node]
  295. }
  296. set sn [$ns node] ;# Dummy node for bottleneck link
  297. $ns duplex-link $node_(e$n) $sn 1.5Mb 50ms DropTail
  298. # Traffic on the duplex link. 
  299. $self instvar qmon_
  300. set qmon_(btnk_f) [$ns monitor-queue $node_(e$n) $sn ""]
  301. set qmon_(btnk_t) [$ns monitor-queue $sn $node_(e$n) ""]
  302. for {set i 0} {$i < $n} {incr i} {
  303. $ns duplex-link $node_(e$i) $sn 1.5Mb 50ms DropTail
  304. $ns duplex-link $node_(c$i) $node_(e$i) 10Mb 2ms DropTail
  305. # Server attached to all clients, but its parent cache is e0
  306. # delay to server is proportional to its distance to e0
  307. set delay [expr 5 + $i*5]ms
  308. $ns duplex-link $node_(e$i) $node_(s0) 1.5Mb $delay DropTail
  309. set qmon_(svr_f$i) [$ns monitor-queue $node_(s0) $node_(e$i) ""]
  310. set qmon_(svr_t$i) [$ns monitor-queue $node_(e$i) $node_(s0) ""]
  311. }
  312. $self checkConfig $class $ns
  313. }
  314. #
  315. # Simple 2 node topology testing SimpleTcp and TcpApp
  316. #
  317. Class Topology/2node -superclass SkelTopology
  318. Topology/2node instproc init { ns } {
  319. $self next
  320. $self instvar node_
  321. set node_(0) [$ns node]
  322. set node_(1) [$ns node]
  323. $ns duplex-link $node_(0) $node_(1) 1.5Mb 10ms DropTail
  324. $ns duplex-link-op $node_(0) $node_(1) orient right
  325. $self checkConfig $class $ns
  326. }
  327. #
  328. # 3 node linear topology testing SimpleTcp and TcpApp
  329. #
  330. Class Topology/3node -superclass SkelTopology
  331. Topology/3node instproc init { ns } {
  332. $self next 
  333. $self instvar node_
  334. set node_(0) [$ns node]
  335. set node_(1) [$ns node]
  336. set node_(2) [$ns node]
  337. $ns duplex-link $node_(0) $node_(1) 1.5Mb 50ms DropTail
  338. $ns duplex-link $node_(1) $node_(2) 1.5Mb 50ms DropTail
  339. $ns duplex-link-op $node_(0) $node_(1) orient right
  340. $ns duplex-link-op $node_(1) $node_(2) orient right
  341. }
  342. #
  343. # 5 node topology testing HTTP cache, with 3 clients, one server and 
  344. # one cache
  345. #
  346. Class Topology/5node -superclass SkelTopology
  347. Topology/5node instproc init { ns } {
  348. $self next
  349. $self instvar node_
  350. for {set i 0} {$i < 5} {incr i} {
  351. set node_($i) [$ns node]
  352. }
  353. $ns duplex-link $node_(3) $node_(4) 1Mb 50ms DropTail
  354. $ns duplex-link $node_(0) $node_(3) 1Mb 50ms DropTail
  355. $ns duplex-link $node_(1) $node_(3) 1Mb 50ms DropTail
  356. $ns duplex-link $node_(2) $node_(3) 1Mb 50ms DropTail
  357. $ns duplex-link-op $node_(4) $node_(3) orient right
  358. $ns duplex-link-op $node_(0) $node_(3) orient down
  359. $ns duplex-link-op $node_(1) $node_(3) orient left
  360. $ns duplex-link-op $node_(2) $node_(3) orient up
  361. }
  362. #----------------------------------------------------------------------
  363. # Section 1: Base test class
  364. #----------------------------------------------------------------------
  365. Class Test
  366. Test instproc init-instvar v {
  367. set cl [$self info class]
  368. while { "$cl" != "" } {
  369. foreach c $cl {
  370. if ![catch "$c set $v" val] {
  371. $self set $v $val
  372. return
  373. }
  374. }
  375. set parents ""
  376. foreach c $cl {
  377. if { $cl != "Object" } {
  378. set parents "$parents [$c info superclass]"
  379. }
  380. }
  381. set cl $parents
  382. }
  383. }
  384. Test instproc init {} {
  385. $self instvar ns_ trace_ net_ defNet_ testName_ node_ test_ topo_
  386. set ns_ [new Simulator -multicast on]
  387. set cls [$self info class]
  388. set cls [split $cls /]
  389. set test_ [lindex $cls [expr [llength $cls] - 1]]
  390. global opts
  391. ns-random $opts(ns-random-seed)
  392. if $opts(nam-trace-all) {
  393. #set trace_ [open "$test_" w]
  394. # test-all-template1 requires data file to be temp.rands :(
  395. set trace_ [open "temp.rands" w]
  396. $ns_ trace-all $trace_
  397. }
  398. if ![info exists opts(net)] {
  399. set net_ $defNet_
  400. } else {
  401. set net_ $opts(net)
  402. }
  403. if ![Topology/$defNet_ info subclass Topology/$net_] {
  404. global argv0
  405. puts "$argv0: cannot run test $test_ over topology $net_"
  406. exit 1
  407. }
  408. set topo_ [new Topology/$net_ $ns_]
  409. foreach i [$topo_ array names node_] {
  410. # This would be cool, but lets try to be compatible
  411. # with test-suite.tcl as far as possible.
  412. #
  413. # $self instvar $i
  414. # set $i [$topo_ node? $i]
  415. #
  416. set node_($i) [$topo_ node? $i]
  417. }
  418. if {$net_ == $defNet_} {
  419. set testName_ "$test_"
  420. } else {
  421. set testName_ "$test_:$net_"
  422. }
  423. }
  424. # Use this so derived class would have a chance to overwrite the default net
  425. # of parent classes
  426. Test instproc set-defnet { defnet } {
  427. $self instvar defNet_
  428. if ![info exists defNet_] {
  429. set defNet_ $defnet
  430. }
  431. }
  432. Test instproc inherit-set { name val } {
  433. $self instvar $name
  434. if ![info exists $name] {
  435. set $name $val
  436. }
  437. }
  438. Test instproc write-testconf { file } {
  439. $self instvar test_ net_
  440. puts $file "# TESTNAME: $test_"
  441. puts $file "# TOPOLOGY: $net_"
  442. global opts
  443. foreach n [lsort [array names opts]] {
  444. # XXX Remove this after validating existing traces
  445. if {$n == "quiet"} { continue }
  446. puts $file "# $n: $opts($n)" 
  447. }
  448. }
  449. Test instproc set-routing {} {
  450. }
  451. Test instproc set-members {} {
  452. }
  453. Test instproc finish {} {
  454. $self instvar ns_ trace_
  455. if [info exists trace_] {
  456. $ns_ flush-trace
  457. close $trace_
  458. }
  459. exit 0
  460. }
  461. Test instproc run {} {
  462. $self instvar finishTime_ ns_ trace_
  463. global opts
  464. if $opts(nam-trace-all) {
  465. $self write-testconf $trace_
  466. }
  467. $self set-routing
  468. $self set-members
  469. $ns_ at $finishTime_ "$self finish"
  470. $ns_ run
  471. }
  472. # option processing copied from John's ~ns/tcl/ex/rbp_demo.tcl
  473. proc default_options {} {
  474. global opts opt_wants_arg raw_opt_info
  475. # raw_opt_info can be set in user's script
  476. while {$raw_opt_info != ""} {
  477. if {![regexp "^[^n]*n" $raw_opt_info line]} {
  478. break
  479. }
  480. regsub "^[^n]*n" $raw_opt_info {} raw_opt_info
  481. set line [string trim $line]
  482. if {[regexp "^[ t]*#" $line]} {
  483. continue
  484. }
  485. if {$line == ""} {
  486. continue
  487. } elseif [regexp {^([^ ]+)[ ]+([^ ]+)$} $line dummy key value] {
  488. set opts($key) $value
  489. set opt_wants_arg($key) 1
  490. } elseif [regexp {^([^ ]+)[ ]*$} $line dummy key] {
  491. # So we don't need to assign opt($key)
  492. set opt_wants_arg($key) 1
  493. } else {
  494. set opt_wants_arg($key) 0
  495. error "unknown stuff "$line" in raw_opt_info"
  496. }
  497. }
  498. }
  499. proc process_args {} {
  500. global argc argv opts opt_wants_arg
  501. default_options
  502. for {set i 0} {$i < $argc} {incr i} {
  503. set key [lindex $argv $i]
  504. if {$key == "-?" || $key == "--help" || $key == "-help" || $key == "-h"} {
  505. usage
  506. }
  507. regsub {^--} $key {} key
  508. if {![info exists opt_wants_arg($key)]} {
  509. #puts stderr "unknown option $key";
  510. #usage
  511. continue
  512. }
  513. if {$opt_wants_arg($key)} {
  514. incr i
  515. set opts($key) [lindex $argv $i]
  516. } else {
  517. set opts($key) [expr !opts($key)]
  518. }
  519. }
  520. }
  521. # Startup procedure, called at the end of the script
  522. proc run {} {
  523. global argc argv opts raw_opt_info
  524. # We don't actually have any real arguments, but we do have 
  525. # various initializations, which the script depends on.
  526. process_args
  527. #set prot $opts(prot)
  528. # Calling convention by test-all-template1: 
  529. # ns <file> <test> [QUIET]
  530. set prot [lindex $argv 0]
  531. set opts(prot) $prot
  532. if {$argc > 1} {
  533. set opts(quiet) 1
  534. } else {
  535. set opts(quiet) 0
  536. }
  537. set test [new Test/$prot]
  538. $test run
  539. }
  540. #----------------------------------------------------------------------
  541. # Section 2 Base class for cache testing
  542. #----------------------------------------------------------------------
  543. Class Test-Cache -superclass Test
  544. # Page lifetime is a uniform distribution in [min, max].
  545. Test-Cache set startTime_ 10
  546. Test-Cache instproc init {} {
  547. $self next
  548. $self instvar startTime_
  549. set startTime_ [$class set startTime_]
  550. $self set-pagepool
  551. global opts
  552. if [info exists opts(hb-interval)] {
  553. Http/Client set hb_interval_ $opts(hb-interval)
  554. Http/Cache/Inval/Mcast set hb_interval_ $opts(hb-interval)
  555. Http/Server/Inval/Yuc set hb_interval_ $opts(hb-interval)
  556. }
  557. if [info exists opts(upd-interval)] {
  558. Http/Cache/Inval/Mcast set upd_interval_ $opts(upd-interval)
  559. }
  560. if [info exists opts(cache-ims-size)] {
  561. Http set IMSSize_ $opts(cache-ims-size)
  562. }
  563. if [info exists opt(server-inv-size)] {
  564. Http set INVSize_ $opt(server-inv-size)
  565. }
  566. if [info exists opts(cache-ref-size)] {
  567. Http set REFSize_ $opts(cache-ref-size)
  568. }
  569. if [info exists opts(client-req-size)] {
  570. Http set REQSize_ $opts(client-req-size)
  571. }
  572. $self instvar ns_
  573. $ns_ color 40 red
  574. $ns_ color 41 orange
  575. # Set default transport to SimpleTcp
  576. Http set TRANSPORT_ SimpleTcp
  577. }
  578. # Allow global options to preempt, and derived classes to overwrite.
  579. Test-Cache instproc set-server-type { servertype } {
  580. $self instvar serverType_ 
  581. global opts
  582. if [info exists opts(server)] {
  583. set serverType_ $opts(server)
  584. } else {
  585. set serverType_ $servertype
  586. }
  587. }
  588. Test-Cache instproc set-cache-type { cachetype } {
  589. $self instvar cacheType_ 
  590. global opts
  591. if [info exists opts(cache)] {
  592. set cacheType_ $opts(cache)
  593. } else {
  594. set cacheType_ $cachetype
  595. }
  596. }
  597. Test-Cache instproc set-client-type { clienttype } {
  598. $self instvar clientType_
  599. global opts
  600. if [info exists opts(client)] {
  601. set clientType_ $opts(client)
  602. } else {
  603. set clientType_ $clienttype
  604. }
  605. }
  606. Test-Cache instproc set-pagepool {} {
  607. $self instvar startTime_ finishTime_ pgp_
  608. global opts
  609. if [info exists opts(page-file)] {
  610. set pgp_ [new PagePool/Trace $opts(page-file)]
  611. set max [$pgp_ get-poolsize]
  612. set tmp [new RandomVariable/Uniform]
  613. $tmp set min_ 0
  614. $tmp set max_ [expr $max - 1]
  615. $pgp_ ranvar $tmp
  616. $pgp_ set start_time_ $startTime_
  617. set finishTime_ [expr [$pgp_ get-duration] + $startTime_]
  618. } else {
  619. # Use PagePool/Math
  620. set pgp_ [new PagePool/Math]
  621. # Size generator
  622. set tmp [new RandomVariable/Constant]
  623. $tmp set val_ $opts(avg-page-size)
  624. $pgp_ ranvar-size $tmp
  625. # Age generator
  626. $self instvar ageRNG_
  627. if ![info exists ageRNG_] {
  628. set ageRNG_ [new RNG]
  629. $ageRNG_ seed $opts(ns-random-seed)
  630. }
  631. set tmp [new RandomVariable/Exponential]
  632. $tmp use-rng $ageRNG_
  633. $tmp set avg_ $opts(avg-page-age)
  634. $pgp_ ranvar-age $tmp
  635. $pgp_ set start_time_ $startTime_
  636. set finishTime_ [expr $startTime_ + $opts(duration)]
  637. }
  638. # puts "Start at $startTime_, stop at $finishTime_"
  639. }
  640. Test-Cache instproc set-req-generator { client } {
  641. $self instvar pgp_ reqRNG_
  642. global opts
  643. if ![info exists reqRNG_] {
  644. set reqRNG_ [new RNG]
  645. $reqRNG_ seed $opts(ns-random-seed)
  646. }
  647. set tmp [new RandomVariable/Exponential]
  648. $tmp use-rng $reqRNG_
  649. $tmp set avg_ $opts(avg-req-interval)
  650. $client set-interval-generator $tmp
  651. $client set-page-generator $pgp_
  652. }
  653. Test-Cache instproc create-members {} {
  654. $self instvar client_ server_ cache_ log_ test_ pgp_ node_ ns_ 
  655. serverType_ cacheType_ clientType_
  656. set st $serverType_
  657. set ct $cacheType_
  658. set lt $clientType_
  659. global opts
  660. if $opts(enable-log) {
  661. set log_ [open "$test_.log" w]
  662. $self write-testconf $log_
  663. }
  664. foreach n [array names node_] {
  665. set type [string range $n 0 0]
  666. set num [string range $n 1 end]
  667. if {$num == ""} {
  668. set num 0
  669. }
  670. switch $type {
  671. s {
  672.  set server_($num) [new Http/Server$st $ns_ $node_($n)]
  673.  $server_($num) set-page-generator $pgp_
  674.  if $opts(enable-log) {
  675.  $server_($num) log $log_
  676.  }
  677. }
  678. e {
  679.  set cache_($num) [new Http/Cache$ct $ns_ $node_($n)]
  680.  if $opts(enable-log) {
  681.  $cache_($num) log $log_
  682.  }
  683. }
  684. c {
  685.   set client_($num) [new Http/Client$lt $ns_ $node_($n)]
  686.   $self set-req-generator $client_($num)
  687.   if $opts(enable-log) {
  688.   $client_($num) log $log_
  689.   }
  690. }
  691. }
  692. }
  693. }
  694. Test-Cache instproc set-routing {} {
  695. $self instvar ns_ mh_
  696. set mh_ [$ns_ mrtproto CtrMcast {}]
  697. $ns_ rtproto Session
  698. }
  699. Test-Cache instproc set-members {} {
  700. $self instvar ns_ finishTime_ startTime_
  701. $ns_ at $startTime_ "$self start-connection"
  702. # $ns_ at $finishTime_ "$self finish-connection"
  703. }
  704. Test-Cache instproc set-groups {} {
  705. # Dummy proc
  706. }
  707. Test-Cache instproc start-connection {} {
  708. $self instvar ns_
  709. $self create-members
  710. $self set-connections
  711. $self set-groups
  712. # Let initializations settles down, then start requests
  713. $ns_ at [expr [$ns_ now] + 10] "$self start-requests"
  714. }
  715. # Empty
  716. Test-Cache instproc set-groups {} {
  717. }
  718. # Empty
  719. Test-Cache instproc set-connections {} {
  720. }
  721. Test-Cache instproc finish {} {
  722. $self instvar log_
  723. if [info exists log_] {
  724. close $log_
  725. }
  726. $self next
  727. }
  728. #----------------------------------------------------------------------
  729. # Section 3: 
  730. # Tests of transport protocols and application data transmission over TCP
  731. #----------------------------------------------------------------------
  732. #
  733. # Test SimpleTcp
  734. #
  735. Class Test/SimpleTcp -superclass Test
  736. Test/SimpleTcp instproc init {} {
  737. $self set-defnet 2node
  738. $self next
  739. $self instvar startTime_ finishTime_
  740. set startTime_ 10
  741. set finishTime_ 20
  742. Http set TRANSPORT_ SimpleTcp
  743. }
  744. Test/SimpleTcp instproc set-routing {} {
  745. $self instvar ns_
  746. $ns_ rtproto Session
  747. }
  748. Test/SimpleTcp instproc set-members {} {
  749. $self instvar ns_ src_ dst_ node_ ftp1_
  750. $ns_ at 1.0 "$self start-connection 0 1"
  751. $ns_ at 9.0 "$self finish-connection 0 1"
  752. }
  753. # Connect TCP source and destination after simulator starts
  754. Test/SimpleTcp instproc start-connection { s d } {
  755. $self instvar ns_ src_ dst_ node_
  756. set src_ [new Agent/TCP/SimpleTcp]
  757. set dst_ [new Agent/TCP/SimpleTcp]
  758. $src_ set fid_ 0
  759. $dst_ set fid_ 0
  760. $ns_ attach-agent $node_($s) $src_
  761. $ns_ attach-agent $node_($d) $dst_
  762. $ns_ connect $src_ $dst_ 
  763. $src_ set dst_addr_ [$dst_ set agent_addr_]
  764. $src_ set dst_port_ [$dst_ set agent_port_]
  765. $src_ set window_ 100
  766. $dst_ listen
  767. $ns_ at [expr [$ns_ now] + 1.0] "$src_ send 1000"
  768. $ns_ at [expr [$ns_ now] + 3.0] "$dst_ send 100"
  769. }
  770. Test/SimpleTcp instproc finish-connection { s d } {
  771. $self instvar ns_ src_ dst_ node_
  772. $src_ close
  773. }
  774. #
  775. # Base class for testing TcpApp over SimpleTcp and FullTcp
  776. #
  777. Class Test-TcpApp -superclass Test
  778. Test-TcpApp instproc set-routing {} {
  779. $self instvar ns_
  780. $ns_ rtproto Session
  781. }
  782. Class Test/TcpApp-2node -superclass Test-TcpApp
  783. Test/TcpApp-2node instproc init {} {
  784. $self set-defnet 2node
  785. $self next
  786. $self instvar startTime_ finishTime_ ns_
  787. set startTime_ 10
  788. set finishTime_ 50
  789. $ns_ color 1 red
  790. $ns_ color 2 blue
  791. }
  792. Test/TcpApp-2node instproc send1 {} {
  793. $self instvar app1_ app2_
  794. $app1_ send 40 "$app2_ recv1 40"
  795. }
  796. Test/TcpApp-2node instproc send2 {} {
  797. $self instvar app1_ app2_ ns_
  798. $app2_ send 1024 "$app1_ recv2 1024"
  799. $ns_ at [expr [$ns_ now] + 1.0] "$self send2"
  800. }
  801. Application/TcpApp instproc recv1 { sz } {
  802. set now [[Simulator instance] now]
  803. #puts "$now app2 receives data $sz bytes from app1"
  804. }
  805. Application/TcpApp instproc recv2 { sz } {
  806. set now [[Simulator instance] now]
  807. #puts "$now app1 receives data $sz bytes from app1"
  808. }
  809. Test/TcpApp-2node instproc set-members {} { 
  810. $self instvar app1_ app2_ ns_ node_
  811. set tcp1 [new Agent/TCP/FullTcp]
  812. set tcp2 [new Agent/TCP/FullTcp]
  813. $tcp1 set window_ 100
  814. $tcp1 set fid_ 1
  815. $tcp2 set window_ 100
  816. $tcp2 set fid_ 2
  817. $tcp2 set iss_ 1224
  818. $ns_ attach-agent $node_(0) $tcp1
  819. $ns_ attach-agent $node_(1) $tcp2
  820. $ns_ connect $tcp1 $tcp2
  821. $tcp2 listen
  822. set app1_ [new Application/TcpApp $tcp1]
  823. set app2_ [new Application/TcpApp $tcp2]
  824. $app1_ connect $app2_
  825. $ns_ at 1.0 "$self send1"
  826. $ns_ at 1.2 "$self send2"
  827. }
  828. #----------------------------------------------------------------------
  829. # Section 4: Tests of Cache
  830. #----------------------------------------------------------------------
  831. #
  832. # test simplest http setup: one client + one server
  833. #
  834. Class Test/http1 -superclass Test
  835. Test/http1 instproc init {} {
  836. $self set-defnet 3node
  837. $self next
  838. $self instvar finishTime_ 
  839. set finishTime_ 40
  840. # Use simple tcp agent
  841. Http set TRANSPORT_ SimpleTcp
  842. }
  843. Test/http1 instproc set-members {} {
  844. $self instvar ns_ src_ dst_ node_ ftp1_
  845. # set ftp1_ [$src_ attach-app FTP]
  846. $ns_ at 1.0 "$self start-connection 1 0"
  847. $ns_ at 9.0 "$self finish-connection 1 0"
  848. $ns_ at 10.0 "$self start-connection 1 2"
  849. $ns_ at 19.0 "$self finish-connection 1 2"
  850. }
  851. # Connect TCP source and destination after simulator starts
  852. Test/http1 instproc start-connection { s d } {
  853. $self instvar ns_ src_ dst_ node_
  854. set src_ [new Http/Client $ns_ $node_($s)]
  855. set dst_ [new Http/Server $ns_ $node_($d)]
  856. $src_ connect $dst_
  857. $src_ send-request $dst_ GET $dst_:1
  858. }
  859. Test/http1 instproc finish-connection { s d } {
  860. $self instvar ns_ src_ dst_ node_
  861. $src_ disconnect $dst_
  862. }
  863. Test/http1 instproc set-routing {} {
  864. $self instvar ns_
  865. $ns_ rtproto Session
  866. }
  867. Class Test/http1f -superclass Test/http1
  868. Test/http1f instproc init args {
  869. eval $self next $args
  870. Http set TRANSPORT_ FullTcp
  871. }
  872. #
  873. # Testing HTTP with one cache, one client and one server
  874. #
  875. Class Test/http2 -superclass Test
  876. Test/http2 instproc init {} {
  877. $self set-defnet 3node
  878. $self next
  879. $self instvar finishTime_ 
  880. set finishTime_ 40
  881. Http set TRANSPORT_ SimpleTcp
  882. }
  883. Test/http2 instproc set-routing {} {
  884. $self instvar ns_
  885. $ns_ rtproto Session
  886. }
  887. Test/http2 instproc set-members {} {
  888. $self instvar ns_ node_ client_ cache_ server_
  889. set client_ [new Http/Client $ns_ $node_(0)]
  890. set cache_ [new Http/Cache $ns_ $node_(1)]
  891. set server_ [new Http/Server $ns_ $node_(2)]
  892. $ns_ at 1.0 "$self start-connection"
  893. $ns_ at 9.0 "$self finish-connection"
  894. $ns_ at 21.0 "$self start-connection"
  895. $ns_ at 29.0 "$self finish-connection"
  896. }
  897. # Connect TCP source and destination after simulator starts
  898. Test/http2 instproc start-connection {} {
  899. $self instvar ns_ client_ server_ cache_ node_
  900. $client_ connect $cache_
  901. $cache_ connect $server_
  902. $cache_ set-parent $server_
  903. $client_ send-request $cache_ GET $server_:1 
  904. }
  905. Test/http2 instproc finish-connection {} {
  906. $self instvar client_ server_ cache_
  907. $client_ disconnect $cache_
  908. $cache_ disconnect $server_
  909. }
  910. Class Test/http2f -superclass Test/http2
  911. Test/http2f instproc init args {
  912. eval $self next $args
  913. Http set TRANSPORT_ FullTcp
  914. }
  915. #----------------------------------------------------------------------
  916. # Testing HTTP with one cache, multiple client and one server
  917. #----------------------------------------------------------------------
  918. Class Test/http3 -superclass Test
  919. Test/http3 instproc init {} {
  920. $self set-defnet 5node
  921. $self next
  922. $self instvar finishTime_ 
  923. set finishTime_ 40
  924. Http set TRANSPORT_ SimpleTcp
  925. }
  926. Test/http3 instproc set-routing {} {
  927. $self instvar ns_
  928. $ns_ rtproto Session
  929. }
  930. Test/http3 instproc set-members {} {
  931. $self instvar ns_ client_ cache_ server_ node_ test_
  932. set client_(0) [new Http/Client $ns_ $node_(0)]
  933. set client_(1) [new Http/Client $ns_ $node_(1)]
  934. set client_(2) [new Http/Client $ns_ $node_(2)]
  935. set cache_ [new Http/Cache $ns_ $node_(3)]
  936. set server_ [new Http/Server $ns_ $node_(4)]
  937. $ns_ at 1.0 "$self start-connection"
  938. $ns_ at 9.0 "$self finish-connection"
  939. # XXX
  940. # (1) If we set connection restarts time to 10.0, then we may
  941. # have a request sent out at 10.0 *before* the connection is 
  942. # actually re-established, which will result in the lose of a 
  943. # request packet and the blocking of subsequent requests.
  944. # (2) Currently when a connection is shut down, we do *NOT* 
  945. # clean up pending requests. This will result in the possible
  946. # blocking of requests after the connection is re-established. 
  947. # This test illustrates this effect.
  948. # The cleaning of a cache after disconnection is currently *NOT*
  949. # implemented. It can be disconnected but its behavior after
  950. # re-connection is not defined. NOTE: disconnection means 
  951. # explicitly call Http::disconnect(). Link dynamics and losses 
  952. # are supported.
  953. $ns_ at 9.9 "$self start-connection"
  954. $ns_ at 19.0 "$self finish-connection"
  955. }
  956. # Connect TCP source and destination after simulator starts
  957. Test/http3 instproc start-connection {} {
  958. $self instvar ns_ client_ server_ cache_ node_
  959. $client_(0) connect $cache_
  960. $client_(1) connect $cache_
  961. $client_(2) connect $cache_
  962. $cache_ connect $server_
  963. $cache_ set-parent $server_
  964. $self start-request
  965. }
  966. Test/http3 instproc start-request {} {
  967. $self instvar client_ ns_ cache_ server_
  968. $client_(0) send-request $cache_ GET $server_:0
  969. set tmp [expr [$ns_ now] + 1]
  970. $ns_ at $tmp "$client_(1) send-request $cache_ GET $server_:1"
  971. set tmp [expr $tmp + 1]
  972. $ns_ at $tmp "$client_(2) send-request $cache_ GET $server_:0"
  973. set tmp [expr $tmp + 2]
  974. $ns_ at $tmp "$self start-request"
  975. }
  976. Test/http3 instproc finish-connection {} {
  977. $self instvar client_ server_ cache_
  978. $client_(0) disconnect $cache_
  979. $client_(1) disconnect $cache_
  980. $client_(2) disconnect $cache_
  981. $cache_ disconnect $server_
  982. }
  983. Class Test/http3f -superclass Test/http3
  984. Test/http3f instproc init args {
  985. eval $self next $args
  986. Http set TRANSPORT_ FullTcp
  987. }
  988. #
  989. # Testing cache with TTL invalidation
  990. #
  991. Class Test/http4 -superclass Test
  992. Test/http4 instproc init {} {
  993. $self set-defnet 5node
  994. $self next
  995. $self instvar ns_ startTime_ finishTime_ 
  996. set startTime_ 1
  997. set finishTime_ 40
  998. Http set TRANSPORT_ SimpleTcp
  999. }
  1000. Test/http4 instproc set-routing {} {
  1001. $self instvar ns_
  1002. $ns_ rtproto Session
  1003. }
  1004. Test/http4 instproc set-topology {} {
  1005. $self instvar node_ ns_
  1006. for {set i 0} {$i < 5} {incr i} {
  1007. set node_($i) [$ns_ node]
  1008. }
  1009. $ns_ duplex-link $node_(3) $node_(4) 1Mb 50ms DropTail
  1010. $ns_ duplex-link $node_(0) $node_(3) 1Mb 50ms DropTail
  1011. $ns_ duplex-link $node_(1) $node_(3) 1Mb 50ms DropTail
  1012. $ns_ duplex-link $node_(2) $node_(3) 1Mb 50ms DropTail
  1013. }
  1014. Test/http4 instproc set-members {} {
  1015. $self instvar ns_ startTime_ client_ cache_ server_ node_ test_
  1016. set client_(0) [new Http/Client $ns_ $node_(0)]
  1017. set client_(1) [new Http/Client $ns_ $node_(1)]
  1018. set client_(2) [new Http/Client $ns_ $node_(2)]
  1019. set cache_ [new Http/Cache/TTL $ns_ $node_(3)]
  1020. set server_ [new Http/Server $ns_ $node_(4)]
  1021. $ns_ at $startTime_ "$self start-connection"
  1022. $ns_ at 10 "$self finish-connection"
  1023. }
  1024. Test/http4 instproc start-requests {} {
  1025. $self instvar client_ server_ cache_ ns_
  1026. $client_(0) send-request $cache_ GET $server_:0
  1027. set tmp [expr [$ns_ now] + 1]
  1028. $ns_ at $tmp "$client_(1) send-request $cache_ GET $server_:1"
  1029. incr tmp
  1030. $ns_ at $tmp "$client_(2) send-request $cache_ GET $server_:0"
  1031. incr tmp 3
  1032. $ns_ at $tmp "$self start-requests"
  1033. }
  1034. # Connect TCP source and destination after simulator starts
  1035. Test/http4 instproc start-connection {} {
  1036. $self instvar ns_ client_ server_ cache_ node_ 
  1037. $client_(0) connect $cache_
  1038. $client_(1) connect $cache_
  1039. $client_(2) connect $cache_
  1040. $cache_ connect $server_
  1041. $cache_ set-parent $server_
  1042. $self start-requests
  1043. }
  1044. Test/http4 instproc finish-connection {} {
  1045. $self instvar client_ server_ cache_
  1046. $client_(0) disconnect $cache_
  1047. $client_(1) disconnect $cache_
  1048. $client_(2) disconnect $cache_
  1049. $cache_ disconnect $server_
  1050. }
  1051. Class Test/http4f -superclass Test/http4
  1052. Test/http4f instproc init args {
  1053. eval $self next $args
  1054. Http set TRANSPORT_ FullTcp
  1055. }
  1056. #
  1057. # Testing PagePool
  1058. #
  1059. Class Test/PagePool -superclass Test
  1060. Test/PagePool instproc init {} {
  1061. $self instvar pgp_ 
  1062. global opts
  1063. set opts(page-file) pages
  1064. set pgp_ [new PagePool/Trace $opts(page-file)]
  1065. set max [$pgp_ get-poolsize]
  1066. set tmp [new RandomVariable/Uniform]
  1067. $tmp set min_ 0
  1068. $tmp set max_ [expr $max - 1]
  1069. $pgp_ ranvar $tmp
  1070. }
  1071. Test/PagePool instproc test-enumerate {} { 
  1072. $self instvar pgp_ log_
  1073. set max [$pgp_ get-poolsize]
  1074. for {set i 0} {$i < $max} {incr i} {
  1075. puts -nonewline $log_ "Page $i: "
  1076. puts -nonewline $log_ "size [$pgp_ gen-size $i] "
  1077. set mtime [$pgp_ gen-modtime $i -1]
  1078. puts -nonewline $log_ "ctime $mtime "
  1079. set tmp [$pgp_ gen-modtime $i $mtime]
  1080. while {$tmp != $mtime} {
  1081. puts -nonewline $log_ "mtime $tmp "
  1082. set mtime $tmp
  1083. set tmp [$pgp_ gen-modtime $i $mtime]
  1084. }
  1085. puts $log_ ""
  1086. }
  1087. }
  1088. Test/PagePool instproc test-getpageid {} {
  1089. $self instvar pgp_ log_
  1090. set max [$pgp_ get-poolsize]
  1091. for {set i 0} {$i < $max} {incr i} {
  1092. set id [$pgp_ gen-pageid 0]
  1093. puts -nonewline $log_ "Page $id: "
  1094. puts -nonewline $log_ "size [$pgp_ gen-size $id] "
  1095. set mtime [$pgp_ gen-modtime $id -1]
  1096. puts -nonewline $log_ "ctime $mtime "
  1097. set tmp [$pgp_ gen-modtime $id $mtime]
  1098. while {$tmp != $mtime} {
  1099. puts -nonewline $log_ "mtime $tmp "
  1100. set mtime $tmp
  1101. set tmp [$pgp_ gen-modtime $id $mtime]
  1102. }
  1103. puts $log_ ""
  1104. }
  1105. }
  1106. Test/PagePool instproc run {} {
  1107. $self instvar log_
  1108. set log_ [open "temp.rands" w]
  1109. $self test-getpageid
  1110. $self test-enumerate
  1111. close $log_
  1112. }
  1113. #----------------------------------------------------------------------
  1114. # Testing simplest case for heartbeat message: 1 client+1 cache+1 server
  1115. #----------------------------------------------------------------------
  1116. # Multicast invalidation + server invalidation
  1117. Class Test/cache0-inv -superclass Test-Cache
  1118. Test/cache0-inv instproc init {} {
  1119. $self set-defnet cache0
  1120. $self next
  1121. $self set-server-type /Inval/Yuc
  1122. $self set-cache-type /Inval/Mcast
  1123. $self set-client-type ""
  1124. Http set TRANSPORT_ SimpleTcp
  1125. }
  1126. Test/cache0-inv instproc set-connections {} {
  1127. $self instvar client_ server_ cache_ 
  1128. # XXX Should always let server connects to cache first, then requests
  1129. $client_(0) connect $cache_(0)
  1130. $server_(0) connect $cache_(0)
  1131. $server_(0) set-parent-cache $cache_(0)
  1132. }
  1133. Test/cache0-inv instproc start-requests {} {
  1134. $self instvar client_ cache_ server_ ns_
  1135. $client_(0) start $cache_(0) $server_(0)
  1136. }
  1137. # Mcast inval
  1138. Class Test/cache0f-inv -superclass Test/cache0-inv
  1139. Test/cache0f-inv instproc init args {
  1140. eval $self next $args
  1141. Http set TRANSPORT_ FullTcp
  1142. }
  1143. # Push + mcast inval
  1144. Class Test/cache0-push -superclass Test/cache0-inv
  1145. Test/cache0-push instproc create-members {} {
  1146. $self next
  1147. $self instvar cache_ server_
  1148. $server_(0) set enable_upd_ 1
  1149. $cache_(0) set enable_upd_ 1
  1150. }
  1151. Class Test/cache0f-push -superclass {Test/cache0-push Test/cache0f-inv}
  1152. # TTL 
  1153. Class Test/cache0-ttl -superclass Test/cache0-inv
  1154. Test/cache0-ttl instproc init args {
  1155. eval $self next $args
  1156. $self set-server-type ""
  1157. $self set-cache-type /TTL
  1158. $self set-client-type ""
  1159. }
  1160. Test/cache0-ttl instproc set-connections {} {
  1161. $self instvar client_ server_ cache_ 
  1162. # XXX Should always let server connects to cache first, then requests
  1163. $client_(0) connect $cache_(0)
  1164. $cache_(0) connect $server_(0)
  1165. $server_(0) set-parent-cache $cache_(0)
  1166. }
  1167. Class Test/cache0f-ttl -superclass {Test/cache0f-inv Test/cache0-ttl}
  1168. # Omniscient TTL
  1169. Class Test/cache0-ottl -superclass Test/cache0-ttl
  1170. Test/cache0-ottl instproc init args {
  1171. eval $self next $args
  1172. $self set-cache-type /TTL/Omniscient
  1173. }
  1174. Class Test/cache0f-ottl -superclass {Test/cache0-ottl Test/cache0f-ttl}
  1175. #----------------------------------------------------------------------
  1176. # Two hierarchies #1: server0 -> root cache 0
  1177. #----------------------------------------------------------------------
  1178. Class Test/TLC1 -superclass Test-Cache
  1179. Test/TLC1 instproc init {} {
  1180. # Do our own initialization
  1181. global opts
  1182. set opts(duration) 500
  1183. set opts(avg-page-age) 60
  1184. set opts(avg-req-interval) 6
  1185. set opts(hb-interval) 6
  1186. $self set-defnet cache2
  1187. $self next
  1188. $self set-cache-type /Inval/Mcast 
  1189. $self set-server-type /Inval/Yuc
  1190. $self set-client-type ""
  1191. Http set TRANSPORT_ SimpleTcp
  1192. }
  1193. Test/TLC1 instproc start-requests {} {
  1194. $self instvar client_ cache_ server_
  1195. $client_(0) start $cache_(2) $server_(0)
  1196. $client_(1) start $cache_(6) $server_(0)
  1197. $client_(2) start $cache_(4) $server_(0)
  1198. $client_(3) start $cache_(1) $server_(0)
  1199. }
  1200. Test/TLC1 instproc set-connections {} {
  1201. $self instvar client_ cache_ server_
  1202. $client_(0) connect $cache_(2)
  1203. $client_(1) connect $cache_(6)
  1204. $client_(2) connect $cache_(4)
  1205. $client_(3) connect $cache_(1)
  1206. $cache_(2) connect $cache_(0)
  1207. $cache_(2) set-parent $cache_(0)
  1208. $cache_(3) connect $cache_(0)
  1209. $cache_(3) set-parent $cache_(0)
  1210. $cache_(6) connect $cache_(2)
  1211. $cache_(6) set-parent $cache_(2)
  1212. $cache_(4) connect $cache_(1)
  1213. $cache_(4) set-parent $cache_(1)
  1214. $cache_(5) connect $cache_(1)
  1215. $cache_(5) set-parent $cache_(1)
  1216. # XXX
  1217. # We also need TCP connections between TLCs, but the order in which
  1218. # they are connected is tricky. I.e., the cache that first sends 
  1219. # out a packet should connect first. But how do we know which cache
  1220. # would send out a packet first???
  1221. $cache_(1) connect $cache_(0)
  1222. }
  1223. Test/TLC1 instproc set-groups {} {
  1224. $self instvar client_ cache_ server_ mh_
  1225. # TBA group setup stuff...
  1226. set grp [Node allocaddr]
  1227. $cache_(0) join-tlc-group $grp
  1228. $cache_(1) join-tlc-group $grp
  1229. $mh_ switch-treetype $grp
  1230. set grp [Node allocaddr]
  1231. $cache_(0) init-inval-group $grp
  1232. $cache_(2) join-inval-group $grp
  1233. $cache_(3) join-inval-group $grp
  1234. $mh_ switch-treetype $grp
  1235. set grp [Node allocaddr]
  1236. $cache_(1) init-inval-group $grp
  1237. $cache_(4) join-inval-group $grp
  1238. $cache_(5) join-inval-group $grp
  1239. $mh_ switch-treetype $grp
  1240. set grp [Node allocaddr]
  1241. $cache_(2) init-inval-group $grp
  1242. $cache_(6) join-inval-group $grp
  1243. $mh_ switch-treetype $grp
  1244. # XXX Must let the server to initialize connection, because it's 
  1245. # going to send out the first packet
  1246. $cache_(1) connect $server_(0)
  1247. $server_(0) connect $cache_(0)
  1248. # XXX Must do this at the end. It'll trigger a lot of JOINs.
  1249. $server_(0) set-parent-cache $cache_(0)
  1250. # XXX Must do this when using multiple hierarchies
  1251. $server_(0) set-tlc $cache_(0)
  1252. }
  1253. Class Test/TLC1f -superclass Test/TLC1
  1254. Test/TLC1f instproc init {} {
  1255. $self next
  1256. Http set TRANSPORT_ FullTcp
  1257. }
  1258. #
  1259. # Two hierarchies with direct request
  1260. #
  1261. #Class Test/TLC1-dreq -superclass Test/TLC1
  1262. # Test/TLC1-dreq instproc init {} {
  1263. #  $self next
  1264. #  $self set-cache-type /Inval/Mcast/Perc
  1265. # }
  1266. # Set up direct connections from leaf caches (i.e., all caches who 
  1267. # may connect to a browser) to the server
  1268. # Test/TLC1-dreq instproc set-connections {} {
  1269. #  $self next
  1270. #  $self instvar cache_ server_
  1271. #  $cache_(1) connect $server_(0)
  1272. #  $cache_(2) connect $server_(0)
  1273. #  $cache_(4) connect $server_(0)
  1274. #  $cache_(6) connect $server_(0)
  1275. #  $cache_(1) set direct_request_ 1
  1276. #  $cache_(2) set direct_request_ 1
  1277. #  $cache_(4) set direct_request_ 1
  1278. #  $cache_(6) set direct_request_ 1
  1279. # }
  1280. #----------------------------------------------------------------------
  1281. # Testing server/cache liveness messages and failure recovery
  1282. #----------------------------------------------------------------------
  1283. Class Test/Liveness -superclass Test-Cache
  1284. Test/Liveness instproc init {} {
  1285. # Set default initialization values
  1286. global opts
  1287. set opts(duration) 1200 ;# Link heals at time 1000.
  1288. set opts(avg-page-age) 60
  1289. set opts(avg-req-interval) 60
  1290. set opts(hb-interval) 30
  1291. $self set-defnet cache4d
  1292. $self next
  1293. $self set-cache-type /Inval/Mcast
  1294. $self set-server-type /Inval/Yuc
  1295. $self set-client-type ""
  1296. # Must use FullTcp, because we'll have packet loss, etc.
  1297. Http set TRANSPORT_ FullTcp
  1298. }
  1299. Test/Liveness instproc start-requests {} {
  1300. $self instvar client_ cache_ server_ ns_
  1301. $client_(0) start $cache_(3) $server_(0)
  1302. $client_(1) start $cache_(4) $server_(0)
  1303. $client_(2) start $cache_(5) $server_(0)
  1304. $client_(3) start $cache_(6) $server_(0)
  1305. # puts "At [$ns_ now], request starts"
  1306. }
  1307. Test/Liveness instproc set-connections {} {
  1308. $self instvar ns_ client_ server_ cache_ 
  1309. # Enable dynamics somewhere
  1310. $client_(0) connect $cache_(3)
  1311. $client_(1) connect $cache_(4)
  1312. $client_(2) connect $cache_(5)
  1313. $client_(3) connect $cache_(6)
  1314. $cache_(1) connect $cache_(0)
  1315. $cache_(2) connect $cache_(0)
  1316. $cache_(3) connect $cache_(1)
  1317. $cache_(4) connect $cache_(1)
  1318. $cache_(5) connect $cache_(2)
  1319. $cache_(6) connect $cache_(2)
  1320. $cache_(1) set-parent $cache_(0)
  1321. $cache_(2) set-parent $cache_(0)
  1322. $cache_(3) set-parent $cache_(1)
  1323. $cache_(4) set-parent $cache_(1)
  1324. $cache_(5) set-parent $cache_(2)
  1325. $cache_(6) set-parent $cache_(2)
  1326. # All TLCs have connection to server
  1327. $cache_(0) connect $server_(0)
  1328. # Parent cache of the server is e3
  1329. $server_(0) connect $cache_(3)
  1330. }
  1331. Test/Liveness instproc set-groups {} {
  1332. $self instvar cache_ mh_ server_
  1333. set grp [Node allocaddr]
  1334. $cache_(0) init-inval-group $grp
  1335. $cache_(1) join-inval-group $grp
  1336. $cache_(2) join-inval-group $grp
  1337. $mh_ switch-treetype $grp
  1338. set grp [Node allocaddr]
  1339. $cache_(1) init-inval-group $grp
  1340. $cache_(3) join-inval-group $grp
  1341. $cache_(4) join-inval-group $grp
  1342. $mh_ switch-treetype $grp
  1343. set grp [Node allocaddr]
  1344. $cache_(2) init-inval-group $grp
  1345. $cache_(5) join-inval-group $grp
  1346. $cache_(6) join-inval-group $grp
  1347. $mh_ switch-treetype $grp
  1348. $server_(0) set-parent-cache $cache_(3)
  1349. }
  1350. #----------------------------------------------------------------------
  1351. # Test Group 1: 
  1352. #
  1353. # Poisson page mods and Poisson requests, one bottleneck link, 2-level 
  1354. # cache hierarchy with a single TLC. No loss.
  1355. #
  1356. # Comparing Invalidation, TTL and OTTL.
  1357. #
  1358. # Testing Mcast+Yucd using a bottleneck topology
  1359. #----------------------------------------------------------------------
  1360. Class Test/Mcast-PB -superclass Test-Cache
  1361. Test/Mcast-PB instproc init {} {
  1362. # Our own initializations
  1363. global opts
  1364. set opts(duration) 200
  1365. set opts(avg-page-age) 10
  1366. set opts(avg-req-interval) 6
  1367. set opts(hb-interval) 6
  1368. set opts(num-2nd-cache) 5
  1369. $self set-defnet BottleNeck
  1370. $self next
  1371. $self instvar secondCaches_
  1372. set secondCaches_ $opts(num-2nd-cache)
  1373. $self set-cache-type /Inval/Mcast
  1374. $self set-server-type /Inval/Yuc
  1375. $self set-client-type ""
  1376. }
  1377. Test/Mcast-PB instproc start-requests {} {
  1378. $self instvar client_ cache_ server_ secondCaches_
  1379. set n $secondCaches_
  1380. for {set i 0} {$i < $n} {incr i} {
  1381. $client_($i) start $cache_($i) $server_(0)
  1382. }
  1383. $self instvar pgp_ topo_ ns_
  1384. # Because Test/Cache::init{} already did set-pagepool{}, now we 
  1385. # know how many pages we have. Estimate the cache population time
  1386. # by NumPages*1+10, then start bandwidth monitoring after 
  1387. # the caches are populated with pages
  1388. $ns_ at [expr [$ns_ now] + [$pgp_ get-poolsize] + 10] 
  1389. "$topo_ start-monitor $ns_"
  1390. }
  1391. Test/Mcast-PB instproc set-connections {} {
  1392. $self instvar ns_ client_ server_ cache_ secondCaches_
  1393. set n $secondCaches_
  1394. for {set i 0} {$i < $n} {incr i} {
  1395. $client_($i) connect $cache_($i)
  1396. $cache_($i) connect $cache_($n)
  1397. $cache_($i) set-parent $cache_($n)
  1398. }
  1399. $cache_($n) connect $server_(0)
  1400. $self connect-server
  1401. }
  1402. Test/Mcast-PB instproc connect-server {} {
  1403. $self instvar server_ cache_
  1404. $server_(0) connect $cache_(0)
  1405. }
  1406. Test/Mcast-PB instproc set-groups {} {
  1407. $self instvar cache_ server_ secondCaches_ mh_
  1408. set n $secondCaches_
  1409. set grp1 [Node allocaddr]
  1410. set grp2 [Node allocaddr]
  1411. $cache_($n) init-inval-group $grp1
  1412. $cache_($n) init-update-group $grp2
  1413. for {set i 0} {$i < $n} {incr i} {
  1414. $cache_($i) join-inval-group $grp1
  1415. $cache_($i) join-update-group $grp2
  1416. }
  1417. $mh_ switch-treetype $grp1
  1418. $mh_ switch-treetype $grp2
  1419. $server_(0) set-parent-cache $cache_(0)
  1420. }
  1421. Test/Mcast-PB instproc collect-stat {} {
  1422. $self instvar topo_ client_ server_ cache_ secondCaches_
  1423. set bw [$topo_ mon-stat]
  1424. set sn 0
  1425. set gn 0
  1426. set st(max) 0
  1427. set st(min) 98765432
  1428. set st(avg) 0
  1429. set rt(max) 0
  1430. set rt(min) 98765432
  1431. set rt(avg) 0
  1432. foreach c [array names client_] {
  1433. set gn [expr $gn + [$client_($c) stat req-num]]
  1434. set sn [expr $sn + [$client_($c) stat stale-num]]
  1435. set st(avg) [expr $st(avg) + [$client_($c) stat stale-time]]
  1436. set tmp [$client_($c) stat st-min]
  1437. if { $tmp < $st(min) } { set st(min) $tmp }
  1438. set tmp [$client_($c) stat st-max]
  1439. if { $tmp > $st(max) } { set st(max) $tmp }
  1440. set rt(avg) [expr $rt(avg) + [$client_($c) stat rep-time]]
  1441. set tmp [$client_($c) stat rt-max]
  1442. if { $tmp > $rt(max) } { set rt(max) $tmp }
  1443. set tmp [$client_($c) stat rt-min]
  1444. if { $tmp < $rt(min) } { set rt(min) $tmp }
  1445. }
  1446. if {$st(max) < $st(min)} {
  1447. set st(max) 0
  1448. set st(min) 0
  1449. }
  1450. if {$rt(max) < $rt(min)} {
  1451. set rt(max) 0
  1452. set rt(min) 0
  1453. }
  1454. set sr [expr double($sn) / $gn * 100]
  1455. if [catch {set st(avg) [expr double($st(avg)) / $sn]}] {
  1456. set st(avg) 0 ;# No stale hits
  1457. set rt(avg) [expr double($rt(avg)) / $gn]
  1458. set ims 0
  1459. foreach c [array names cache_] {
  1460. set ims [expr $ims + [$cache_($c) stat ims-num]]
  1461. }
  1462. set res [list sr $sr sh [$server_(0) stat hit-num] th [$cache_($secondCaches_) stat hit-num] st $st(avg) st-max $st(max) st-min $st(min) rt $rt(avg) rt-max $rt(max) rt-min $rt(min) mn [$server_(0) stat mod-num] ims-num $ims]
  1463. return [concat $bw $res]
  1464. }
  1465. Test/Mcast-PB instproc output-stat { args } {
  1466. eval array set d $args
  1467. global opts 
  1468. # XXX Don't have statistics for total bandwidth. :(
  1469. #puts "$opts(hb-interval) Bandwidth*Hop -1 Stale $d(sr) AverageRepTime $d(rt) BottleneckBW $d(btnk_bw) ServerBW $d(svr_bw) StaleTime $d(st)"
  1470. }
  1471. Test/Mcast-PB instproc finish {} {
  1472. global opts
  1473. if $opts(quiet) {
  1474. $self output-stat [$self collect-stat]
  1475. }
  1476. $self next
  1477. }
  1478. #
  1479. # Same as mcast-PB, except using Inval/Mcast/Perc cache
  1480. Class Test/Mcast-PBP -superclass Test/Mcast-PB
  1481. Test/Mcast-PBP instproc init {} {
  1482. $self next
  1483. $self set-cache-type /Inval/Mcast/Perc
  1484. }
  1485. #
  1486. # Same as mcast-PB, except enabled selective push of updates
  1487. #
  1488. Class Test/Mcast-PBU -superclass Test/Mcast-PB
  1489. Test/Mcast-PBU instproc create-members {} {
  1490. $self next
  1491. $self instvar cache_ server_
  1492. foreach n [array names cache_] {
  1493. $cache_($n) set enable_upd_ 1
  1494. }
  1495. foreach n [array names server_] {
  1496. $server_($n) set enable_upd_ 1
  1497. }
  1498. }
  1499. #
  1500. # Mcast invalidation + selective push + mandatory push
  1501. #
  1502. Class Test/Mcast-PBU-MP -superclass Test/Mcast-PBU
  1503. Test/Mcast-PBU-MP instproc create-members {} {
  1504. $self next
  1505. $self instvar client_ ns_ server_
  1506. $ns_ at 100.0 "$client_(1) request-mpush $server_(0):0"
  1507. $ns_ at 500.0 "$client_(1) stop-mpush $server_(0):0"
  1508. }
  1509. #
  1510. # Testing TTL using a bottleneck topology
  1511. #
  1512. Class Test/ttl-PB -superclass Test/Mcast-PB
  1513. Test/ttl-PB instproc init {} {
  1514. global opts
  1515. set opts(ttl) 0.1
  1516. $self next
  1517. $self set-cache-type /TTL
  1518. $self set-server-type ""
  1519. $self set-client-type ""
  1520. }
  1521. Test/ttl-PB instproc create-members {} {
  1522. $self next
  1523. global opts
  1524. $self instvar cache_
  1525. foreach n [array names cache_] {
  1526. $cache_($n) set-thresh $opts(ttl)
  1527. }
  1528. }
  1529. Test/ttl-PB instproc set-groups {} {
  1530. # We do not set any mcast groups
  1531. }
  1532. Test/ttl-PB instproc connect-server {} {
  1533. $self instvar server_ cache_
  1534. $cache_(0) connect $server_(0)
  1535. }
  1536. Test/ttl-PB instproc output-stat { args } {
  1537. eval array set d $args
  1538. global opts 
  1539. # XXX Don't have statistics for total bandwidth. :(
  1540. #puts "$opts(ttl) Bandwidth*Hop -1 Stale $d(sr) AverageRepTime $d(rt) BottleneckBW $d(btnk_bw) ServerBW $d(svr_bw) StaleTime $d(st)"
  1541. }
  1542. #
  1543. # Testing Omniscient TTL using a bottleneck topology
  1544. #
  1545. Class Test/ottl-PB -superclass {Test/ttl-PB Test/Mcast-PB}
  1546. Test/ottl-PB instproc init {} {
  1547. $self next
  1548. $self set-cache-type /TTL/Omniscient
  1549. $self set-server-type ""
  1550. $self set-client-type ""
  1551. }
  1552. Test/ottl-PB instproc output-stat { args } {
  1553. eval array set d $args
  1554. # XXX Don't have statistics for total bandwidth. :(
  1555. #puts "Bandwidth*Hop -1 Stale $d(sr) AverageRepTime $d(rt) BottleneckBW $d(btnk_bw) ServerBW $d(svr_bw) StaleTime $d(st)"
  1556. }
  1557. #
  1558. # All the above tests with real traces
  1559. #
  1560. Class Test/Mcast-PBtr -superclass Test/Mcast-PB
  1561. Test/Mcast-PBtr instproc init {} {
  1562. $self inherit-set pagepoolType_ "ProxyTrace"
  1563. $self next
  1564. Http set TRANSPORT_ FullTcp
  1565. }
  1566. Test/Mcast-PBtr instproc populate-cache {} {
  1567. # Populate servers and caches with pages.
  1568. # Do not use Http/Client::populate{}!
  1569. $self instvar pgp_ cache_ server_ secondCaches_ startTime_ ns_
  1570. set n $secondCaches_
  1571. for {set i 0} {$i < [$pgp_ get-poolsize]} {incr i} {
  1572. set pageid $server_(0):$i
  1573. $server_(0) gen-page $pageid
  1574. #set pageinfo [$server_(0) get-page $pageid]
  1575. #for {set j 0} {$j < $secondCaches_} {incr j} {
  1576. # eval $cache_($j) enter-page $pageid $pageinfo
  1577. #}
  1578. #eval $cache_($secondCaches_) enter-page $pageid $pageinfo
  1579. # if {$i % 1000 == 0} {
  1580. # puts "$i pages populated"
  1581. # }
  1582. }
  1583. }
  1584. Test/Mcast-PBtr instproc start-connection {} {
  1585. $self next
  1586. $self populate-cache
  1587. }
  1588. Test/Mcast-PBtr instproc start-requests {} {
  1589. $self instvar client_ cache_ server_ secondCaches_
  1590. for {set i 0} {$i < $secondCaches_} {incr i} {
  1591. # Use start-session{} to avoid populating cache
  1592. $client_($i) start-session $cache_($i) $server_(0)
  1593. }
  1594. $self instvar topo_ ns_
  1595. $topo_ start-monitor $ns_
  1596. }
  1597. Test/Mcast-PBtr instproc set-pagepool {} {
  1598. $self instvar startTime_ finishTime_ pgp_ ns_ pagepoolType_
  1599. global opts
  1600. if {![info exists opts(xtrace-req)] || ![info exists opts(xtrace-page)]} {
  1601. error "Must supply request logs and page logs of proxy traces"
  1602. }
  1603. set pgp_ [new PagePool/$pagepoolType_]
  1604. $pgp_ set-reqfile $opts(xtrace-req)
  1605. $pgp_ set-pagefile $opts(xtrace-page)
  1606. $pgp_ bimodal-ratio 0.1
  1607. $pgp_ set-client-num $opts(num-2nd-cache)
  1608. # XXX Do *NOT* set start time of page generators. It'll be set
  1609. # after the cache population phase
  1610. # Estimate a finish time
  1611. set opts(duration) [$pgp_ get-duration]
  1612. set finishTime_ [expr $opts(duration) + $startTime_]
  1613. #puts "Duration changed to $opts(duration), finish at $finishTime_"
  1614. $self instvar ageRNG_
  1615. if ![info exists ageRNG_] {
  1616. set ageRNG_ [new RNG]
  1617. $ageRNG_ seed $opts(ns-random-seed)
  1618. }
  1619. # Dynamic page, with page modification 
  1620. set tmp [new RandomVariable/Uniform]
  1621. $tmp use-rng $ageRNG_
  1622. $tmp set min_ [expr $opts(avg-page-age)*0.001]
  1623. $tmp set max_ [expr $opts(avg-page-age)*1.999]
  1624. $pgp_ ranvar-dp $tmp
  1625. # Static page
  1626. set tmp [new RandomVariable/Uniform]
  1627. $tmp use-rng $ageRNG_
  1628. $tmp set min_ [expr $finishTime_ * 1.1]
  1629. $tmp set max_ [expr $finishTime_ * 1.2]
  1630. $pgp_ ranvar-sp $tmp
  1631. }
  1632. # Set every client's request generator to pgp_
  1633. Test/Mcast-PBtr instproc set-req-generator { client } {
  1634. $self instvar pgp_
  1635. $client set-page-generator $pgp_
  1636. }
  1637. Class Test/Mcast-PBPtr -superclass {Test/Mcast-PBP Test/Mcast-PBtr}
  1638. Class Test/Mcast-PBUtr -superclass {Test/Mcast-PBU Test/Mcast-PBtr}
  1639. Class Test/ttl-PBtr -superclass {Test/ttl-PB Test/Mcast-PBtr}
  1640. Class Test/ottl-PBtr -superclass {Test/ottl-PB Test/Mcast-PBtr}
  1641. #----------------------------------------------------------------------
  1642. # Test group 2
  1643. #
  1644. # Same as test group 1, except using compound pages
  1645. #
  1646. # Mcast-PB with compound pages
  1647. #----------------------------------------------------------------------
  1648. Class Test/mmcast-PB -superclass Test/Mcast-PB
  1649. Test/mmcast-PB instproc init {} {
  1650. $self next
  1651. $self set-cache-type /Inval/Mcast/Perc
  1652. $self set-server-type /Inval/MYuc
  1653. $self set-client-type /Compound
  1654. }
  1655. Test/mmcast-PB instproc set-pagepool {} {
  1656. $self instvar startTime_ finishTime_ pgp_
  1657. global opts
  1658. # Use PagePool/Math, which means a single page
  1659. set pgp_ [new PagePool/CompMath]
  1660. # Size generator
  1661. $pgp_ set main_size_ $opts(avg-page-size)
  1662. $pgp_ set comp_size_ $opts(comp-page-size)
  1663. # Age generator
  1664. $self instvar ageRNG_
  1665. if ![info exists ageRNG_] {
  1666. set ageRNG_ [new RNG]
  1667. $ageRNG_ seed $opts(ns-random-seed)
  1668. }
  1669. set tmp [new RandomVariable/Exponential]
  1670. $tmp use-rng $ageRNG_
  1671. $tmp set avg_ $opts(avg-page-age)
  1672. $pgp_ ranvar-main-age $tmp
  1673. # Compound age generator
  1674. $self instvar compAgeRNG_
  1675. if ![info exists compAgeRNG_] {
  1676. set compAgeRNG_ [new RNG]
  1677. $compAgeRNG_ seed $opts(ns-random-seed)
  1678. }
  1679. set tmp [new RandomVariable/Uniform]
  1680. $tmp use-rng $compAgeRNG_
  1681. $tmp set min_ [expr $opts(avg-comp-page-age) * 0.9]
  1682. $tmp set max_ [expr $opts(avg-comp-page-age) * 1.1]
  1683. $pgp_ ranvar-obj-age $tmp
  1684. $pgp_ set num_pages_ [expr $opts(num-comp-pages) + 1]
  1685. $pgp_ set start_time_ $startTime_
  1686. set finishTime_ [expr $startTime_ + $opts(duration)]
  1687. # puts "Start at $startTime_, stop at $finishTime_"
  1688. }
  1689. #
  1690. # selective push + inval
  1691. #
  1692. Class Test/mmcast-PBU -superclass {Test/Mcast-PBU Test/mmcast-PB}
  1693. #
  1694. # TTL with compound page
  1695. #
  1696. Class Test/mttl-PB -superclass {Test/ttl-PB Test/mmcast-PB}
  1697. Test/mttl-PB instproc init {} {
  1698. $self next
  1699. $self set-cache-type /TTL
  1700. $self set-server-type /Compound
  1701. $self set-client-type /Compound
  1702. }
  1703. #
  1704. # Omniscient TTL + compound page
  1705. #
  1706. Class Test/mottl-PB -superclass {Test/ottl-PB Test/mmcast-PB}
  1707. Test/mottl-PB instproc init {} {
  1708. $self next
  1709. $self set-cache-type /TTL/Omniscient
  1710. $self set-server-type /Compound
  1711. $self set-client-type /Compound
  1712. }
  1713. #----------------------------------------------------------------------
  1714. # Test group 3
  1715. #
  1716. # Comparison of direct request+invalidation vs ttl+direct request
  1717. #
  1718. # Topology is derived from the BottleNeck topology. It adds additional
  1719. # direct links from every leaf cache to the web server. This link is
  1720. # used to model the "short path" from leaf caches to the server.
  1721. #----------------------------------------------------------------------
  1722. Class Test-dreq -superclass Test-Cache
  1723. Test-dreq instproc init {} {
  1724.     $self set-defnet cache5
  1725.     $self next
  1726.     
  1727.     $self instvar secondCaches_
  1728.     global opts
  1729.     set secondCaches_ $opts(num-2nd-cache)
  1730. }
  1731. Test-dreq instproc start-requests {} {
  1732. $self instvar client_ server_ cache_ secondCaches_
  1733. for {set i 0} {$i < $secondCaches_} {incr i} {
  1734. $client_($i) start $cache_($i) $server_(0)
  1735. }
  1736. }
  1737. Test-dreq instproc set-connections {} {
  1738. $self instvar client_ server_ cache_ secondCaches_ ns_
  1739. for {set i 0} {$i < $secondCaches_} {incr i} {
  1740. $client_($i) connect $cache_($i)
  1741. }
  1742. }
  1743. Test-dreq instproc collect-stat {} {
  1744. $self instvar topo_ client_ secondCaches_
  1745. $topo_ instvar qmon_
  1746. set svr_bw 0
  1747. for {set i 0} {$i < $secondCaches_} {incr i} {
  1748. set svr_bw [expr [$qmon_(svr_f$i) set bdepartures_] + 
  1749. $svr_bw + [$qmon_(svr_t$i) set bdepartures_]]
  1750. }
  1751. set btnk_bw [expr [$qmon_(btnk_f) set bdepartures_] + 
  1752. [$qmon_(btnk_t) set bdepartures_]]
  1753. set sn 0
  1754. set gn 0
  1755. set st 0
  1756. set rt 0
  1757. foreach c [array names client_] {
  1758. set gn [expr $gn + [$client_($c) stat req-num]]
  1759. set sn [expr $sn + [$client_($c) stat stale-num]]
  1760. set st [expr $st + [$client_($c) stat stale-time]]
  1761. set rt [expr $rt + [$client_($c) stat rep-time]]
  1762. }
  1763. set sr [expr double($sn) / $gn * 100]
  1764. if [catch {set st [expr double($st) / $sn]}] {
  1765. set st 0 ;# No stale hits
  1766. }
  1767. set rt [expr double($rt) / $gn]
  1768. return [list svr_bw $svr_bw btnk_bw $btnk_bw sr $sr st $st rt $rt]
  1769. }
  1770. Test-dreq instproc finish {} {
  1771. $self output-stat [$self collect-stat]
  1772. $self next
  1773. }
  1774. #Class Test/mcast-dreq -superclass Test-dreq
  1775. #Test/mcast-dreq instproc init {} {
  1776. # $self next
  1777. #  $self set-cache-type /Inval/Mcast/Perc
  1778. #  $self set-server-type /Inval/Yuc
  1779. #  $self set-client-type ""
  1780. # }
  1781. # Test/mcast-dreq instproc output-stat { args } {
  1782. #  eval array set d $args
  1783. #  global opts 
  1784. #  # XXX Don't have statistics for total bandwidth. :(
  1785. #  #puts "$opts(hb-interval) Bandwidth*Hop -1 Stale $d(sr) AverageRepTime $d(rt) BottleneckBW $d(btnk_bw) ServerBW $d(svr_bw) StaleTime $d(st)"
  1786. # }
  1787. # Test/mcast-dreq instproc set-connections {} {
  1788. #  $self next ;# connecting clients
  1789. #  $self instvar server_ cache_ secondCaches_ 
  1790. #  set n $secondCaches_
  1791. #  for {set i 0} {$i < $secondCaches_} {incr i} {
  1792. #  $cache_($i) connect $cache_($n)
  1793. #  $cache_($i) set-parent $cache_($n)
  1794. #  if $i {
  1795. #  # Let all leaf caches connect to server
  1796. #  $cache_($i) connect $server_(0)
  1797. #  }
  1798. #  }
  1799. #  $cache_($n) connect $server_(0)
  1800. #  $server_(0) connect $cache_(0)
  1801. # }
  1802. # Test/mcast-dreq instproc set-groups {} {
  1803. #  $self instvar cache_ server_ secondCaches_ mh_
  1804. #  set n $secondCaches_
  1805. #  set grp1 [Node allocaddr]
  1806. #  set grp2 [Node allocaddr]
  1807. #  $cache_($n) init-inval-group $grp1
  1808. #  $cache_($n) init-update-group $grp2
  1809. #  for {set i 0} {$i < $n} {incr i} {
  1810. #  $cache_($i) join-inval-group $grp1
  1811. #  $cache_($i) join-update-group $grp2
  1812. #  # Every leaf cache uses direct request
  1813. #  $cache_($i) set direct_request_ 1
  1814. #  }
  1815. #  $mh_ switch-treetype $grp1
  1816. #  $mh_ switch-treetype $grp2
  1817. #  $server_(0) set-parent-cache $cache_(0)
  1818. # }
  1819. #----------------------------------------------------------------------
  1820. # Options 
  1821. #----------------------------------------------------------------------
  1822. global raw_opt_info
  1823. set raw_opt_info {
  1824. # Random number seed; default is 0, so ns will give a 
  1825. # diff. one on each invocation.
  1826. # XXX Get a "good" seed from predef_seeds[] in rng.cc
  1827. ns-random-seed 188312339
  1828. # Animation options; complete traces are useful
  1829. # for nam only, so do those only when a tracefile
  1830. # is being used for nam
  1831. nam-trace-all 1
  1832. enable-log 0
  1833. # Tests to be used
  1834. prot
  1835. duration 500
  1836.     
  1837. # Trace file used for PagePool
  1838. page-file 
  1839. # TTL threshold
  1840. ttl 0.1
  1841. # Cache type
  1842. cache 
  1843. # server type
  1844. server 
  1845. # Packet size configurations
  1846. cache-ims-size 50
  1847. cache-ref-size 50
  1848. server-inv-size 43
  1849. client-req-size 43
  1850. # request intervals
  1851. min-req-interval 50
  1852. max-req-interval 70
  1853. avg-req-interval 60
  1854. min-page-size 100
  1855. max-page-size 50000
  1856. avg-page-size 1024
  1857. min-page-age  50
  1858. max-page-age  70
  1859. avg-page-age  60
  1860. # compound page size: 50K
  1861. comp-page-size 51200
  1862. avg-comp-page-age 40000
  1863. num-comp-pages 1
  1864. # If we use only one page
  1865. single-page 1
  1866. hb-interval 30
  1867. upd-interval 5
  1868. # Number of second level caches. Needed by Topology/BottleNeck
  1869. num-2nd-cache 5
  1870. scheduler-type Calendar
  1871. # Proxy trace files: requests and pages
  1872. xtrace-req webtrace-reqlog
  1873. xtrace-page webtrace-pglog
  1874. }
  1875. #----------------------------------------------------------------------
  1876. # Execution starts...
  1877. #----------------------------------------------------------------------
  1878. run