1 # lhm.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1996-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/lhm/lhm.tcl,v 1.5 2002/02/03 04:21:53 lim Exp $
32
33
34 import mashutils Trace HashTable RendezvousManager Servent
35
36 #Trace on ; Trace add LocalHostManager
37
38 #
39 # The LocalHostManager
40 # - defines new virtual scopes (ie, for use as
41 # and argmument to a -rendez option somewhere)
42 # - accepts querys against the cached list of messages sent on scopes it
43 # is listening on
44 # - advertises the scope (if it chooses to define one) and itself
45 # - advertises that it can allocate certain services that
46 # are machine-specific and thus not for use with a HostManager.
47 # These are defined in a "srv" file, which defaults to
48 # ~/.mash/localsrvs/FQDN_OF_LOCALMACHINE . (should be /etc/lhm-srvs).
49 # Override with the -srvfile arg.
50 # - accepts requests to allocate these certain "services"
51 #<br>
52 # It advertises the new scopes (`scope: ...') and
53 # itself (`rv-cache: ...') in the top-level virtual scope
54 #<br>
55 # The hard-coded rendez spec is the default *global*
56 # rendezvous spec, ie, the toplevel "virtual scope". The default
57 # can be overridden to allow a multi-level hierarchy; i.e., the
58 # -rendez option address is considered the "top-level" rendezvous
59 # channel, and this agent listens/advertises only on it and in "lower"
60 # channels advertised on it.
61 #
62 #
63 Class LocalHostManager -superclass Observer -configuration {
64 rendez 224.2.127.253/1202
65 }
66
67 #
68 #
69 LocalHostManager public init {} {
70 $self next
71 $self read_srv_file
72 $self init_ctrl
73 $self init_network
74 $self init_srvs
75 $self announce_proxysrvs
76 }
77
78 #
79 LocalHostManager public destroy {} {
80 $self instvar rv_
81 $rv_ detach_observer $self
82 $self next
83 }
84
85
86 # reads file that lists which servents can be allocated by
87 # this LocalHostManager. File formatted as lines, each consisting of: <br>
88 #
89 # {advert for srv} {http://... srv script URL} {machine} {args}
90 #
91 LocalHostManager private read_srv_file {} {
92 Trc $class "--> ${class}::$proc"
93 $self instvar srvs_
94
95 set srvs_ ""
96 set f [$self get_option srvfile]
97 if {$f != ""} {
98 if [file readable $f] {
99 puts "reading in srvs from `$f'"
100 set fd [open $f r]
101 set filedata [read $fd]
102 set linedata [split $filedata "\n"]
103 foreach i $linedata {
104 set j [string trim $i]
105 if {$j == ""} {continue}
106 if {[string index $j 0] == "#"} {continue}
107 lappend srvs_ [new Servent $j]
108 }
109 close $fd
110 } else {
111 puts "Srv file `$f' not found/readable..."
112 }
113 } else {
114 puts "No srv file specified."
115 }
116 }
117
118
119 # reads file that lists proxy announcements and start announcing them
120 #
121 LocalHostManager private announce_proxysrvs {} {
122 Trc $class "--> ${class}::$proc"
123 $self instvar rv_
124
125 set proxy_srvs_ ""
126 set f [$self get_option proxysrvfile]
127 if {$f != ""} {
128 if [file readable $f] {
129 puts "reading in proxy srvs from `$f'"
130 set fd [open $f r]
131 set filedata [read $fd]
132 set linedata [split $filedata "\n"]
133 foreach i $linedata {
134 set j [string trim $i]
135 if {$j == ""} {continue}
136 if {[string index $j 0] == "#"} {continue}
137 Trc $class "proxy announcing `$j'"
138
139 if {[$self myvscopes] != ""} {
140 foreach vs [$self myvscopes] {
141 $rv_ start $vs $j
142 }
143 } else {
144 $rv_ start [$rv_ get_local_rv] $j
145 }
146
147 }
148 close $fd
149 } else {
150 puts "ProxySrv file `$f' not found/readable..."
151 }
152 } else {
153 puts "No proxysrv file specified."
154 }
155 }
156
157
158 #
159 LocalHostManager private init_ctrl {} {
160 Trc $class "--> ${class}::$proc"
161 $self instvar unicastmgr_ myport_
162 set myport_ [$self get_option ctrlport]
163 if {$myport_ == ""} {
164 set myport_ [$self alloc_port]
165 }
166 set unicastmgr_ [new LocalHostManagerCtrl $myport_ $self]
167 puts "LocalHostManagerCtrl listening on [localaddr]/$myport_"
168 }
169
170
171 # announce the new "virtual scopes" defined by this LocalHostManager
172 # (if there are any), and advertise that it caches and accepts
173 # queries against msgs send on these scopes.
174 # <br>
175 # The vscopes option is assumed to be a list of the form
176 # <br> `scopeName scopeSpec'.
177 LocalHostManager private init_network {} {
178 Trc $class "--> ${class}::$proc"
179 $self instvar rv_
180
181 set r [$self get_option rendez]
182 set rv_ [new RendezvousManager $r] ;# (r != "") because of default
183 $rv_ attach_observer $self
184
185 set vsopt [$self get_option vscope]
186 set vsl ""
187 foreach v $vsopt {eval lappend vsl $v}
188 foreach {vsn vss} $vsl {
189 puts "vscope = `$vsn' on `$vss'"
190 $rv_ add_spec $vss
191 $self announce_vs $vsn $vss
192 $self announce_cache $vss
193 }
194 }
195
196
197 # announce `rv-cache:' msgs on and for spec `s'
198 LocalHostManager private announce_cache {s} {
199 Trc $class "--> ${class}::$proc"
200 $self instvar rv_ myport_
201 $rv_ start $s "rv-cache: rspec=$s ctrladdr=[localaddr]/$myport_"
202 }
203
204 # announce virtual scope with name `name' and spec `spec'
205 # on the toplevel rv channel and in the new vs
206 LocalHostManager private announce_vs {name spec} {
207 Trc $class "--> ${class}::$proc"
208 $self instvar rv_
209
210 set r [$self get_option rendez]
211 puts "announcing scope msgs on `$r' and `$spec'"
212 $rv_ start $r "scope: name=$name spec=$spec"
213 $rv_ start $spec "scope: name=$name spec=$spec"
214 }
215
216 # init and assert `can-allocate:' msgs
217 #
218 LocalHostManager private init_srvs {} {
219 Trc $class "--> ${class}::$proc"
220 $self instvar srvs_ rv_ url2file_ srv_ads_
221 set url2file_ [new HashTable]
222
223 if {$srvs_==""} {return}
224
225 foreach s $srvs_ {
226 append msg "can-allocate: "
227 append msg [$s rv_msg]
228 append msg " uniqid=[$s uniqid]\n"
229 }
230
231 if {[$self myvscopes] == ""} {
232 $rv_ start [$rv_ get_local_rv] $msg
233 set srv_ads_([$rv_ get_local_rv]) $msg
234 } else {
235 foreach vs [$self myvscopes] {
236 $rv_ start $vs $msg
237 }
238 }
239 }
240
241 #
242 LocalHostManager public myvscopes {} {
243 Trc $class "--> ${class}::$proc"
244 set reply ""
245 set vsl [$self get_option vscope]
246 foreach s $vsl {
247 lappend reply [lindex $s 1]
248 }
249 return $reply
250 }
251
252 #
253 LocalHostManager instproc alloc_port { } {
254 # Random number U[8192, 16384]
255 set r01 [expr [random]/double(0x7fffffff)]
256 set r02 [expr round(8392 + $r01 * 8192)]
257 if {$r02 % 2 == 1} {incr r02 -1}
258 return $r02
259 }
260
261 #
262 LocalHostManager instproc alloc_mcast_addr { } {
263 set lo1 round([expr [random]/double(0x7fffffff) * 256])
264 set lo2 round([expr [random]/double(0x7fffffff) * 256])
265 return "224.3.[expr round($lo1)].[expr round($lo2)]"
266 }
267
268
269 # recv a scope msg -- see if we need to update which channel
270 # our announcements are sent on. If we are not "asserting"
271 # virtual scope(s), keep announcements on the "local" vscope
272 #
273 LocalHostManager public rendez_recv_scope {rspec addr port data size} {
274 Trc $class "--> ${class}::$proc"
275 if {[$self myvscopes] == ""} {
276 $self instvar rv_ srv_ads_
277 set l [$rv_ get_local_rv]
278 Trc $class "local_rv = $l"
279
280 if ![info exists srv_ads_($l)] {
281 foreach i [array names srv_ads_] {
282 set msg $srv_ads_($i)
283 $rv_ stop $i $msg
284 unset srv_ads_($i)
285 }
286 set srv_ads_($l) $msg
287 $rv_ start $l $msg
288 }
289 }
290 }
291
292
293 #----------------------------------------
294 # query resolution
295 #----------------------------------------
296
297
298
299 # called when msg of type "query:" is received. If it was received
300 # on a rv channel, the rspec arg is set to its spec, otherwise it
301 # was received via unicast and rspec is set to "-".
302 #<br>
303 # The msg payload is assumed to be of the form:
304 #<br>
305 # "query: ?vs=(scopename|scopespec)? ?rport=num? query=queryString"
306 #<br>
307 # Replies are sent either to the issuing rv channel or via unicast
308 # as appropriate. [FIXME- this currently ignores scopename/scopespec
309 # until RendezvousManager is fixed to handle it.]
310 #
311 LocalHostManager public rendez_recv_query {rvmsg} {
312 Trc $class "--> ${class}::$proc"
313 $self instvar rv_
314
315 set queryrspec [$rvmsg get_field vs]
316 set querystring [$rvmsg get_field query]
317 set reply "query-reply: `"
318 append reply [$rv_ query $querystring]
319 append reply "' for [list $querystring]"
320 if {$queryrspec != ""} {
321 append reply " on $queryrspec"
322 }
323
324 Trc $class "sending `$reply'"
325 if {[$rvmsg rspec] == "-"} {
326 # unicast the response
327 set rport [$rvmsg get_field rport]
328 if {$rport==""} {
329 set rport [$rvmsg sender_port]
330 }
331 set u [new UDPChannel [$rvmsg sender_addr]/$rport]
332 $u send $reply
333 delete $u
334 } else {
335 # multicast the response
336 # FIXME don't want to keep periodically transmitting query replies
337 # too long...
338 $rv_ start [$rvmsg rspec] $reply
339 }
340 }
341
342
343
344 #----------------------------------------
345 # exec local processes
346 #----------------------------------------
347
348
349
350 # Accept allocation requests for services we have advertised via
351 # "can-allocate"
352 # <p>
353 # Check if the allocation msg refers to a service in the srv file,
354 # and check that said srv hasn't been heard from ever/in a while.
355 # If both are true, exec the srv.
356 # <p>
357 # Note that `-rendez FIXME -uniqid YYY' is added to execargs.
358 #
359 LocalHostManager public rendez_recv_allocate {rvmsg} {
360 Trc $class "--> ${class}::$proc [$rvmsg data]"
361 $self instvar rv_ url2file_
362
363 set req_srv [$self get_srvref $rvmsg]
364 if {$req_srv == ""} {
365 Trc $class "allocation request:\n `$data'\n for non-localhost"
366 return
367 }
368
369 if ![$self srv_running $req_srv] {
370 # if it was exec'd too recently, wait a bit to retry
371 if {[$req_srv pid] > 0} {
372 Trc $class "checking if exec'd < 10s ago"
373 Trc $class "=> [expr [clock seconds]-[$req_srv exectime]]s. ago"
374 if {[expr [clock seconds]-[$req_srv exectime]] < 10} {
375 return
376 }
377 }
378
379 # get script
380 set url [$req_srv url]
381 set localfile [$req_srv scriptfile]
382 if {$localfile == ""} {
383 set localfile [$url2file_ exists $url]
384 if {$localfile == -1} {
385 set localfile [$self generate_filename]
386 $url2file_ create $url $localfile
387 }
388 $req_srv set_scriptfile $localfile
389 }
390 if ![file exists $localfile] {
391 if {[$self copyURLtoFile $url $localfile] == 0} {return}
392 #file attributes $localfile -permissions 00755
393 }
394
395 # exec
396 set filename [$req_srv scriptfile]
397 set tmppath [$self get_option tmppath]
398 #set outputf ">& $tmppath/[file tail $filename]-[$req_srv uniqid].out"
399 set outputf ""
400
401 set path [$self get_option execpath]
402 # FIXME
403 set rspec [$rvmsg rspec]
404 if {$rspec == "-"} {set rspec [lindex [$self myvscopes] 0]}
405 set execargs "-rendez $rspec -uniqid [$req_srv uniqid]"
406 set execargs "$execargs [$req_srv execargs]"
407 set execstr "$path/[$req_srv execcmd] $filename $execargs $outputf"
408
409 puts " -- exec'ing new servent"
410 puts " `$execstr'"
411 if { [catch "eval exec [list $execstr] &" pid] != 0 } {
412 global errorCode
413 puts "Error in exec of '$execstr': $errorCode"
414 $req_srv set_pid -1
415 return -1
416 } else {
417 Trc $class "exec successful, pid = $pid"
418 }
419 $req_srv set_pid $pid
420 $req_srv set_exectime [clock seconds]
421 return 0
422 }
423 return 0
424 }
425
426 # returns a ref to the Servent object indicated in
427 # `msg', or {} if it is either invalid (improperly formatted)
428 # does not refer to a Servent we can allocate
429 #
430 LocalHostManager private get_srvref {msg} {
431 Trc $class "--> ${class}::$proc"
432 Trc detail-$class "`[$msg get_msg]'"
433 $self instvar srvs_
434
435 set uid [$msg get_field uniqid]
436 foreach s $srvs_ {
437 #Trc $class "uid=$uid ?==? srvuid=[$s uniqid]"
438 if {$uid == [$s uniqid]} {
439 return $s
440 }
441 }
442 return ""
443 }
444
445 # see if servent `srv' is running by checking if it was exec'd
446 # and if it has been heard from less then `timeout' secs ago.
447 #
448 LocalHostManager private srv_running {srv {timeoutsecs 20}} {
449 Trc $class "--> ${class}::$proc $srv"
450 $self instvar rv_
451
452 set pid [$srv pid]
453 Trc $class "srv pid=$pid"
454 if {$pid >= 0} {
455 # exec'd it before -- still alive?
456 set qry "will-provide: & uniqid=[$srv uniqid]"
457 Trc $class "srv query is `$qry'"
458 set q [$rv_ query $qry]
459 if {$q == ""} {
460 # its gone!
461 Trc $class "srv gone: no announcement(s) found"
462 return 0
463 } else {
464 Trc $class "matching msg= $q"
465 # its here, but check against (possibily tighter) `timeoutsecs'
466 set q [$rv_ query_metadata $qry]
467 Trc $class "msg metadata= [$q get_metadata]"
468 set t [$q get_meta_field time]
469 set currTime [clock seconds]
470 if {[expr $currTime - $t] > $timeoutsecs} {
471 Trc $class "srv not heard from in >$timeoutsecs secs"
472 return 0
473 }
474 Trc $class "srv here recently"
475 }
476 return 1
477 } else {
478 if {$pid == -1} {puts "Warning: attempting to redo a failed exec."}
479 }
480 return 0
481 }
482
483
484 # FIXME - needs to check that the URL is valid
485 #
486 #
487 LocalHostManager private copyURLtoFile {url file {chunk 4096} } {
488 Trc $class "--> ${class}::$proc $url $file"
489
490 set urlhost [lindex [split $url /] 2]
491 set urlhost [lindex [split $urlhost :] 0]
492 if {[gethostbyname $urlhost] == ""} {
493 puts "copyURLtoFile: Bad hostname in URL: $urlhost"
494 return 0
495 }
496
497 puts "Retreiving URL $url ..."
498 set out [open $file w]
499 set token [::http::geturl $url -channel $out -blocksize $chunk]
500 close $out
501 set retVal [::http::code $token]
502 if {[lindex $retVal 1] != 200} {
503 puts "Error: HTTP request failed: $retVal"
504 file delete $file
505 return 0
506 }
507 ::http::reset $token
508 return $token
509 }
510
511 #
512 LocalHostManager private generate_filename {} {
513 $self instvar uniq_idx_
514 if ![info exists uniq_idx_] {set uniq_idx_ 0}
515 set r "/var/tmp/servent-${uniq_idx_}.mash"
516 while [file exists $r] {
517 incr uniq_idx_
518 set r "/var/tmp/servent-${uniq_idx_}.mash"
519 }
520 return $r
521 }
522
523
524
525 # Recv a "map-WPI-WRI" msg, which indicates the client wants us
526 # to generate a shepard from the WRI that maps to the WPI.
527 #
528 LocalHostManager public rendez_recv_map-WPI-WRI {rvmsg} {
529 Trc $class "--> ${class}::$proc [$rvmsg get_msg]"
530
531 puts "request for shepard generation (WPI to WRI mapping)"
532 }
533
534
535 #-----------------------------------------------------------------
536
537
538 import UDPServer mashutils
539
540 # accept unicast queries and control messages
541 #
542 Class LocalHostManagerCtrl -superclass UDPServer
543
544 #
545 LocalHostManagerCtrl public init {spec parent} {
546 Trc $class "--> ${class}::$proc"
547 $self next $spec
548 $self instvar parent_
549 set parent_ $parent
550 }
551
552 # unicast forwarder to the LocalHostManager, setting rspec to "-"
553 #
554 LocalHostManagerCtrl public recv {addr port data size} {
555 Trc $class "--> ${class}::$proc"
556 $self instvar parent_
557 set newmsg [new RVMsg $data "-" $addr/$port]
558 set t [$newmsg get_type]
559 set theMethod rendez_recv_$t
560 if [$parent_ has_method $theMethod] {
561 $parent_ $theMethod $newmsg
562 }
563 }
564
565
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.