Commit | Line | Data |
4536f655 |
1 | # File: Stem/UDPMsg.pm |
2 | |
3 | # This file is part of Stem. |
4 | # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc. |
5 | |
6 | # Stem is free software; you can redistribute it and/or modify |
7 | # it under the terms of the GNU General Public License as published by |
8 | # the Free Software Foundation; either version 2 of the License, or |
9 | # (at your option) any later version. |
10 | |
11 | # Stem is distributed in the hope that it will be useful, |
12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
14 | # GNU General Public License for more details. |
15 | |
16 | # You should have received a copy of the GNU General Public License |
17 | # along with Stem; if not, write to the Free Software |
18 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
19 | |
20 | # For a license to use the Stem under conditions other than those |
21 | # described here, to purchase support for this software, or to purchase a |
22 | # commercial warranty contract, please contact Stem Systems at: |
23 | |
24 | # Stem Systems, Inc. 781-643-7504 |
25 | # 79 Everett St. info@stemsystems.com |
26 | # Arlington, MA 02474 |
27 | # USA |
28 | |
29 | package Stem::UDPMsg ; |
30 | |
31 | use strict ; |
32 | |
33 | use Data::Dumper ; |
34 | use IO::Socket ; |
35 | |
36 | my $attr_spec = [ |
37 | |
38 | { |
39 | 'name' => 'reg_name', |
40 | 'help' => <<HELP, |
41 | The registration name for this Cell |
42 | HELP |
43 | }, |
44 | |
45 | { |
46 | 'name' => 'bind_host', |
47 | 'help' => <<HELP, |
48 | The UDP socket is bound to this host for receiving or sending packets |
49 | HELP |
50 | }, |
51 | |
52 | { |
53 | 'name' => 'bind_port', |
54 | 'help' => <<HELP, |
55 | The UDP socket is bound to this port for receiving or sending packets |
56 | HELP |
57 | }, |
58 | { |
59 | 'name' => 'send_host', |
60 | 'help' => <<HELP, |
61 | The UDP packet is sent to this host if the send message has no host |
62 | HELP |
63 | }, |
64 | { |
65 | 'name' => 'send_port', |
66 | 'help' => <<HELP, |
67 | The UDP packet is sent to this port if the send message has no port |
68 | HELP |
69 | }, |
70 | { |
71 | 'name' => 'bind_port', |
72 | 'help' => <<HELP, |
73 | The UDP socket is bound to this port for receiving or sending packets |
74 | HELP |
75 | }, |
76 | { |
77 | 'name' => 'server', |
78 | 'type' => 'boolean', |
79 | 'help' => <<HELP, |
80 | Marks this socket as a server and it expect to receive UDP packets |
81 | HELP |
82 | }, |
83 | { |
84 | 'name' => 'max_recv_size', |
85 | 'default' => 4096, |
86 | 'help' => <<HELP, |
87 | Maximum size of received UDP packets. |
88 | |
89 | HELP |
90 | }, |
91 | { |
92 | 'name' => 'data_addr', |
93 | 'help' => <<HELP, |
94 | Send received UDP packets as 'udp_data' type messages to this address |
95 | HELP |
96 | }, |
97 | { |
98 | 'name' => 'error_addr', |
99 | 'help' => <<HELP, |
100 | Send received UDP errors as 'udp_error' type messages to this address |
101 | HELP |
102 | }, |
103 | { |
104 | 'name' => 'timeout_addr', |
105 | 'help' => <<HELP, |
106 | Send UDP timeouts as 'udp_timeout' type messages to this address |
107 | HELP |
108 | }, |
109 | { |
110 | 'name' => 'object', |
111 | 'help' => <<HELP, |
112 | This object will get the callbacks |
113 | HELP |
114 | }, |
115 | { |
116 | 'name' => 'timeout', |
117 | 'help' => <<HELP, |
118 | This sets the timeout period to wait for UDP data. If no data has been |
119 | received since the timer started, a timeout message or callback will |
120 | be triggered. |
121 | HELP |
122 | }, |
123 | { |
124 | 'name' => 'recv_method', |
125 | 'default' => 'udp_received', |
126 | 'help' => <<HELP, |
127 | This method will be called in the object when a UDP packet has been received |
128 | HELP |
129 | }, |
130 | { |
131 | 'name' => 'error_method', |
132 | 'default' => 'udp_error', |
133 | 'help' => <<HELP, |
134 | This method will be called in the object when a UDP had been detected |
135 | HELP |
136 | }, |
137 | { |
138 | 'name' => 'timeout_method', |
139 | 'default' => 'udp_timeout', |
140 | 'help' => <<HELP, |
141 | This method will be called in the object when no UDP data has been received |
142 | after the timeout period. |
143 | HELP |
144 | }, |
145 | { |
146 | 'name' => 'log_name', |
147 | 'help' => <<HELP, |
148 | Log to send store sent and received messages |
149 | HELP |
150 | }, |
151 | ] ; |
152 | |
153 | |
154 | sub new { |
155 | |
156 | my( $class ) = shift ; |
157 | |
158 | my $self = Stem::Class::parse_args( $attr_spec, @_ ) ; |
159 | return $self unless ref $self ; |
160 | |
161 | my $info_text = '' ; |
162 | |
163 | my $socket = IO::Socket::INET->new( 'Proto' => 'udp' ) ; |
164 | $self->{'socket'} = $socket ; |
165 | |
166 | if ( my $bind_port = $self->{'bind_port'} ) { |
167 | |
168 | $info_text .= "Port: $bind_port\n" ; |
169 | |
170 | my $bind_ip ; |
171 | my $bind_host = $self->{'bind_host'} ; |
172 | |
173 | if ( length $bind_host ) { |
174 | |
175 | $bind_ip = inet_aton( $bind_host ) ; |
176 | $info_text .= "Host: $bind_host\n" ; |
177 | } |
178 | else { |
179 | |
180 | $bind_ip = INADDR_ANY ; |
181 | $info_text .= "Host: INADDR_ANY\n" ; |
182 | } |
183 | |
184 | $socket->bind( $bind_port, $bind_ip ) ; |
185 | } |
186 | |
187 | my @timeout_args = ( $self->{'timeout'} ) ? |
188 | ( 'timeout' => $self->{'timeout'} ) : () ; |
189 | |
190 | |
191 | if ( $self->{'server'} ) { |
192 | |
193 | $self->{'read_event'} = Stem::Event::Read->new( |
194 | 'object' => $self, |
195 | 'fh' => $socket, |
196 | @timeout_args, |
197 | ) ; |
198 | } |
199 | |
200 | my $reg_name = $self->{'reg_name'} || 'NONE' ; |
201 | my $sock_host = $socket->sockhost ; |
202 | my $sock_port = $socket->sockport ; |
203 | |
204 | $self->{'info'} = <<INFO ; |
205 | --------------------- |
206 | UDPMsg |
207 | |
208 | Cell name: $reg_name |
209 | Port: $sock_port |
210 | --- |
211 | $info_text |
212 | --------------------- |
213 | |
214 | INFO |
215 | |
216 | return $self ; |
217 | } |
218 | |
219 | sub status_cmd { |
220 | |
221 | my ( $self ) = @_ ; |
222 | |
223 | return $self->{'info'} ; |
224 | } |
225 | |
226 | |
227 | sub readable { |
228 | |
229 | my( $self ) = @_ ; |
230 | |
231 | #print "UDP readable\n" ; |
232 | |
233 | my $udp_data ; |
234 | |
235 | my $udp_addr = $self->{'socket'}->recv( $udp_data, |
236 | $self->{'max_recv_size'} ) ; |
237 | |
238 | #print "UDP READ [$udp_data]\n" ; |
239 | |
240 | # handle errors |
241 | |
242 | unless( defined( $udp_addr ) ) { |
243 | |
244 | if ( my $error_addr = $self->{'error_addr'} ) { |
245 | |
246 | my $msg = Stem::Msg->new( |
247 | 'to' => $error_addr, |
248 | 'from' => $self->{'from_addr'}, |
249 | 'type' => 'udp_error', |
250 | 'data' => \"$!", |
251 | ) ; |
252 | |
253 | #print $msg->dump( 'UDP error' ) ; |
254 | $msg->dispatch() ; |
255 | return ; |
256 | } |
257 | |
258 | # send the data via a callback |
259 | |
260 | if ( my $obj = $self->{'object'} ) { |
261 | |
262 | my $method = $self->{'error_method'} ; |
263 | $obj->$method( \"$!" ) ; |
264 | } |
265 | |
266 | return ; |
267 | } |
268 | |
269 | my( $from_port, $from_host ) = unpack_sockaddr_in( $udp_addr ) ; |
270 | |
271 | $from_host = inet_ntoa( $from_host ) ; |
272 | |
273 | # send out the data as a stem message |
274 | |
275 | #print "ADDR [$self->{'data_addr'}]\n" ; |
276 | |
277 | if ( my $data_addr = $self->{'data_addr'} ) { |
278 | |
279 | my $msg = Stem::Msg->new( |
280 | 'to' => $data_addr, |
281 | 'from' => $self->{'reg_name'}, |
282 | 'type' => 'udp_data', |
283 | 'data' => { |
284 | 'data' => \$udp_data, |
285 | 'from_port' => $from_port, |
286 | 'from_host' => $from_host, |
287 | }, |
288 | ) ; |
289 | |
290 | #print $msg->dump( 'UDP recv' ) ; |
291 | $msg->dispatch() ; |
292 | return ; |
293 | } |
294 | |
295 | # send the data via a callback |
296 | |
297 | if ( my $obj = $self->{'object'} ) { |
298 | |
299 | my $method = $self->{'recv_method'} ; |
300 | $obj->$method( \$udp_data, $from_port, $from_host ) ; |
301 | } |
302 | |
303 | return ; |
304 | } |
305 | |
306 | sub read_timeout { |
307 | |
308 | my( $self ) = @_ ; |
309 | |
310 | #print "UDP timeout\n" ; |
311 | |
312 | # send out the timeout as a stem message |
313 | |
314 | if ( my $timeout_addr = $self->{'timeout_addr'} ) { |
315 | |
316 | my $msg = Stem::Msg->new( |
317 | 'to' => $timeout_addr, |
318 | 'from' => $self->{'reg_name'}, |
319 | 'type' => 'udp_timeout', |
320 | ) ; |
321 | |
322 | #print $msg->dump( 'UDP timeout' ) ; |
323 | $msg->dispatch() ; |
324 | return ; |
325 | } |
326 | |
327 | # send the timeout via a callback |
328 | |
329 | if ( my $obj = $self->{'object'} ) { |
330 | |
331 | my $method = $self->{'timeout_method'} ; |
332 | $obj->$method() ; |
333 | } |
334 | |
335 | return ; |
336 | } |
337 | |
338 | |
339 | sub send_cmd { |
340 | |
341 | my ( $self, $msg ) = @_ ; |
342 | |
343 | #print $msg->dump( 'UDP send' ) ; |
344 | my $msg_data = $msg->data() ; |
345 | |
346 | my $send_port = $msg_data->{'send_port'} || $self->{'send_port'} ; |
347 | my $send_host = $msg_data->{'send_host'} || $self->{'send_host'} ; |
348 | |
349 | my $udp_data = $msg_data->{'data'} ; |
350 | |
351 | return $self->_send( $udp_data, $send_port, $send_host ) ; |
352 | } |
353 | |
354 | sub send { |
355 | |
356 | my ( $self, $data, %args ) = @_ ; |
357 | |
358 | my $send_port = $args{'send_port'} || $self->{'send_port'} ; |
359 | my $send_host = $args{'send_host'} || $self->{'send_host'} ; |
360 | |
361 | return $self->_send( $data, $send_port, $send_host ) ; |
362 | } |
363 | |
364 | sub _send { |
365 | |
366 | my( $self, $data, $port, $host ) = @_ ; |
367 | |
368 | $host or return "Missing send_host for UDP send" ; |
369 | $port or return "Missing send_port for UDP send" ; |
370 | |
371 | #print "P $port H $host\n" ; |
372 | |
373 | my $host_ip = inet_aton( $host ) ; |
374 | $host_ip or return "Bad host '$host'" ; |
375 | |
376 | my $send_addr = pack_sockaddr_in( $port, $host_ip ) ; |
377 | |
378 | $data = $$data if ref $data ; |
379 | |
380 | my $byte_cnt = $self->{'socket'}->send( $data, 0, $send_addr ) ; |
381 | |
382 | #print "BYTES [$byte_cnt]\n" ; |
383 | |
384 | return "send error: $!" unless defined $byte_cnt ; |
385 | return ; |
386 | } |
387 | |
388 | |
389 | sub shut_down_cmd { |
390 | |
391 | my ( $self, $msg ) = @_ ; |
392 | |
393 | #print $msg->dump( 'SHUT' ) ; |
394 | |
395 | $self->shut_down() ; |
396 | |
397 | return ; |
398 | } |
399 | |
400 | sub shut_down { |
401 | |
402 | my ( $self ) = @_ ; |
403 | |
404 | if ( my $read_event = delete $self->{'read_event'} ) { |
405 | |
406 | $read_event->cancel() ; |
407 | } |
408 | |
409 | delete $self->{'object'} ; |
410 | |
411 | my $socket = delete $self->{'socket'} ; |
412 | |
413 | close $socket ; |
414 | } |
415 | |
416 | 1 ; |