mirror of
git://scm.dxcluster.org/scm/spider
synced 2024-09-21 07:47:10 +00:00
added Windows only BPQ interface from John G8BPQ
This commit is contained in:
parent
e5c28b46a0
commit
a90885c5c1
@ -3,7 +3,7 @@
|
||||
#
|
||||
# Copyright (c) 2001 Dirk Koopman G1TLH
|
||||
#
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
|
||||
my $self = shift;
|
||||
@ -23,6 +23,8 @@ foreach my $call (sort keys %Msg::conns) {
|
||||
$c = "Server";
|
||||
} else {
|
||||
$addr = "AGW Port ($r->{agwport})" if exists $r->{agwport};
|
||||
$addr = "BPQ Stream ($r->{bpqstream})" if exists $r->{bpqstream};
|
||||
|
||||
$addr ||= "$r->{peerhost}/$r->{peerport}";
|
||||
$addr ||= "Unknown";
|
||||
}
|
||||
|
27
perl/BPQConnect.pm
Normal file
27
perl/BPQConnect.pm
Normal file
@ -0,0 +1,27 @@
|
||||
#
|
||||
# Copy this file to /spider/local and modify it to your requirements
|
||||
#
|
||||
#
|
||||
# This file specifies whether you want to connect to a BPQ32 Switch
|
||||
# You are only likely to want to do this in a Microsoft Windows
|
||||
# environment
|
||||
#
|
||||
|
||||
package BPQMsg;
|
||||
|
||||
use strict;
|
||||
use vars qw($enable $ApplMask $BPQStreams);
|
||||
|
||||
# set this to 1 to enable BPQ handling
|
||||
|
||||
$enable = 0;
|
||||
|
||||
# Applmask is normally 1, unless you are already running another BPQ app such as a BBS
|
||||
|
||||
$ApplMask = 1;
|
||||
|
||||
# Streams to allocate - used both for incomming and outgoing connects
|
||||
|
||||
$BPQStreams = 10;
|
||||
|
||||
1;
|
347
perl/BPQMsg.pm
Normal file
347
perl/BPQMsg.pm
Normal file
@ -0,0 +1,347 @@
|
||||
#
|
||||
# This class is the internal subclass that deals with the G8BPQ switch connections
|
||||
#
|
||||
# Written by John Wiseman G8BPQ Jan 2006
|
||||
#
|
||||
# Based on AGWMsg.pm Copyright (c) 2001 - Dirk Koopman G1TLH
|
||||
#
|
||||
|
||||
package BPQMsg;
|
||||
|
||||
use strict;
|
||||
use Msg;
|
||||
use BPQConnect;
|
||||
use DXDebug;
|
||||
|
||||
use vars qw(@ISA @outqueue $send_offset $inmsg $rproc $noports
|
||||
%circuit $total_in $total_out);
|
||||
|
||||
@ISA = qw(Msg ExtMsg);
|
||||
@outqueue = ();
|
||||
$send_offset = 0;
|
||||
$inmsg = '';
|
||||
$rproc = undef;
|
||||
$noports = 0;
|
||||
%circuit = ();
|
||||
$total_in = $total_out = 0;
|
||||
|
||||
my $GetFreeBuffs;
|
||||
my $FindFreeStream;
|
||||
my $SetAppl;
|
||||
my $SessionState;
|
||||
my $GetCallsign;
|
||||
my $SendMsg;
|
||||
my $GetMsg;
|
||||
my $RXCount;
|
||||
my $DeallocateStream;
|
||||
my $SessionControl;
|
||||
|
||||
my @Stream;
|
||||
|
||||
my $Buffers;
|
||||
|
||||
sub init
|
||||
{
|
||||
return unless $enable;
|
||||
|
||||
eval {
|
||||
require Win32::API;
|
||||
};
|
||||
if ($@) {
|
||||
$enable = 0;
|
||||
dbg("BPQWin disabled because Win32::API cannot be loaded");
|
||||
return;
|
||||
} else {
|
||||
Win32::API->import;
|
||||
}
|
||||
|
||||
$rproc = shift;
|
||||
|
||||
dbg("BPQ initialising...");
|
||||
|
||||
$GetFreeBuffs = Win32::API->new("bpq32", "int _GetFreeBuffs\@0()");
|
||||
$FindFreeStream = Win32::API->new("bpq32", "int _FindFreeStream\@0()");
|
||||
$SetAppl = Win32::API->new("bpq32", "int _SetAppl\@12(int a, int b, int c)");
|
||||
$SessionState = Win32::API->new("bpq32", "DWORD _SessionState\@12(DWORD stream, LPDWORD state, LPDWORD change)");
|
||||
$GetCallsign = new Win32::API("bpq32", "_GetCallsign\@8",'NP','N');
|
||||
$SendMsg = new Win32::API("bpq32","_SendMsg\@12",'NPN','N');
|
||||
$RXCount = new Win32::API("bpq32","_RXCount\@4",'N','N');
|
||||
$GetMsg = Win32::API->new("bpq32","_GetMsgPerl\@8",'NP','N');
|
||||
|
||||
$DeallocateStream = Win32::API->new("bpq32","_DeallocateStream\@4",'N','N');
|
||||
$SessionControl = Win32::API->new("bpq32", "int _SessionControl\@12(int a, int b, int c)");
|
||||
|
||||
if (!defined $GetMsg) {
|
||||
$GetMsg = Win32::API->new("bpqperl","_GetMsgPerl\@8",'NP','N');
|
||||
}
|
||||
|
||||
if (!defined $GetMsg) {
|
||||
dbg ("Can't find routine 'GetMsgPerl' - is bpqperl.dll available?");
|
||||
}
|
||||
|
||||
$Buffers = 0;
|
||||
|
||||
if (defined $GetFreeBuffs && defined $GetMsg) {
|
||||
my $s;
|
||||
|
||||
$Buffers = $GetFreeBuffs->Call();
|
||||
|
||||
dbg("G8BPQ Free Buffers = $Buffers") if isdbg('bpq');
|
||||
|
||||
$s = "BPQ Streams:";
|
||||
|
||||
for (my $i = 1; $i <= $BPQStreams; $i++) {
|
||||
|
||||
$Stream[$i] = $FindFreeStream->Call();
|
||||
|
||||
$s .= " $Stream[$i]";
|
||||
|
||||
$SetAppl->Call($Stream[$i], 0, $ApplMask);
|
||||
|
||||
}
|
||||
|
||||
dbg($s) if isdbg('bpq');
|
||||
} else {
|
||||
|
||||
dbg("Couldn't initialise BPQ32 switch, BPQ disabled");
|
||||
$enable = 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub finish
|
||||
{
|
||||
return unless $enable;
|
||||
|
||||
dbg("BPQ Closing..") if isdbg('bpq');
|
||||
|
||||
return unless $Buffers;
|
||||
|
||||
for (my $i = 1; $i <= $BPQStreams; $i++) {
|
||||
$SetAppl->Call($Stream[$i], 0, 0);
|
||||
$SessionControl->Call($Stream[$i], 2, 0); # Disconnect
|
||||
$DeallocateStream->Call($Stream[$i]);
|
||||
}
|
||||
}
|
||||
|
||||
sub login
|
||||
{
|
||||
goto &main::login; # save some writing, this was the default
|
||||
}
|
||||
|
||||
sub active
|
||||
{
|
||||
dbg("BPQ is active called") if isdbg('bpq');
|
||||
return $Buffers;
|
||||
}
|
||||
|
||||
|
||||
sub connect
|
||||
{
|
||||
|
||||
return unless $Buffers;
|
||||
|
||||
my ($conn, $line) = @_;
|
||||
my ($port, $call) = split /\s+/, $line;
|
||||
|
||||
|
||||
dbg("BPQ Outgoing Connect $conn $port $call") if isdbg('bpq');
|
||||
|
||||
|
||||
for (my $i = $BPQStreams; $i > 0; $i--) {
|
||||
my $inuse = $circuit{$Stream[$i]};
|
||||
|
||||
if (not $inuse) { # Active connection?
|
||||
|
||||
dbg("BPQ Outgoing Connect using stream $i") if isdbg('bpq');
|
||||
|
||||
$conn->{bpqstream} = $Stream[$i];
|
||||
$conn->{lineend} = "\cM";
|
||||
$conn->{incoming} = 0;
|
||||
$conn->{csort} = 'ax25';
|
||||
$conn->{bpqcall} = uc $call;
|
||||
$circuit{$Stream[$i]} = $conn;
|
||||
|
||||
$SessionControl->Call($Stream[$i], 1, 0); # Connect
|
||||
|
||||
$conn->{state} = 'WC';
|
||||
|
||||
return 1;
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
# No free streams
|
||||
dbg("BPQ Outgoing Connect - No streams available") if isdbg('bpq');
|
||||
|
||||
$conn->{bpqstream} = 0; # So we can tidy up
|
||||
$circuit{0} = $conn;
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub in_disconnect
|
||||
{
|
||||
my $conn = shift;
|
||||
dbg( "in_disconnect $conn $circuit{$conn->{bpqstream}}") if isdbg('bpq');
|
||||
delete $circuit{$conn->{bpqstream}};
|
||||
$conn->SUPER::disconnect;
|
||||
}
|
||||
|
||||
sub disconnect
|
||||
{
|
||||
|
||||
return unless $enable && $Buffers;
|
||||
|
||||
my $conn = shift;
|
||||
|
||||
delete $circuit{$conn->{bpqstream}};
|
||||
|
||||
$conn->SUPER::disconnect;
|
||||
|
||||
if ($conn->{bpqstream}) { # not if stream = 0!
|
||||
$SessionControl->Call($conn->{bpqstream}, 2, 0); # Disconnect
|
||||
}
|
||||
}
|
||||
|
||||
sub enqueue
|
||||
{
|
||||
|
||||
return unless $Buffers;
|
||||
|
||||
my ($conn, $msg) = @_;
|
||||
|
||||
if ($msg =~ /^D/) {
|
||||
$msg =~ s/^[-\w]+\|//;
|
||||
# _sendf('Y', $main::mycall, $conn->{call}, $conn->{bpqstream}, $conn->{agwpid});
|
||||
# _sendf('D', $main::mycall, $conn->{bpqcall}, $conn->{bpqstream}, $conn->{agwpid}, $msg . $conn->{lineend});
|
||||
|
||||
$msg = $msg . $conn->{lineend};
|
||||
|
||||
my $len = length($msg);
|
||||
$SendMsg->Call($conn->{bpqstream}, $msg, $len);
|
||||
dbg("BPQ Data Out port: $conn->{bpqstream} length: $len \"$msg\"") if isdbg('bpq');
|
||||
}
|
||||
}
|
||||
|
||||
sub process
|
||||
{
|
||||
return unless $enable && $Buffers;
|
||||
|
||||
my $state=0;
|
||||
my $change=0;
|
||||
|
||||
for (my $i = 1; $i <= $BPQStreams; $i++) {
|
||||
$SessionState->Call($Stream[$i], $state, $change);
|
||||
|
||||
if ($change) {
|
||||
dbg("Stream $Stream[$i] newstate $state") if isdbg('bpq');
|
||||
|
||||
if ($state == 0) {
|
||||
# Disconnected
|
||||
|
||||
my $conn = $circuit{$Stream[$i]};
|
||||
|
||||
if ($conn) { # Active connection?
|
||||
&{$conn->{eproc}}() if $conn->{eproc};
|
||||
$conn->in_disconnect;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
if ($state) {
|
||||
|
||||
# Incoming call
|
||||
|
||||
my $call=" ";
|
||||
|
||||
$GetCallsign->Call($Stream[$i],$call);
|
||||
|
||||
for ($call) { # trim whitespace in $variable, cheap
|
||||
s/^\s+//;
|
||||
s/\s+$//;
|
||||
}
|
||||
|
||||
dbg("BPQ Connect Stream $Stream[$i] $call") if isdbg('bpq');
|
||||
|
||||
my $conn = $circuit{$Stream[$i]};;
|
||||
|
||||
if ($conn) {
|
||||
|
||||
# Connection already exists - if we are connecting out this is OK
|
||||
|
||||
if ($conn->{state} eq 'WC') {
|
||||
$SendMsg->Call($Stream[$i], "?\r", 2); # Trigger response for chat script
|
||||
}
|
||||
|
||||
# Just ignore incomming connect if we think it is already connected
|
||||
|
||||
} else {
|
||||
|
||||
# New Incoming Connect
|
||||
|
||||
$conn = BPQMsg->new($rproc);
|
||||
$conn->{bpqstream} = $Stream[$i];
|
||||
$conn->{lineend} = "\cM";
|
||||
$conn->{incoming} = 1;
|
||||
$conn->{bpqcall} = $call;
|
||||
$circuit{$Stream[$i]} = $conn;
|
||||
if (my ($c, $s) = $call =~ /^(\w+)-(\d\d?)$/) {
|
||||
$s = 15 - $s if $s > 8;
|
||||
$call = $s > 0 ? "${c}-${s}" : $c;
|
||||
}
|
||||
$conn->to_connected($call, 'A', $conn->{csort} = 'ax25');
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
# See if data received
|
||||
|
||||
my $cnt = $RXCount->Call($Stream[$i]);
|
||||
|
||||
while ($cnt > 0) {
|
||||
$cnt--;
|
||||
|
||||
my $Buffer = " " x 340;
|
||||
|
||||
my $len=0;
|
||||
|
||||
$len=$GetMsg->Call($Stream[$i],$Buffer);
|
||||
|
||||
$Buffer = substr($Buffer,0,$len);
|
||||
|
||||
dbg ("BPQ RX: $Buffer") if isdbg('bpq');
|
||||
|
||||
my $conn = $circuit{$Stream[$i]};
|
||||
|
||||
if ($conn) {
|
||||
|
||||
dbg("BPQ State = $conn->{state}") if isdbg('bpq');
|
||||
|
||||
if ($conn->{state} eq 'WC') {
|
||||
if (exists $conn->{cmd}) {
|
||||
if (@{$conn->{cmd}}) {
|
||||
dbg($Buffer) if isdbg('connect');
|
||||
$conn->_docmd($Buffer);
|
||||
}
|
||||
}
|
||||
if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) {
|
||||
$conn->to_connected($conn->{call}, 'O', $conn->{csort});
|
||||
}
|
||||
} else {
|
||||
my @lines = split /\cM\cJ?/, $Buffer;
|
||||
push @lines, $Buffer unless @lines;
|
||||
for (@lines) {
|
||||
&{$conn->{rproc}}($conn, "I$conn->{call}|$_");
|
||||
}
|
||||
}
|
||||
} else {
|
||||
dbg("BPQ error Unsolicited Data!");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
@ -5,10 +5,13 @@
|
||||
# This is where the cluster handles direct connections coming both in
|
||||
# and out
|
||||
#
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
# Copyright (c) 2001 - Dirk Koopman G1TLH
|
||||
#
|
||||
# Modified Jan 2006 by John Wiseman G8BPQ to support connections to BPQ32 node,
|
||||
# and fix pattern matching on 'chat' abort handling
|
||||
#
|
||||
|
||||
package ExtMsg;
|
||||
|
||||
@ -270,6 +273,10 @@ sub _doconnect
|
||||
# turn it into an AGW object
|
||||
bless $conn, 'AGWMsg';
|
||||
$r = $conn->connect($line);
|
||||
} elsif ($sort eq 'bpq') {
|
||||
# turn it into an BPQ object
|
||||
bless $conn, 'BPQMsg';
|
||||
$r = $conn->connect($line);
|
||||
} elsif ($sort eq 'ax25' || $sort eq 'prog') {
|
||||
$r = $conn->start_program($line, $sort);
|
||||
} else {
|
||||
@ -318,7 +325,7 @@ sub _dochat
|
||||
if ($line) {
|
||||
if ($expect) {
|
||||
dbg("connect $conn->{cnum}: expecting: \"$expect\" received: \"$line\"") if isdbg('connect');
|
||||
if ($conn->{abort} && $line =~ /\Q$conn->{abort}/i) {
|
||||
if ($conn->{abort} && $line =~ /$conn->{abort}/i) {
|
||||
dbg("connect $conn->{cnum}: aborted on /$conn->{abort}/") if isdbg('connect');
|
||||
$conn->disconnect;
|
||||
delete $conn->{cmd};
|
||||
|
@ -11,6 +11,6 @@ use vars qw($version $subversion $build);
|
||||
|
||||
$version = '1.54';
|
||||
$subversion = '0';
|
||||
$build = '199';
|
||||
$build = '200';
|
||||
|
||||
1;
|
||||
|
@ -102,6 +102,7 @@ use RouteDB;
|
||||
use DXXml;
|
||||
use DXSql;
|
||||
use IsoTime;
|
||||
use BPQMsg;
|
||||
|
||||
use Data::Dumper;
|
||||
use IO::File;
|
||||
@ -260,6 +261,7 @@ sub cease
|
||||
|
||||
# disconnect AGW
|
||||
AGWMsg::finish();
|
||||
BPQMsg::finish();
|
||||
|
||||
# disconnect UDP customers
|
||||
UDPMsg::finish();
|
||||
@ -411,6 +413,9 @@ foreach my $l (@main::listen) {
|
||||
dbg("AGW Listener") if $AGWMsg::enable;
|
||||
AGWrestart();
|
||||
|
||||
dbg("BPQ Listener") if $BPQMsg::enable;
|
||||
BPQMsg::init(\&new_channel);
|
||||
|
||||
dbg("UDP Listener") if $UDPMsg::enable;
|
||||
UDPMsg::init(\&new_channel);
|
||||
|
||||
@ -538,6 +543,7 @@ for (;;) {
|
||||
DXUser::process();
|
||||
DXDupe::process();
|
||||
AGWMsg::process();
|
||||
BPQMsg::process();
|
||||
|
||||
if (defined &Local::process) {
|
||||
eval {
|
||||
|
Loading…
Reference in New Issue
Block a user