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');
141 return unless $Buffers;
143 my ($conn, $line) = @_;
144 my ($port, $call) = split /\s+/, $line;
147 dbg("BPQ Outgoing Connect $conn $port $call") if isdbg('bpq');
150 for (my $i = $BPQStreams; $i > 0; $i--) {
151 my $inuse = $circuit{$Stream[$i]};
153 if (not $inuse) { # Active connection?
155 dbg("BPQ Outgoing Connect using stream $i") if isdbg('bpq');
157 $conn->{bpqstream} = $Stream[$i];
158 $conn->{lineend} = "\cM";
159 $conn->{incoming} = 0;
160 $conn->{csort} = 'ax25';
161 $conn->{bpqcall} = uc $call;
162 $circuit{$Stream[$i]} = $conn;
164 $SessionControl->Call($Stream[$i], 1, 0); # Connect
166 $conn->{state} = 'WC';
175 dbg("BPQ Outgoing Connect - No streams available") if isdbg('bpq');
177 $conn->{bpqstream} = 0; # So we can tidy up
185 dbg( "in_disconnect $conn $circuit{$conn->{bpqstream}}") if isdbg('bpq');
186 delete $circuit{$conn->{bpqstream}};
187 $conn->SUPER::disconnect;
193 return unless $enable && $Buffers;
197 delete $circuit{$conn->{bpqstream}};
199 $conn->SUPER::disconnect;
201 if ($conn->{bpqstream}) { # not if stream = 0!
202 $SessionControl->Call($conn->{bpqstream}, 2, 0); # Disconnect
209 return unless $Buffers;
211 my ($conn, $msg) = @_;
214 $msg =~ s/^[-\w]+\|//;
215 # _sendf('Y', $main::mycall, $conn->{call}, $conn->{bpqstream}, $conn->{agwpid});
216 # _sendf('D', $main::mycall, $conn->{bpqcall}, $conn->{bpqstream}, $conn->{agwpid}, $msg . $conn->{lineend});
218 $msg = $msg . $conn->{lineend};
220 my $len = length($msg);
221 $SendMsg->Call($conn->{bpqstream}, $msg, $len);
222 dbg("BPQ Data Out port: $conn->{bpqstream} length: $len \"$msg\"") if isdbg('bpq');
228 return unless $enable && $Buffers;
233 for (my $i = 1; $i <= $BPQStreams; $i++) {
234 $SessionState->Call($Stream[$i], $state, $change);
237 dbg("Stream $Stream[$i] newstate $state") if isdbg('bpq');
242 my $conn = $circuit{$Stream[$i]};
244 if ($conn) { # Active connection?
245 &{$conn->{eproc}}() if $conn->{eproc};
246 $conn->in_disconnect;
257 $GetCallsign->Call($Stream[$i],$call);
259 for ($call) { # trim whitespace in $variable, cheap
264 dbg("BPQ Connect Stream $Stream[$i] $call") if isdbg('bpq');
266 my $conn = $circuit{$Stream[$i]};;
270 # Connection already exists - if we are connecting out this is OK
272 if ($conn->{state} eq 'WC') {
273 $SendMsg->Call($Stream[$i], "?\r", 2); # Trigger response for chat script
276 # Just ignore incomming connect if we think it is already connected
280 # New Incoming Connect
282 $conn = BPQMsg->new($rproc);
283 $conn->{bpqstream} = $Stream[$i];
284 $conn->{lineend} = "\cM";
285 $conn->{incoming} = 1;
286 $conn->{bpqcall} = $call;
287 $circuit{$Stream[$i]} = $conn;
288 if (my ($c, $s) = $call =~ /^(\w+)-(\d\d?)$/) {
289 $s = 15 - $s if $s > 8;
290 $call = $s > 0 ? "${c}-${s}" : $c;
292 $conn->to_connected($call, 'A', $conn->{csort} = 'ax25');
299 # See if data received
301 my $cnt = $RXCount->Call($Stream[$i]);
306 my $Buffer = " " x 340;
310 $len=$GetMsg->Call($Stream[$i],$Buffer);
312 $Buffer = substr($Buffer,0,$len);
314 dbg ("BPQ RX: $Buffer") if isdbg('bpq');
316 my $conn = $circuit{$Stream[$i]};
320 dbg("BPQ State = $conn->{state}") if isdbg('bpq');
322 if ($conn->{state} eq 'WC') {
323 if (exists $conn->{cmd}) {
324 if (@{$conn->{cmd}}) {
325 dbg($Buffer) if isdbg('connect');
326 $conn->_docmd($Buffer);
329 if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) {
330 $conn->to_connected($conn->{call}, 'O', $conn->{csort});
333 my @lines = split /\cM\cJ?/, $Buffer;
334 push @lines, $Buffer unless @lines;
336 &{$conn->{rproc}}($conn, "I$conn->{call}|$_");
340 dbg("BPQ error Unsolicited Data!");