]> gb7djk.dxcluster.net Git - spider.git/blob - perl/UDPMsg.pm
make sure DXCron::spawn records output
[spider.git] / perl / UDPMsg.pm
1 #
2 # This class is the internal subclass that deals with UDP Engine connections
3 #
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.
7 #
8 # This class will morph into (and is the test bed for) Multicasts
9 #
10 #
11 #
12 # Copyright (c) 2002 - Dirk Koopman G1TLH
13 #
14
15 package UDPMsg;
16
17 use strict;
18 use IO::Socket;
19 use Msg;
20 use DXDebug;
21
22 use vars qw(@ISA @sock @outqueue $send_offset $inmsg $rproc $noports 
23                         %circuit $total_in $total_out $enable);
24
25 @ISA = qw(Msg ExtMsg);
26 @sock = ();
27 @outqueue = ();
28 $send_offset = 0;
29 $inmsg = '';
30 $rproc = undef;
31 $noports = 0;
32 %circuit = ();
33 $total_in = $total_out = 0;
34
35 sub init
36 {
37         return unless $enable;
38         return unless @main::listen;
39         
40         $rproc = shift;
41         
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);
45                 
46                 unless ($sock) {
47                         dbg("Cannot connect to UDP Engine at $_->[0]/$_->[1] $!");
48                         return;
49                 }
50                 Msg::blocking($sock, 0);
51                 Msg::set_event_handler($sock, read=>\&_rcv, error=>\&_error);
52         }
53         finish();
54 }
55
56 my $finishing = 0;
57
58 sub finish
59 {
60         return if $finishing;
61         foreach my $sock (@sock) {
62                 $finishing = 1;
63                 dbg("UDP ending...");
64                 for (values %circuit) {
65                         &{$_->{eproc}}() if $_->{eproc};
66                         $_->disconnect;
67                 }
68                 Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef);
69                 $sock->close;
70         }
71 }
72
73 sub active
74 {
75         return scalar @sock;
76 }
77
78 sub _sendf
79 {
80         my $sort = shift || confess "need a valid UDP command letter";
81         my $from = shift || '';
82         my $to   = shift || '';
83         my $port = shift || 0;
84         my $pid  = shift || 0;
85         my $data = shift || '';
86         my $len  = 0;
87         
88         $len = length $data; 
89
90         # do it
91
92         # Msg::set_event_handler($sock, write=>\&_send);
93 }
94
95 sub _send 
96 {
97     return unless @sock;
98
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.
104
105     my $offset = $send_offset;
106
107     while (@outqueue) {
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
123                     return 1;
124                 } else {    # Uh, oh
125                                         _error();
126                     return 0; # fail. Message remains in queue ..
127                 }
128             }
129                         if (isdbg('raw')) {
130                                 dbgdump('raw', "UDP send $bytes_written: ", $msg);
131                         }
132             $total_out      += $bytes_written;
133             $offset         += $bytes_written;
134             $bytes_to_write -= $bytes_written;
135         }
136         $send_offset = $offset = 0;
137         shift @outqueue;
138         last;  # Go back to select and wait
139                        # for it to fire again.
140     }
141
142     # Call me back if queue has not been drained.
143     if (@outqueue) {
144 #        Msg::set_event_handler ($sock, write => \&_send);
145     } else {
146 #        Msg::set_event_handler ($sock, write => undef);
147     }
148     1;  # Success
149 }
150
151 sub _rcv {                     # Complement to _send
152     return unless @sock;
153
154     my ($msg, $offset, $bytes_read);
155
156 #       $bytes_read = sysread ($sock, $msg, 1024, 0);
157         if (defined ($bytes_read)) {
158                 if ($bytes_read > 0) {
159             $total_in += $bytes_read;
160                         $inmsg .= $msg;
161                         if (isdbg('raw')) {
162                                 dbgdump('raw', "UDP read $bytes_read: ", $msg);
163                         }
164                 } 
165         } else {
166                 if (Msg::_err_will_block($!)) {
167                         return; 
168                 } else {
169                         $bytes_read = 0;
170                 }
171     }
172
173 FINISH:
174     if (defined $bytes_read && $bytes_read == 0) {
175                 finish();
176     } else {
177                 _decode() if length $inmsg >= 36;
178         }
179 }
180
181 sub _error
182 {
183 #       dbg("error on UDP connection $addr/$port $!");
184 #       Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef);
185 #       $sock = undef;
186         for (%circuit) {
187                 &{$_->{eproc}}() if $_->{eproc};
188                 $_->disconnect;
189         }
190 }
191
192 sub _decode
193 {
194         return unless @sock;
195
196 }
197
198 sub _find
199 {
200         my $call = shift;
201         return $circuit{$call};
202 }
203
204 sub peerhost
205 {
206         my $conn = shift;
207         $conn->{peerhost} ||= 'ax25';
208         return $conn->{peerhost};
209 }
210
211 sub connect
212 {
213         my ($conn, $line) = @_;
214         
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';
224         return 1;
225 }
226
227 sub in_disconnect
228 {
229         my $conn = shift;
230         delete $circuit{$conn->{udpcall}}; 
231         $conn->SUPER::disconnect;
232 }
233
234 sub disconnect
235 {
236         my $conn = shift;
237         delete $circuit{$conn->{udpcall}}; 
238         if ($conn->{incoming}) {
239         }
240         $conn->SUPER::disconnect;
241 }
242
243 sub enqueue
244 {
245         my ($conn, $msg) = @_;
246         if ($msg =~ /^D/) {
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');
250         }
251 }
252
253 sub process
254 {
255         return unless @sock;
256 }
257
258 1;
259