2 # This class is the internal subclass that deals with UDP Engine connections
4 # The complication here is that there may be just a multicast address with
5 # one shared connection or there may be several 'connections' which have no
6 # real defined start or end.
8 # This class will morph into (and is the test bed for) Multicasts
12 # Copyright (c) 2002 - Dirk Koopman G1TLH
22 use vars qw(@ISA @sock @outqueue $send_offset $inmsg $rproc $noports
23 %circuit $total_in $total_out $enable);
25 @ISA = qw(Msg ExtMsg);
33 $total_in = $total_out = 0;
35 use vars qw($VERSION $BRANCH);
36 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
37 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
38 $main::build += $VERSION;
39 $main::branch += $BRANCH;
43 return unless $enable;
44 return unless @main::listen;
48 foreach my $sock (@main::listen) {
49 dbg("UDP initialising and connecting to $_->[0]/$_->[1] ...");
50 $sock = IO::Socket::INET->new(LocalAddr => $_->[0], LocalPort => $_->[1], Proto=>'udp', Type => SOCK_DGRAM);
53 dbg("Cannot connect to UDP Engine at $_->[0]/$_->[1] $!");
56 Msg::blocking($sock, 0);
57 Msg::set_event_handler($sock, read=>\&_rcv, error=>\&_error);
67 foreach my $sock (@sock) {
70 for (values %circuit) {
71 &{$_->{eproc}}() if $_->{eproc};
74 Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef);
86 my $sort = shift || confess "need a valid UDP command letter";
87 my $from = shift || '';
89 my $port = shift || 0;
91 my $data = shift || '';
98 # Msg::set_event_handler($sock, write=>\&_send);
105 # If $flush is set, set the socket to blocking, and send all
106 # messages in the queue - return only if there's an error
107 # If $flush is 0 (deferred mode) make the socket non-blocking, and
108 # return to the event loop only after every message, or if it
109 # is likely to block in the middle of a message.
111 my $offset = $send_offset;
114 my $msg = $outqueue[0];
115 my $mlth = length($msg);
116 my $bytes_to_write = $mlth - $offset;
117 my $bytes_written = 0;
118 confess("Negative Length! msg: '$msg' lth: $mlth offset: $offset") if $bytes_to_write < 0;
119 while ($bytes_to_write > 0) {
120 # $bytes_written = syswrite ($sock, $msg,
121 # $bytes_to_write, $offset);
122 if (!defined($bytes_written)) {
123 if (Msg::_err_will_block($!)) {
124 # Should happen only in deferred mode. Record how
125 # much we have already sent.
126 $send_offset = $offset;
127 # Event handler should already be set, so we will
128 # be called back eventually, and will resume sending
132 return 0; # fail. Message remains in queue ..
136 dbgdump('raw', "UDP send $bytes_written: ", $msg);
138 $total_out += $bytes_written;
139 $offset += $bytes_written;
140 $bytes_to_write -= $bytes_written;
142 $send_offset = $offset = 0;
144 last; # Go back to select and wait
145 # for it to fire again.
148 # Call me back if queue has not been drained.
150 # Msg::set_event_handler ($sock, write => \&_send);
152 # Msg::set_event_handler ($sock, write => undef);
157 sub _rcv { # Complement to _send
160 my ($msg, $offset, $bytes_read);
162 # $bytes_read = sysread ($sock, $msg, 1024, 0);
163 if (defined ($bytes_read)) {
164 if ($bytes_read > 0) {
165 $total_in += $bytes_read;
168 dbgdump('raw', "UDP read $bytes_read: ", $msg);
172 if (Msg::_err_will_block($!)) {
180 if (defined $bytes_read && $bytes_read == 0) {
183 _decode() if length $inmsg >= 36;
189 # dbg("error on UDP connection $addr/$port $!");
190 # Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef);
193 &{$_->{eproc}}() if $_->{eproc};
207 return $circuit{$call};
212 my ($conn, $line) = @_;
214 my ($port, $call) = split /\s+/, $line;
215 $conn->{udppid} = ord "\xF0";
216 $conn->{udpport} = $port - 1;
217 $conn->{lineend} = "\cM";
218 $conn->{incoming} = 0;
219 $conn->{csort} = 'ax25';
220 $conn->{udpcall} = uc $call;
221 $circuit{$conn->{udpcall}} = $conn;
222 $conn->{state} = 'WC';
229 delete $circuit{$conn->{udpcall}};
230 $conn->SUPER::disconnect;
236 delete $circuit{$conn->{udpcall}};
237 if ($conn->{incoming}) {
239 $conn->SUPER::disconnect;
244 my ($conn, $msg) = @_;
246 $msg =~ s/^[-\w]+\|//;
247 my $len = length($msg) + 1;
248 dbg("UDP Data Out port: $conn->{udpport} pid: $conn->{udppid} '$main::mycall'->'$conn->{udpcall}' length: $len \"$msg\"") if isdbg('udp');