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;
37 return unless $enable;
38 return unless @main::listen;
42 foreach my $sock (@main::listen) {
43 dbg("UDP initialising and connecting to $_->[0]/$_->[1] ...");
44 $sock = IO::Socket::INET->new(LocalAddr => $_->[0], LocalPort => $_->[1], Proto=>'udp', Type => SOCK_DGRAM);
47 dbg("Cannot connect to UDP Engine at $_->[0]/$_->[1] $!");
50 Msg::blocking($sock, 0);
51 Msg::set_event_handler($sock, read=>\&_rcv, error=>\&_error);
61 foreach my $sock (@sock) {
64 for (values %circuit) {
65 &{$_->{eproc}}() if $_->{eproc};
68 Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef);
80 my $sort = shift || confess "need a valid UDP command letter";
81 my $from = shift || '';
83 my $port = shift || 0;
85 my $data = shift || '';
92 # Msg::set_event_handler($sock, write=>\&_send);
99 # If $flush is set, set the socket to blocking, and send all
100 # messages in the queue - return only if there's an error
101 # If $flush is 0 (deferred mode) make the socket non-blocking, and
102 # return to the event loop only after every message, or if it
103 # is likely to block in the middle of a message.
105 my $offset = $send_offset;
108 my $msg = $outqueue[0];
109 my $mlth = length($msg);
110 my $bytes_to_write = $mlth - $offset;
111 my $bytes_written = 0;
112 confess("Negative Length! msg: '$msg' lth: $mlth offset: $offset") if $bytes_to_write < 0;
113 while ($bytes_to_write > 0) {
114 # $bytes_written = syswrite ($sock, $msg,
115 # $bytes_to_write, $offset);
116 if (!defined($bytes_written)) {
117 if (Msg::_err_will_block($!)) {
118 # Should happen only in deferred mode. Record how
119 # much we have already sent.
120 $send_offset = $offset;
121 # Event handler should already be set, so we will
122 # be called back eventually, and will resume sending
126 return 0; # fail. Message remains in queue ..
130 dbgdump('raw', "UDP send $bytes_written: ", $msg);
132 $total_out += $bytes_written;
133 $offset += $bytes_written;
134 $bytes_to_write -= $bytes_written;
136 $send_offset = $offset = 0;
138 last; # Go back to select and wait
139 # for it to fire again.
142 # Call me back if queue has not been drained.
144 # Msg::set_event_handler ($sock, write => \&_send);
146 # Msg::set_event_handler ($sock, write => undef);
151 sub _rcv { # Complement to _send
154 my ($msg, $offset, $bytes_read);
156 # $bytes_read = sysread ($sock, $msg, 1024, 0);
157 if (defined ($bytes_read)) {
158 if ($bytes_read > 0) {
159 $total_in += $bytes_read;
162 dbgdump('raw', "UDP read $bytes_read: ", $msg);
166 if (Msg::_err_will_block($!)) {
174 if (defined $bytes_read && $bytes_read == 0) {
177 _decode() if length $inmsg >= 36;
183 # dbg("error on UDP connection $addr/$port $!");
184 # Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef);
187 &{$_->{eproc}}() if $_->{eproc};
201 return $circuit{$call};
207 $conn->{peerhost} ||= 'ax25';
208 return $conn->{peerhost};
213 my ($conn, $line) = @_;
215 my ($port, $call) = split /\s+/, $line;
216 $conn->{udppid} = ord "\xF0";
217 $conn->{udpport} = $port - 1;
218 $conn->{lineend} = "\cM";
219 $conn->{incoming} = 0;
220 $conn->{csort} = 'ax25';
221 $conn->{udpcall} = uc $call;
222 $circuit{$conn->{udpcall}} = $conn;
223 $conn->{state} = 'WC';
230 delete $circuit{$conn->{udpcall}};
231 $conn->SUPER::disconnect;
237 delete $circuit{$conn->{udpcall}};
238 if ($conn->{incoming}) {
240 $conn->SUPER::disconnect;
245 my ($conn, $msg) = @_;
247 $msg =~ s/^[-\w]+\|//;
248 my $len = length($msg) + 1;
249 dbg("UDP Data Out port: $conn->{udpport} pid: $conn->{udppid} '$main::mycall'->'$conn->{udpcall}' length: $len \"$msg\"") if isdbg('udp');