File: http-mcache.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 (607 lines) | stat: -rw-r--r-- 19,042 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
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
# 
#  Copyright (c) 1997 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.

# 
# Implementation of web cache, client and server which support 
# multimedia objects.
#
# $Header: /cvsroot/nsnam/ns-2/tcl/webcache/http-mcache.tcl,v 1.6 2005/09/16 03:05:47 tomh Exp $

#
# Multimedia web client
#

# Override this method to change the default max size of the page pool
Http/Client/Media instproc create-pagepool {} {
	set pool [new PagePool/Client/Media]
	$self set-pagepool $pool
	return $pool
}

# Connection procedure:
# (1) Client ---(HTTP_REQUEST)--> Server
# (2) Client <--(HTTP_RESPONSE)-- Server
# (3) Client <----(RAP_DATA)----  Server
Http/Client/Media instproc get-response-GET { server pageid args } {
	eval $self next $server $pageid $args
	
	# XXX Enter the page into page pool, so that we can keep track of 
	# which segment has been received and know where to stop receiving. 
	if [$self exist-page $pageid] {
		error "Http/Client/Media: receives an \"active\" page!"
	}
	eval $self enter-page $pageid $args

	array set data $args
	if {[info exists data(pgtype)] && ($data(pgtype) == "MEDIA")} {
		# Create a multimedia connection to server
		$self media-connect $server $pageid
	}
}

# Don't accept an request if there is one stream still on transit
Http/Client/Media instproc send-request { server type pageid args } {
	$self instvar mmapp_ 
	if [info exists mmapp_($pageid)] {
		return
	}
	eval $self next $server $type $pageid $args
}

# Create a RAP connection to a server
Http/Client/Media instproc media-connect { server pageid } {

	# DEBUG ONLY
	#puts "Client [$self id] media-connect [$server id] $pageid"

	$self instvar mmapp_ ns_ node_ 
	Http instvar MEDIA_TRANSPORT_ MEDIA_APP_
	if [info exists mmapp_($pageid)] {
		puts "Media client [$self id] got a request for an existing stream"
		return
	}
	set agent [new Agent/$MEDIA_TRANSPORT_]
	$ns_ attach-agent $node_ $agent
	set app [new Application/$MEDIA_APP_ $pageid]
	$app attach-agent $agent
	$app target $self
	$server alloc-mcon $self $pageid $agent
	set mmapp_($pageid) $app
	$app set-layer [$self get-layer $pageid]
}

Http/Client/Media instproc media-disconnect { server pageid } {
	$self instvar mmapp_ ns_ node_

	if {![info exists mmapp_($pageid)]} {
		error "Media client [$self id] disconnect: not connected to \
server [$server id] with page $pageid"
	}
	set app $mmapp_($pageid)
	set agent [$app agent]
	$ns_ detach-agent $node_ $agent

	# DEBUG ONLY
#	puts "Client [$self id] disconnect from server [$server id]"

	# Disconnect the agent and app at the server side
	$server media-disconnect $self $pageid

	delete $agent
	delete $app
	unset mmapp_($pageid)

	$self stream-received $pageid
}


#
# Multimedia web server
#

# Create media pages instead of normal pages
Http/Server/Media instproc gen-page { pageid } {
	$self instvar pgtr_ 
	set pginfo [$self next $pageid]
	if [$pgtr_ is-media-page $pageid] {
		return [lappend pginfo pgtype MEDIA]
	} else {
		return $pginfo
	}
}

Http/Server/Media instproc create-pagepool {} {
	set pool [new PagePool/Client/Media]
	$self set-pagepool $pool
	# Set the pool size to "infinity" (2^31-1)
	$pool set max_size_ 2147483647
	return $pool
}

Http/Server/Media instproc medialog-on {} {
	$self instvar MediaLog_
	set MediaLog_ 1
}

