1 # sdp_agent.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1997-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/applications/pathfinder/sdp_agent.tcl,v 1.18 2002/02/03 04:22:06 lim Exp $
32
33
34 #
35 # The SDP_Agent class handles the receiving of SDP Programs. Subsequently,
36 # these Programs can be returned upon request.
37 #
38 Class SDP_Agent
39
40 SDP_Agent public init { } {
41
42 $self instvar sessions_ sdp_list_
43
44 # Initialize the sessions directory.
45 #set session_ ~/mash/tcl/applications/mash_server/sessions/
46 #set o [$self options]
47 #$o load_preferences "mserver"
48 set sessions_ [$self get_option sdp_sessions_dir]
49
50 # Initialize the list of SDP Programs
51 set sdp_list_ {}
52
53 # Read cache
54 $self read_cache
55 }
56
57
58 SDP_Agent private read_cache { } {
59
60 $self instvar sessions_ sdp_list_
61
62 mtrace trcNet "In SDP_Agent::read_cache"
63
64 cd $sessions_
65 set msgfiles [glob -nocomplain -- *]
66
67 foreach f $msgfiles {
68
69 # Extract the Program object from the catalog file.
70 set msg_str [read_file $f]
71 set msg [lindex [ [new SDPParser 0] parse $msg_str] 0]
72 if {$msg==""} {
73 file delete $f
74 } else {
75
76 set program [new Program $msg]
77
78 # Use the message's time information to figure out whether
79 # this announcement has expired.
80 set sdp_time [$msg set alltimedes_]
81 if {$sdp_time==""} {
82 file delete $f
83 } else {
84 set end_time [[lindex $sdp_time 0] set endtime_]
85 set end_offset [[lindex $sdp_time 0] sec_until_current endtime_]
86 if { $end_offset < 0 && $end_time != 0 } {
87 file delete $f
88
89 } else {
90 # Append the key/msg pair to the sdp_list_.
91 lappend sdp_list_ [get_key $program] $msg
92 }
93 }
94 }
95 }
96 }
97
98
99 #
100 # This method is a called when a new Program is received. The addprog
101 # method takes a program and adds it to the current list of programs.
102 # Finally, the program is written to the cache.
103 #
104 SDP_Agent public addprog { source program } {
105
106 $self instvar sessions_ sdp_list_
107 global tcl_platform
108
109 # Extract the unique key and message of this Program
110 set key [get_key $program]
111 set msg [$program base]
112
113 # Check if this announcement is currently in the sdp_list_.
114 if { [lsearch -exact $sdp_list_ $key] == -1 } {
115
116 mtrace trcNet "-> Received announcment: $key"
117
118 # Append the key/program pair to the list.
119 lappend sdp_list_ $key $msg
120
121 # Store the message in a file with the filename key in the cache.
122 if {$tcl_platform(platform) == "windows"} {
123 # semi-colons are illegal in windows filenames
124 regsub -all ":" $key "+" key
125
126 }
127 append filename $sessions_ $key
128
129 write_to_file $filename [$msg obj2str]
130 }
131 }
132
133
134 SDP_Agent public updateprog { source program } {
135
136 $self instvar sessions_ sdp_list_
137 global tcl_platform
138
139 # Extract the unique key and message of this Program; from the key,
140 # construct the filename.
141 set key [get_key $program]
142 set msg [$program base]
143 if {$tcl_platform(platform) == "windows"} {
144 # semi-colons are illegal in windows filenames
145 regsub -all ":" $key "+" newkey
146 append filename $sessions_ $newkey
147
148 } else {
149 append filename $sessions_ $key
150
151 }
152 mtrace trcNet "-> Updating announcment: $key"
153
154 # Check that the filename exists in the cache.
155 set exists [file exists $filename]
156 if { $exists } {
157 # Replace the old key/program pair in the list with the new one.
158 set index [expr [lsearch -exact $sdp_list_ $key] + 1]
159 set sdp_list_ [lreplace $sdp_list_ $index $index $msg]
160
161 # Write the updated message in the file.
162 write_to_file $filename [$msg obj2str]
163
164 } else {
165 $self addprog $source $program
166 }
167 }
168
169
170 SDP_Agent public removeprog { source program } {
171
172 $self instvar sessions_ sdp_list_
173 global tcl_platform
174
175 # Extract the unique key of this Program; from that, construct
176 # the filename.
177 set key [get_key $program]
178 if {$tcl_platform(platform) == "windows"} {
179 # semi-colons are illegal in windows filenames
180 regsub -all ":" $key "+" newkey
181 append filename $sessions_ $newkey
182
183 } else {
184 append filename $sessions_ $key
185
186 }
187
188 mtrace trcNet "-> Removing announcment: $key"
189
190 # Remove the key/program pair from the list.
191 set index [lsearch -exact $sdp_list_ $key]
192 if { $index != -1 } {
193 set sdp_list_ [lreplace $sdp_list_ $index [expr $index + 1]]
194
195 } else {
196 mtrace trcNet "-> Announcement not in sdp_list_."
197 }
198
199 # Check that the length of the list is still an even number.
200 if { [expr [llength $sdp_list_] % 2] != 0 } {
201 puts "removeprog produced an invalid sdp_list_."
202 exit
203 }
204
205 # Remove the file corresponding to the key in the cache.
206 file delete $filename
207 }
208
209
210 SDP_Agent public addsource { source } {
211 }
212
213
214 #
215 # The return_progs method returns a list of SDP key and Program pairs
216 # which can then be converted into an associated array.
217 #
218 SDP_Agent public return_progs { } {
219 $self instvar sdp_list_
220 return $sdp_list_
221 }
222
223
224 # -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
225
226
227 import HTTP_Agent
228 import ScopeZone
229 import ProgramSource/SAP
230
231 #
232 # The HTTP_Agent/SDP_Agent class is an HTTP-aware agent that can be
233 # used in the MASH_Server. This object contains a plain SDP_Agent
234 # which is used to listen for new SDP Programs and return the current
235 # list of Programs.
236 #
237 Class HTTP_Agent/SDP_Agent -superclass HTTP_Agent
238
239 HTTP_Agent/SDP_Agent public init { } {
240 # This doesn't belong here,
241 # but is necessary for AnnounceListenManager/SAP/Nsdr
242 $self add_default sapTTL 127
243 #
244
245 $self next
246 $self instvar agent_
247 set agent_ [new SDP_Agent]
248 set zone [new ScopeZone 224.2.128.0/17]
249 new ProgramSource/SAP $agent_ $zone
250 }
251
252
253 #
254 # The handle_request method is called by the MASH_Server when an
255 # HTTP request is received. This method checks for the "magic URLs"
256 # it cares about and returns the corresponding page.
257 #
258 HTTP_Agent/SDP_Agent instproc handle_request { url key source reply_var } {
259 upvar $reply_var reply
260 $self instvar list_
261 mtrace trcNet "-> SDP_Agent::handle_request called"
262
263 set page ""
264 set status 200
265 set type "text/html"
266
267 # Check for the "magic" URLs.
268 if { $url == "/live-list.html" } {
269 mtrace trcNet "-> SDP Announcements page requested"
270 set page [$self get_page sessions_list]
271
272 } elseif { $url == "/live-desc" } {
273 mtrace trcNet "-> SDP Description requested"
274 # $self update_agent_list
275 # array set desc_array $list_
276 # set msg $desc_array($key)
277 # set page [$self get_desc_page $msg sessions]
278 set page [$self get_desc_page $key sessions]
279 # set page [$self edit_html $page]
280
281 } elseif { $url == "/view" } {
282 mtrace trcNet "-> View Session requested"
283 $self update_agent_list
284 array set desc_array $list_
285 set msg_str [$desc_array($key) obj2str]
286
287 # set page $msg_str
288 # set type "application/x-sd"
289
290 set argv [list -sdp $msg_str]
291 set page [$self create_collaborator_mashlet $argv]
292 set type "x-mash/x-script"
293 } elseif { $url == "/asview" } {
294 mtrace trcNet "-> Assisted View Session requested"
295 $self update_agent_list
296 array set desc_array $list_
297 set msg_str [$desc_array($key) obj2str]
298
299 # set page $msg_str
300 # set type "application/x-sd"
301
302 set megafor [$self get_option megafor]
303 set argv [list -sdp $msg_str -usemega -unicast $megafor]
304 set page [$self create_collaborator_mashlet $argv]
305 set type "x-mash/x-script"
306 } elseif { $url == "/prefs.mash" } {
307 # FIXME: do this here, for now
308
309 set mashlet_dir [$self get_option mashlet_dir]
310 if { $mashlet_dir == "" } {
311 # create a default url (relative to the host on which
312 # mash_server is being run) for use by the
313 # TCLCL_IMPORT_DIRS environment variable
314 set server_port [$self get_option server_port]
315 global mash
316 set mashlet_dir "http://[localaddr]:$server_port/$mash(version)"
317 }
318
319 set page "
320 . configure -bg \#FFFFFF
321 label .label -text {Please wait while mashlets are imported} -bg \#FFFFFF
322 pack .label -fill both -expand 1
323 update
324 set env(TCLCL_IMPORT_DIRS) $mashlet_dir
325 set x 0; import PathFinderPrefs
326 destroy .label
327 PathFinderPrefs .f
328 pack .f -padx 5 -pady 5 -anchor nw
329 "
330 set type "x-mash/x-script"
331 }
332
333 if { $page != {} } {
334 set reply(headers) [list content-type $type]
335 set reply(data) $page
336 set reply(status) $status
337 return 1
338 } else {
339 return 0
340 }
341 }
342
343
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.