1 # al-platform-client.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1999-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/as/al-platform-client.tcl,v 1.5 2002/02/03 04:25:20 lim Exp $
32
33
34 import AnnounceListenManager/AS/Client
35
36 # Listen-only class
37 Class AnnounceListenManager/AS/Client/Platform -superclass \
38 AnnounceListenManager/AS/Client
39
40
41
42 AnnounceListenManager/AS/Client/Platform public init { spec } {
43 $self next $spec 0 client
44
45 }
46
47 AnnounceListenManager/AS/Client/Platform public service_location { } {
48 #puts "service_location called!"
49 exit
50 }
51
52 AnnounceListenManager/AS/Client/Platform instproc recv_announcement { addr port data size } {
53 $self instvar lastann_ sdp_ agentbytype_ agenttab_ atype_
54 set t [$self get_timer]
55 $t sample_size $size
56 #puts ""
57 #puts "$self ($class): recv {$data}"
58 #puts ""
59 set o [split $data \n]
60 if { [lindex $o 0] != "ASCP v[AnnounceListenManager/AS version]" } {
61 # FIXME
62 set msg "$self ($class): received non-ASCP v[$class version] announcement from $addr."
63 if { $atype_ == "hm" } {
64 $self instvar agent_
65 $agent_ log $msg
66 } else {
67 puts stderr $msg
68 }
69
70 return
71 }
72 set atype [lindex $o 1]
73 set aspec [lindex $o 2]
74 set srv_name [lindex $o 3]
75 set srv_loc [lindex $o 4]
76 set srv_inst [lindex $o 5]
77 set ssg_port [lindex $o 6]
78 set ad [join [lrange $o 7 end] \n]
79
80 # Special case death packet.
81 if { $srv_name == "DEATH" } {
82 set msg "Received death packet from $aspec at $addr - exiting."
83 if { $srv_loc == $atype_ } {
84 if { $atype_ == "hm" } {
85 $self instvar agent_
86 $agent_ log $msg
87 } else {
88 puts stderr $msg
89 }
90 $self announce_death
91 exit 0
92 }
93 $self recv_msg $atype $aspec $addr DEATH $srv_loc \
94 $srv_inst $ssg_port "$ad"
95 return
96 }
97 # Synchronous bye
98 if { $srv_name == "bye" } {
99 $self delete_agent $aspec
100 return
101 }
102
103 set pid [lindex [split $aspec @] 0]
104 #puts "pid=$pid"
105 set platformid [lindex [split $aspec @] 1]
106 #puts "platformid=$platformid"
107 set aspec $platformid
108 if ![info exists agenttab_($aspec)] {
109 # new agent
110 $self instvar avgdelta_
111 $self register $atype $aspec $addr $srv_name $srv_inst "$ad"
112 $t incr_nsrcs
113 set timeout [$self get_option startupWait]
114 set avgdelta_($aspec) [expr $timeout / 8]
115 lappend agentbytype_($atype) $aspec
116 } else {
117 set now [gettimeofday]
118 set delta [expr $now - $lastann_($aspec,abs)]
119 $self instvar avgdelta_
120 set avgdelta_($aspec) \
121 [expr 0.875*$avgdelta_($aspec)+0.125*$delta]
122
123 }
124 set agenttab_($aspec) "$addr {$ad} $atype $srv_name $srv_inst"
125 set lastann_($aspec,abs) [gettimeofday]
126 set lastann_($aspec,ascii) [gettimeofday ascii]
127 $self recv_msg $atype $aspec $addr $srv_name $srv_loc $srv_inst \
128 $ssg_port "$ad"
129 }
130
131 AnnounceListenManager/AS/Client/Platform public get_platform_list {} {
132 $self instvar platforms_
133
134 return [array names platforms_]
135 }
136
137 # don't need?
138 AnnounceListenManager/AS/Client/Platform private recv_msg { atype aspec addr srv_name \
139 srv_loc srv_inst ssg_port msg } {
140
141 # For now, this is the only type of message we should be
142 # recving on the global channel
143 switch $atype {
144 platform {
145 #puts "Got $aspec"
146 }
147 default {
148 puts "Error: atype=$atype"
149 exit
150 }
151 }
152 }
153
154 AnnounceListenManager/AS/Client/Platform instproc register { atype aspec addr srv_name srv_inst msg } {
155 $self instvar platforms_
156
157 #set platformid [lindex [split $aspec @] 1]
158 # Eventually should include location info
159 #puts "register $aspec"
160 set platforms_($aspec) $aspec
161 }
162
163 # Careful, don't want to unregister whole platform just because one host unregs
164 AnnounceListenManager/AS/Client/Platform instproc unregister { atype aspec addr srv_name srv_inst ad } {
165 $self instvar platforms_
166 #set platformid [lindex [split $aspec @] 1]
167 #puts "unregister $aspec"
168 unset platforms_($aspec)
169
170 }
171
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.