# Allocate a media connection
Http/Server/Media instproc alloc-mcon { client pageid dst_agent } {
	$self instvar ns_ node_ mmapp_ 
	Http instvar MEDIA_TRANSPORT_ MEDIA_APP_

	set agent [new Agent/$MEDIA_TRANSPORT_]
	$ns_ attach-agent $node_ $agent
	set app [new Application/$MEDIA_APP_ $pageid]
	$app attach-agent $agent
	$app target $self 
	set mmapp_($client/$pageid) $app
	# Set layers
	$app set-layer [$self get-layer $pageid]

	# Associate $app with $client and $pageid
	$self register-client $app $client $pageid

	# DEBUG ONLY
	# Logging MediaApps, only do it for sender-side media apps
	$self instvar MediaLog_
	if [info exists MediaLog_] {
		set lf [$self log]
		if {$lf != ""} {
			$app log $lf
		}
	}
#	puts "Server [$self id] allocated a connection to client [$client id] using agent $agent"

	# Connect two RAP agents and start data transmission
	$ns_ connect $agent $dst_agent
	$agent start
}

Http/Server/Media instproc media-disconnect { client pageid } { 
	$self instvar mmapp_ ns_ node_

	# DEBUG ONLY
#	puts "At [$ns_ now] Server [$self id] disconnected from client [$client id]"

	if {![info exists mmapp_($client/$pageid)]} {
		error "Media server [$self id] disconnect: not connected to \
client [$client id] with page $pageid"
	}
	set app $mmapp_($client/$pageid)
	set agent [$app agent]
	$ns_ detach-agent $node_ $agent

	$self unregister-client $app $client $pageid

	# DEBUG ONLY 
#	puts "Server [$self id] deleting agent $agent"

	delete $agent
	delete $app
	unset mmapp_($client/$pageid)
}

# Tell the client that a stream has been completed. Assume that there is 
# an open connection between server and client
Http/Server/Media instproc finish-stream { app } {
	$self instvar mmapp_ 
	foreach n [array names mmapp_] {
		if {$mmapp_($n) == $app} {
			set tmp [split $n /]
			set client [lindex $tmp 0]
			set pageid [lindex $tmp 1]
			$self send $client [$self get-reqsize] \
				"$client media-disconnect $self $pageid"
			return
		}
	}
}

# If the page is a media page, set the response size to that of the request
Http/Server/Media instproc handle-request-GET { pageid args } {
	set pginfo [eval $self next $pageid $args]
	if {[$self get-pagetype $pageid] == "MEDIA"} {
		set pginfo [lreplace $pginfo 0 0 [$self get-reqsize]]
	}
	return $pginfo
}

Http/Server/Media instproc gen-pageinfo { pageid } {
	set pginfo [eval $self next $pageid]
	# Create contents for media page
	$self instvar pgtr_
	if [$pgtr_ is-media-page $pageid] {
		return [lappend pginfo pgtype MEDIA layer \
				[$pgtr_ get-layer $pageid]]
	} else {
		return $pginfo
	}
}

# Map a media application to the HTTP application at the other end
#Http/Server/Media instproc map-media-app { app } {
#	$self instvar mmapp_
#	foreach n [array names mmapp_] {
#		if {$mmapp_($n) == $app} {
#			return [lindex [split $n /] 0]
#		}
#	}
#}

