lib/Stem/UDPMsg.pm

   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 ;