]> dxcluster.net Git - spider.git/blob - perl/BPQMsg.pm
update actual prefix file
[spider.git] / perl / BPQMsg.pm
1 #
2 # This class is the internal subclass that deals with the G8BPQ switch connections
3 #
4 # Written by John Wiseman G8BPQ Jan 2006
5 #
6 # Based on AGWMsg.pm Copyright (c) 2001 - Dirk Koopman G1TLH
7 #
8
9 package BPQMsg;
10
11 use strict;
12 use Msg;
13 use BPQConnect;
14 use DXDebug;
15
16 use vars qw(@ISA @outqueue $send_offset $inmsg $rproc $noports
17                         %circuit $total_in $total_out);
18
19 @ISA = qw(Msg ExtMsg);
20 @outqueue = ();
21 $send_offset = 0;
22 $inmsg = '';
23 $rproc = undef;
24 $noports = 0;
25 %circuit = ();
26 $total_in = $total_out = 0;
27
28 my $GetFreeBuffs;
29 my $FindFreeStream;
30 my $SetAppl;
31 my $SessionState;
32 my $GetCallsign;
33 my $SendMsg;
34 my $GetMsg;
35 my $RXCount;
36 my $DeallocateStream;
37 my $SessionControl;
38
39 my @Stream;
40
41 my $Buffers;
42
43 sub init
44 {
45         return unless $enable;
46
47         eval {
48                 require Win32::API;
49         };
50         if ($@) {
51                 $enable = 0;
52                 dbg("BPQWin disabled because Win32::API cannot be loaded");
53                 return;
54         } else {
55                 Win32::API->import;
56         }
57
58         $rproc = shift;
59
60         dbg("BPQ initialising...");
61
62         $GetFreeBuffs = Win32::API->new("bpq32", "int _GetFreeBuffs\@0()");
63     $FindFreeStream = Win32::API->new("bpq32", "int _FindFreeStream\@0()");
64     $SetAppl = Win32::API->new("bpq32", "int _SetAppl\@12(int a, int b, int c)");
65     $SessionState = Win32::API->new("bpq32", "DWORD _SessionState\@12(DWORD stream, LPDWORD state, LPDWORD change)");
66         $GetCallsign = new Win32::API("bpq32", "_GetCallsign\@8",'NP','N');
67         $SendMsg = new Win32::API("bpq32","_SendMsg\@12",'NPN','N');
68         $RXCount = new Win32::API("bpq32","_RXCount\@4",'N','N');
69         $GetMsg = Win32::API->new("bpq32","_GetMsgPerl\@8",'NP','N');
70
71         $DeallocateStream = Win32::API->new("bpq32","_DeallocateStream\@4",'N','N');
72     $SessionControl = Win32::API->new("bpq32", "int _SessionControl\@12(int a, int b, int c)");
73
74         if (!defined $GetMsg) {
75                 $GetMsg = Win32::API->new("bpqperl","_GetMsgPerl\@8",'NP','N');
76         }
77
78         if (!defined $GetMsg) {
79                 dbg ("Can't find routine 'GetMsgPerl' - is bpqperl.dll available?");
80         }
81
82         $Buffers = 0;
83
84         if (defined $GetFreeBuffs && defined $GetMsg) {
85                 my $s;
86
87                 $Buffers = $GetFreeBuffs->Call();
88
89                 dbg("G8BPQ Free Buffers = $Buffers") if isdbg('bpq');
90
91                 $s = "BPQ Streams:";
92
93                 for (my $i = 1; $i <= $BPQStreams; $i++) {
94
95                         $Stream[$i] = $FindFreeStream->Call();
96
97                         $s .= " $Stream[$i]";
98
99                         $SetAppl->Call($Stream[$i], 0, $ApplMask);
100
101                 }
102
103                 dbg($s) if isdbg('bpq');
104         } else {
105
106                 dbg("Couldn't initialise BPQ32 switch, BPQ disabled");
107                 $enable = 0;
108         }
109 }
110
111 sub finish
112 {
113         return unless $enable;
114
115         dbg("BPQ Closing..") if isdbg('bpq');
116
117         return unless $Buffers;
118
119         for (my $i = 1; $i <= $BPQStreams; $i++) {
120                 $SetAppl->Call($Stream[$i], 0, 0);
121                 $SessionControl->Call($Stream[$i], 2, 0); # Disconnect
122                 $DeallocateStream->Call($Stream[$i]);
123         }
124 }
125
126 sub login
127 {
128         goto &main::login;                      # save some writing, this was the default
129 }
130
131 sub active
132 {
133         dbg("BPQ is active called") if isdbg('bpq');
134         return $Buffers;
135 }
136
137 sub peerhost
138 {
139         my $conn = shift;
140         $conn->{peerhost} ||= 'ax25';
141         return $conn->{peerhost};
142 }
143
144
145 sub connect
146 {
147
148         return unless $Buffers;
149
150         my ($conn, $line) = @_;
151         my ($port, $call) = split /\s+/, $line;
152
153
154         dbg("BPQ Outgoing Connect  $conn $port $call") if isdbg('bpq');
155
156
157         for (my $i = $BPQStreams; $i > 0; $i--) {
158                 my $inuse = $circuit{$Stream[$i]};
159
160                 if (not $inuse) {               # Active connection?
161
162                         dbg("BPQ Outgoing Connect using stream $i") if isdbg('bpq');
163
164                         $conn->{bpqstream} = $Stream[$i];
165                         $conn->{lineend} = "\cM";
166                         $conn->{incoming} = 0;
167                         $conn->{csort} = 'ax25';
168                         $conn->{bpqcall} = uc $call;
169                         $circuit{$Stream[$i]} = $conn;
170
171                         $SessionControl->Call($Stream[$i], 1, 0); # Connect
172
173                         $conn->{state} = 'WC';
174
175                         return 1;
176
177                 }
178
179         }
180
181         # No free streams
182         dbg("BPQ Outgoing Connect - No streams available") if isdbg('bpq');
183
184         $conn->{bpqstream} = 0;         # So we can tidy up
185         $circuit{0} = $conn;
186         return 0;
187 }
188
189 sub in_disconnect
190 {
191         my $conn = shift;
192         dbg( "in_disconnect $conn $circuit{$conn->{bpqstream}}") if isdbg('bpq');
193         delete $circuit{$conn->{bpqstream}};
194         $conn->SUPER::disconnect;
195 }
196
197 sub disconnect
198 {
199
200         return unless $enable && $Buffers;
201
202         my $conn = shift;
203
204         delete $circuit{$conn->{bpqstream}};
205
206         $conn->SUPER::disconnect;
207
208         if ($conn->{bpqstream}) {       # not if stream = 0!
209                 $SessionControl->Call($conn->{bpqstream}, 2, 0); # Disconnect
210         }
211 }
212
213 sub enqueue
214 {
215
216         return unless $Buffers;
217
218         my ($conn, $msg) = @_;
219
220         if ($msg =~ /^D/) {
221                 $msg =~ s/^[-\w]+\|//;
222                 #               _sendf('Y', $main::mycall, $conn->{call}, $conn->{bpqstream}, $conn->{agwpid});
223                 #               _sendf('D', $main::mycall, $conn->{bpqcall}, $conn->{bpqstream}, $conn->{agwpid}, $msg . $conn->{lineend});
224
225                 $msg = $msg . $conn->{lineend};
226
227                 my $len = length($msg);
228                 $SendMsg->Call($conn->{bpqstream}, $msg, $len);
229                 dbg("BPQ Data Out port: $conn->{bpqstream}   length: $len \"$msg\"") if isdbg('bpq');
230         }
231 }
232
233 sub process
234 {
235         return unless $enable && $Buffers;
236
237         my $state=0;
238         my $change=0;
239
240         for (my $i = 1; $i <= $BPQStreams; $i++) {
241                 $SessionState->Call($Stream[$i], $state, $change);
242
243                 if ($change) {
244                         dbg("Stream $Stream[$i] newstate $state") if isdbg('bpq');
245
246                         if ($state == 0) {
247                                 # Disconnected
248
249                                 my $conn = $circuit{$Stream[$i]};
250
251                                 if ($conn) {            # Active connection?
252                                         &{$conn->{eproc}}() if $conn->{eproc};
253                                         $conn->in_disconnect;
254                                 }
255
256                         }
257
258                         if ($state) {
259
260                                 # Incoming call
261
262                                 my $call="            ";
263
264                                 $GetCallsign->Call($Stream[$i],$call);
265
266                                 for ($call) {   # trim whitespace in $variable, cheap
267                                 s/^\s+//;
268                                         s/\s+$//;
269                                 }
270
271                                 dbg("BPQ Connect Stream $Stream[$i] $call") if isdbg('bpq');
272
273                                 my $conn =  $circuit{$Stream[$i]};;
274
275                                 if ($conn) {
276
277                                         # Connection already exists - if we are connecting out this is OK
278
279                                         if ($conn->{state} eq 'WC') {
280                                                 $SendMsg->Call($Stream[$i], "?\r", 2); # Trigger response for chat script
281                                         }
282
283                                         # Just ignore incomming connect if we think it is already connected
284
285                                 } else {
286
287                                         # New Incoming Connect
288
289                                         $conn = BPQMsg->new($rproc);
290                                         $conn->{bpqstream} = $Stream[$i];
291                                         $conn->{lineend} = "\cM";
292                                         $conn->{incoming} = 1;
293                                         $conn->{bpqcall} = $call;
294                                         $circuit{$Stream[$i]} = $conn;
295                                         if (my ($c, $s) = $call =~ /^(\w+)-(\d\d?)$/) {
296                                                 $s = 15 - $s if $s > 8;
297                                                 $call = $s > 0 ? "${c}-${s}" : $c;
298                                         }
299                                         $conn->to_connected($call, 'A', $conn->{csort} = 'ax25');
300                                 }
301
302                         }
303
304                 }
305
306                 # See if data received
307
308                 my $cnt = $RXCount->Call($Stream[$i]);
309
310                 while ($cnt > 0) {
311                         $cnt--;
312
313                         my $Buffer = " " x 340;
314
315                         my $len=0;
316
317                         $len=$GetMsg->Call($Stream[$i],$Buffer);
318
319                         $Buffer = substr($Buffer,0,$len);
320
321                         dbg ("BPQ RX: $Buffer") if isdbg('bpq');
322
323                         my $conn = $circuit{$Stream[$i]};
324
325                         if ($conn) {
326
327                                 dbg("BPQ State = $conn->{state}") if isdbg('bpq');
328
329                                 if ($conn->{state} eq 'WC') {
330                                         if (exists $conn->{cmd}) {
331                                                 if (@{$conn->{cmd}}) {
332                                                         dbg($Buffer) if isdbg('connect');
333                                                         $conn->_docmd($Buffer);
334                                                 }
335                                         }
336                                         if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) {
337                                                 $conn->to_connected($conn->{call}, 'O', $conn->{csort});
338                                         }
339                                 } else {
340                                         my @lines = split /\cM\cJ?/, $Buffer;
341                                         push @lines, $Buffer unless @lines;
342                                         for (@lines) {
343                                                 &{$conn->{rproc}}($conn, "I$conn->{call}|$_");
344                                         }
345                                 }
346                         } else {
347                                 dbg("BPQ error Unsolicited Data!");
348                         }
349                 }
350         }
351 }
352
353 1;
354