# Handle prefetching of designated segments
Http/Server/Media instproc get-request { client type pageid args } {
	if {$type == "PREFSEG"} {
		# XXX allow only one prefetching stream from any single client
		# Records this client as doing prefetching. 
		# FAKE a connection to the client without prior negotiation
		set pagenum [lindex [split $pageid :] 1]
		set conid [lindex $args 0]
		set layer [lindex $args 1]
		set seglist [lrange $args 2 end]
		eval $self register-prefetch $client $pagenum $conid \
				$layer $seglist
		$client start-prefetch $self $pageid $conid
		$self evTrace S PREF p $pageid l $layer [join $seglist]
		# DEBUG only
#		$self instvar ns_
#		puts "At [$ns_ now] server [$self id] prefetches $args"
	} elseif {$type == "STOPPREF"} {
		set pagenum [lindex [split $pageid :] 1]
		set conid [lindex $args 0]
		# DEBUG only
#		$self instvar ns_
#		puts "At [$ns_ now] server [$self id] stops prefetching $pageid conid $conid"
		if [$self stop-prefetching $client $conid $pagenum] {
			# Tear down pref channel iff we don't have remaining 
			# clients sharing the channel
			$client media-disconnect $self $pageid $conid
		}
	} elseif {$type == "OFFLPREF"} {
		# Simply send the page back through TCP channel
		if ![$self exist-page $pageid] {
			error "Server [$self id] offline-prefetch non-existent page $pageid!"
		}
		set size [$self get-size $pageid]
		$self send $client $size "$client offline-complete $pageid"
	} else {
		eval $self next $client $type $pageid $args
	}
}



#
# Multimedia web cache
#

Http/Cache/Media instproc create-pagepool {} {
	set pool [new PagePool/Client/Media]
	$self set-pagepool $pool
	return $pool
}

Http/Cache/Media instproc start-prefetch { server pageid conid } {
	$self instvar pref_ ns_
	if [info exists pref_($server/$pageid)] {
		# We are already connected to the server
		if {[lsearch -exact $pref_($server/$pageid) $conid] == -1} {
#			puts "At [$ns_ now] cache [$self id] RE-REQUESTs prefetching to server [$server id] for page $pageid"
			lappend pref_($server/$pageid) $conid
		}
		return
	} else {
		# Whenever there is a prefetching request to the server, 
		# increase the "ref counter" by one. Then we delete it 
		# when it's 0.
		lappend pref_($server/$pageid) $conid
	}
#	puts "At [$ns_ now] cache [$self id] starts prefetching to [$server id] for page $pageid conid $conid"
	# XXX Do not use QA for prefetching!!
	Http instvar MEDIA_APP_
	set oldapp $MEDIA_APP_
	# XXX Do not use the default initial RTT of RAP. We must start sending
	# as soon as possible, then drop our rate if necessary. Instead, set
	# initial ipg_ and srtt_ to 10ms.
	set oldipg [Agent/RAP set ipg_]
	set oldsrtt [Agent/RAP set srtt_]
	Agent/RAP set ipg_ 0.01
	Agent/RAP set srtt_ 0.01
	set MEDIA_APP_ MediaApp
	$self media-connect $server $pageid
	set MEDIA_APP_ $oldapp
	Agent/RAP set ipg_ $oldipg
	Agent/RAP set srtt_ $oldsrtt
}

Http/Cache/Media instproc media-connect { server pageid } {
	$self instvar s_mmapp_ ns_ node_ 

	# DEBUG ONLY
#	puts "At [$ns_ now], cache [$self id] connects to [$server id] for page $pageid"

	Http instvar MEDIA_TRANSPORT_ MEDIA_APP_
	if [info exists s_mmapp_($server/$pageid)] {
		error "Media client [$self id] got a request for an existing \
stream"
	}
	set agent [new Agent/$MEDIA_TRANSPORT_]
	$ns_ attach-agent $node_ $agent
	set app [new Application/$MEDIA_APP_ $pageid]
	$app attach-agent $agent
	$app target $self
	$server alloc-mcon $self $pageid $agent
	set s_mmapp_($server/$pageid) $app
	$app set-layer [$self get-layer $pageid]
}

