~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/applications/pathfinder/http_agent.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # http_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/http_agent.tcl,v 1.8 2002/02/03 04:22:06 lim Exp $
 32 
 33 
 34 import Class
 35 
 36 #
 37 # HTTP_Agent is an abstract base class from which MASH_Server agents
 38 # can be created. The basic requirement is that agents implement the
 39 # handle_request method. Other helpful suggestions include setting the
 40 # agent_ instvar to a MASH agent that does the actual MASH-related
 41 # work. This method takes url and key as parameters and returns page
 42 # information in the form of a list { data status_id }. If the agent
 43 # does not understand the request, it returns nothing. This class also
 44 # contains some of the common functions for returning and HTMLifying
 45 # agent response pages.
 46 #
 47 Class HTTP_Agent -configuration {
 48         server_port 4444
 49 }
 50 
 51 HTTP_Agent public init { } {
 52 
 53     $self instvar valid_clients_
 54 
 55     # Obtain a list of valid clients.
 56     #set o [$self options]
 57     #$o load_preferences "mserver"
 58     set client_str [$self get_option valid_clients]
 59     set valid_clients_ [split $client_str]
 60 }
 61 
 62 
 63 HTTP_Agent public handle_request { url key source } {
 64     mtrace trcNet "Error: HTTP_Agent is an abstract base class."
 65     error "HTTP_Agent is an abstract base class."
 66     exit
 67 }
 68 
 69 
 70 #
 71 # The get_page method creates the dynamic HTML page.  The page_type
 72 # parameter corresponds to the page as specified in DynamicHTMLifier;
 73 # e.g. html_(page_type)
 74 #
 75 HTTP_Agent private get_page { page_type } {
 76 
 77     mtrace trcNet "-> Creating $page_type page"
 78     set page [$self create_dynamic_html \
 79             [DynamicHTMLifier set html_($page_type)]]
 80 
 81     return $page
 82 }
 83 
 84 
 85 #
 86 # The htmlify_messages method uses the instvar list_ and the page_type
 87 # parameter to make a HTMLified page of list_ elements. Note that to
 88 # use this method, the agent_ instvar must be initialized to some
 89 # MASH worker; furthermore, this agent must include a method return_progs
 90 # which returns a list to be HTMLified.
 91 #
 92 HTTP_Agent private htmlify_messages { page_type } {
 93 
 94     $self instvar list_
 95 
 96     $self update_agent_list
 97     array set agent_array $list_
 98 
 99     set html {}
100     foreach key [$self sort [array names agent_array]] {
101         append html [$agent_array($key) create_dynamic_html \
102                 [DynamicHTMLifier set html_($page_type)]]
103     }
104 
105     return $html
106 }
107 
108 
109 #
110 # The update_agent_list method should be called each time the
111 # instvar list_ is to be used. Note that to use this method, the
112 # agent_ instvar must be initialized to some MASH worker;
113 # furthermore, this agent must include a method return_progs
114 # which returns a list that can be converted into an associated
115 # array.
116 #
117 HTTP_Agent private update_agent_list { } {
118     $self instvar agent_ list_
119     set list_ [$agent_ return_progs]
120 }
121 
122 
123 HTTP_Agent private sort { list } {
124     return [lsort -command "$self sort_compare_" $list]
125 }
126 
127 
128 HTTP_Agent private sort_compare_ { key1 key2 } {
129 
130     $self instvar list_
131 
132     array set agent_array $list_
133     return [string compare \
134             [string tolower [$agent_array($key1) set session_name_]] \
135             [string tolower [$agent_array($key2) set session_name_]]]
136 }
137 
138 
139 #
140 # The desc_page method takes a key and returns the HTMLified
141 # page describing the SDP Message.
142 #
143 HTTP_Agent private get_desc_page { key type } {
144 
145     $self instvar list_
146 
147     $self update_agent_list
148     array set agent_array $list_
149 
150     append html_page $type _desc
151 
152     # Use the key to find the program which will then create the
153     # HTML to be returned.
154     mtrace trcNet "-> Creating description page"
155     set desc_page [$agent_array($key) create_dynamic_html \
156             [DynamicHTMLifier set html_($html_page)]]
157     return $desc_page
158 }
159 
160 
161 # The get_error_page method returns a HTML page with the specified
162 # error message "msg."
163 HTTP_Agent private get_error_page { msg } {
164 
165     set page "<html><body bgcolor=#FFFFFF> $msg </body></html>"
166     return $page
167 }
168 
169 
170 #
171 # The validate_source method checks that the person who requested the
172 # action has access to the that action.
173 #
174 HTTP_Agent private validate_source { source } {
175 
176     $self instvar valid_clients_
177 
178     if { [llength $valid_clients_] == 0 } {
179         return 1
180     }
181 
182     set source [string tolower $source]
183     mtrace trcNet "-> Validating source $source"
184 
185     foreach client $valid_clients_ {
186         mtrace trcNet "-> Checking client: $client"
187         if [string match $client $source] {
188             return 1
189         }
190     }
191 
192     return 0
193 }
194 
195 
196 HTTP_Agent private create_collaborator_mashlet { argv } {
197         set mashlet_dir [$self get_option mashlet_dir]
198         if { $mashlet_dir == "" } {
199                 # create a default url (relative to the host on which
200                 # mash_server is being run) for use by the
201                 # TCLCL_IMPORT_DIRS environment variable
202                 set server_port [$self get_option server_port]
203                 global mash
204                 set mashlet_dir "http://[localaddr]:$server_port/$mash(version)"
205         }
206         set server_name [$self get_option play_server_addr]
207         regsub -all ":" $server_name "/" megactrl
208         set megafor  [$self get_option megafor]
209         set page "
210                 label .label -text {Please wait while mashlets are imported}
211                 pack .label -fill both -expand 1
212                 update
213                 global env
214                 set env(TCLCL_IMPORT_DIRS) $mashlet_dir
215                 set x 0; import WidgetClass
216                 WidgetClass transparent_gif
217                 set x 0; import CollaboratorApp
218                 destroy .label
219                 CollaboratorApp create_pathfinder_app [list $argv] [list $megactrl] [list $megafor]
220         "
221 
222         return $page
223 }
224 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.