2 # This class is the internal subclass that deals with the G8BPQ switch connections
4 # Written by John Wiseman G8BPQ Jan 2006
6 # Based on AGWMsg.pm Copyright (c) 2001 - Dirk Koopman G1TLH
16 use vars qw(@ISA @outqueue $send_offset $inmsg $rproc $noports
17 %circuit $total_in $total_out);
19 @ISA = qw(Msg ExtMsg);
26 $total_in = $total_out = 0;
45 return unless $enable;
52 dbg("BPQWin disabled because Win32::API cannot be loaded");
60 dbg("BPQ initialising...");
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');
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)");
74 if (!defined $GetMsg) {
75 $GetMsg = Win32::API->new("bpqperl","_GetMsgPerl\@8",'NP','N');
78 if (!defined $GetMsg) {
79 dbg ("Can't find routine 'GetMsgPerl' - is bpqperl.dll available?");
84 if (defined $GetFreeBuffs && defined $GetMsg) {
87 $Buffers = $GetFreeBuffs->Call();
89 dbg("G8BPQ Free Buffers = $Buffers") if isdbg('bpq');
93 for (my $i = 1; $i <= $BPQStreams; $i++) {
95 $Stream[$i] = $FindFreeStream->Call();
99 $SetAppl->Call($Stream[$i], 0, $ApplMask);
103 dbg($s) if isdbg('bpq');
106 dbg("Couldn't initialise BPQ32 switch, BPQ disabled");
113 return unless $enable;
115 dbg("BPQ Closing..") if isdbg('bpq');
117 return unless $Buffers;
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]);
128 goto &main::login; # save some writing, this was the default
133 dbg("BPQ is active called") if isdbg('bpq');
140 $conn->{peerhost} ||= 'ax25';
141 return $conn->{peerhost};
148 return unless $Buffers;
150 my ($conn, $line) = @_;
151 my ($port, $call) = split /\s+/, $line;
154 dbg("BPQ Outgoing Connect $conn $port $call") if isdbg('bpq');
157 for (my $i = $BPQStreams; $i > 0; $i--) {
158 my $inuse = $circuit{$Stream[$i]};
160 if (not $inuse) { # Active connection?
162 dbg("BPQ Outgoing Connect using stream $i") if isdbg('bpq');
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;
171 $SessionControl->Call($Stream[$i], 1, 0); # Connect
173 $conn->{state} = 'WC';
182 dbg("BPQ Outgoing Connect - No streams available") if isdbg('bpq');
184 $conn->{bpqstream} = 0; # So we can tidy up
192 dbg( "in_disconnect $conn $circuit{$conn->{bpqstream}}") if isdbg('bpq');
193 delete $circuit{$conn->{bpqstream}};
194 $conn->SUPER::disconnect;
200 return unless $enable && $Buffers;
204 delete $circuit{$conn->{bpqstream}};
206 $conn->SUPER::disconnect;
208 if ($conn->{bpqstream}) { # not if stream = 0!
209 $SessionControl->Call($conn->{bpqstream}, 2, 0); # Disconnect
216 return unless $Buffers;
218 my ($conn, $msg) = @_;
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});
225 $msg = $msg . $conn->{lineend};
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');
235 return unless $enable && $Buffers;
240 for (my $i = 1; $i <= $BPQStreams; $i++) {
241 $SessionState->Call($Stream[$i], $state, $change);
244 dbg("Stream $Stream[$i] newstate $state") if isdbg('bpq');
249 my $conn = $circuit{$Stream[$i]};
251 if ($conn) { # Active connection?
252 &{$conn->{eproc}}() if $conn->{eproc};
253 $conn->in_disconnect;
264 $GetCallsign->Call($Stream[$i],$call);
266 for ($call) { # trim whitespace in $variable, cheap
271 dbg("BPQ Connect Stream $Stream[$i] $call") if isdbg('bpq');
273 my $conn = $circuit{$Stream[$i]};;
277 # Connection already exists - if we are connecting out this is OK
279 if ($conn->{state} eq 'WC') {
280 $SendMsg->Call($Stream[$i], "?\r", 2); # Trigger response for chat script
283 # Just ignore incomming connect if we think it is already connected
287 # New Incoming Connect
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;
299 $conn->to_connected($call, 'A', $conn->{csort} = 'ax25');
306 # See if data received
308 my $cnt = $RXCount->Call($Stream[$i]);
313 my $Buffer = " " x 340;
317 $len=$GetMsg->Call($Stream[$i],$Buffer);
319 $Buffer = substr($Buffer,0,$len);
321 dbg ("BPQ RX: $Buffer") if isdbg('bpq');
323 my $conn = $circuit{$Stream[$i]};
327 dbg("BPQ State = $conn->{state}") if isdbg('bpq');
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);
336 if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) {
337 $conn->to_connected($conn->{call}, 'O', $conn->{csort});
340 my @lines = split /\cM\cJ?/, $Buffer;
341 push @lines, $Buffer unless @lines;
343 &{$conn->{rproc}}($conn, "I$conn->{call}|$_");
347 dbg("BPQ error Unsolicited Data!");