Http/Cache/Media instproc alloc-mcon { client pageid dst_agent } {
	$self instvar ns_ node_ c_mmapp_ 
	Http instvar MEDIA_TRANSPORT_ MEDIA_APP_
	if [info exists c_mmapp_($client/$pageid)] {
		error "Media cache [$self id] got a request for an existing \
stream $pageid from client [$client id]"
	}

	set agent [new Agent/$MEDIA_TRANSPORT_]
	$ns_ attach-agent $node_ $agent
	set app [new Application/$MEDIA_APP_ $pageid]
	$app attach-agent $agent
	$app target $self 
	set c_mmapp_($client/$pageid) $app
	# Set layers
	$app set-layer [$self get-layer $pageid]

	# Associate $app with $client and $pageid
	$self register-client $app $client $pageid

	# Logging MediaApps, only do it for sender-side media apps
	$self instvar MediaLog_
	if [info exists MediaLog_] {
		set lf [$self log]
		if {$lf != ""} {
			$app log $lf
		}
	}

	# Connect two RAP agents and start data transmission
	$ns_ connect $agent $dst_agent
	$agent start
}

# Turn on logging of media application
Http/Cache/Media instproc medialog-on {} {
	$self instvar MediaLog_
	set MediaLog_ 1
}

Http/Cache/Media instproc media-disconnect { host pageid args } {
	$self instvar c_mmapp_ s_mmapp_ ns_ node_ pref_ c_tbt_

	# Flags: is it client disconnection or server? 
	set cntdisco 0 
	set svrdisco 0

	set server [lindex [split $pageid :] 0]

	if {($host != $server) && [info exists c_mmapp_($host/$pageid)]} {
		# Disconnect from a client
		set app $c_mmapp_($host/$pageid)
		set agent [$app agent]
		$ns_ detach-agent $node_ $agent
		$self unregister-client $app $host $pageid
		# DEBUG ONLY
#		puts "At [$ns_ now] Cache [$self id] disconnect from \
#				client [$host id]"

		# Do NOT delete client-side agent and app until we've 
		# torn down prefetching connection to the server. 
		# XXX But first check that this client has indeed been 
		# involved in prefetching!
		if {[info exists pref_($server/$pageid)] && \
			[lsearch -exact $pref_($server/$pageid) $app] != -1} {
			# If we have concurrent requests and other clients
			# may still be using this prefetching channel. We
			# tell the server that this client has stopped so 
			# that server will remove all related state.
#			puts "At [$ns_ now] Cache [$self id] stops prefetching for conid $app, page $pageid, from server [$server id]"
			$self send $server [$self get-reqsize] "$server get-request $self STOPPREF $pageid $app"
			# Stop application-related timers
			set c_tbt_($host/$pageid) $app
			$app stop
		} else {
			delete $app
		}
		delete $agent
		unset c_mmapp_($host/$pageid)

		# Dump status of all pages after serving a client
		$self instvar pool_
		foreach p [lsort [$pool_ list-pages]] {
			$self dump-page $p
		}
		set cntdisco 1

	} elseif [info exists s_mmapp_($host/$pageid)] {
		# XXX This assumes that we are NOT connecting to another cache.
		# Stop prefetching when we requested that at the server. 
		#
		# Also, we assume that while the cache is downloading from 
		# the server during the first retrieval, no prefetching should
		# be used. This is guaranteed by the way MEDIAREQ_CHECKSEG is 
		# handled in mcache.cc:680.
		#
		# Note that (1) this always happens AFTER client disconnection,
		# (2) whenever there is a prefetching connection, there's 
		# always a corresponding entry in s_mmapp_().
		#
		# If we are disconnecting a prefetching channel, check if 
		# we still have other clients sharing the channel. If not,
		# then we tear down the channel. 
		set svrdisco 1
		if [info exists pref_($server/$pageid)] {
			# By default we don't tear down pref channel
			set teardown 0
			# Actually the MediaApp for the client
			set conid [lindex $args 0]
			set pos [lsearch -exact $pref_($server/$pageid) $conid]
			if {$pos == -1} {
				error "media-disconnect cannot find $conid!!"
			}
			set pref_($server/$pageid) [lreplace \
				$pref_($server/$pageid) $pos $pos]
			if {[llength $pref_($server/$pageid)] == 0} {
				$self evTrace E STP s [$server id] p $pageid
				unset pref_($server/$pageid)
				# Now we can tear down the pref channel
				set teardown 1
			}
			# Tear down client-side connection (i.e.,conid)
#			puts "At [$ns_ now] cache [$self id] stops prefetching\
# to [$server id] for client $conid"
			delete $conid
		} else {
			# If no pref, tear down by default
			set teardown 1
		}
		if {$teardown} {
			# Disconnect from a server
			set app $s_mmapp_($host/$pageid)
			set agent [$app agent]
			$ns_ detach-agent $node_ $agent
			$host media-disconnect $self $pageid
			# DEBUG ONLY
#			puts "At [$ns_ now] Cache [$self id] disconnect from \
#				server [$host id]"
			delete $agent
			delete $app
			unset s_mmapp_($host/$pageid)
		}
		# Use the TCP channel between the cache and the server to 
		# transmit the entire file. Note since we no longer do 
		# online prefetching, this channel is pretty much empty
		# and we can occupy it as long as we want. 
		$self instvar firstreq_
		if {([$self get-pref-style] == "OFFLINE_PREF") && \
				[info exists firstreq_($pageid)]} { 
			$self send $server [$self get-reqsize] \
				"$server get-request $self OFFLPREF $pageid"
		}
		if [info exists firstreq_($pageid)] {
			unset firstreq_($pageid)
		}
	} else {
		error "At [$ns_ now] Media cache [$self id] tries to \
			disconnect from a non-connected host [$host id]"
	}

	# XXX Only do this when we disconnect from a server. 
	if {$svrdisco == 1} {
		$self stream-received $pageid
	}
}

# Tell the client that a stream has been completed. Assume that there is 
# an open connection between server and client
Http/Cache/Media instproc finish-stream { app } {
	$self instvar c_mmapp_ s_mmapp_
	foreach n [array names c_mmapp_] {
		if {$c_mmapp_($n) == $app} {
			set tmp [split $n /]
			set client [lindex $tmp 0]
			set pageid [lindex $tmp 1]
			$self send $client [$self get-reqsize] \
				"$client media-disconnect $self $pageid"
			return
		}
	}
}

Http/Cache/Media instproc get-response-GET { server pageid args } {
	# Whether this is the first request. If offline prefetching is used, 
	# media-disconnect{} uses this information to decide whether to 
	# prefetch the entire stream. 
	$self instvar firstreq_
	if ![$self exist-page $pageid] {
		set firstreq_($pageid) 1
	}

	eval $self next $server $pageid $args

	# DEBUG ONLY
#	puts "Cache [$self id] gets response"

	array set data $args
	if {[info exists data(pgtype)] && ($data(pgtype) == "MEDIA")} {
		# Create a multimedia connection to server
		$self media-connect $server $pageid
	}
}

# XXX If it's a media page, change page size and send back a small response. 
# This response is intended to establish a RAP connection from client to 
# cache. 
Http/Cache/Media instproc answer-request-GET { cl pageid args } {
	array set data $args
	if {[info exists data(pgtype)] && ($data(pgtype) == "MEDIA")} {
		set size [$self get-reqsize]
	} else {
		set size $data(size)
	}
	$self send $cl $size \
		"$cl get-response-GET $self $pageid $args"
	$self evTrace E SND c [$cl id] p $pageid z $data(size)
}

# $args is a list of segments, each of which is a list of 
# two elements: {start end}
Http/Cache/Media instproc pref-segment {conid pageid layer args} {
	# XXX directly send a request to the SERVER. Assuming that 
	# we are not going through another cache. 
	set server [lindex [split $pageid :] 0]
	set size [$self get-reqsize]
	$self send $server $size "$server get-request $self PREFSEG \
		$pageid $conid $layer [join $args]"
}

Http/Cache/Media instproc set-repl-style { style } {
	$self instvar pool_
	$pool_ set-repl-style $style
}