From c644e2f01b7528fb3cd4666a552a5ee282462e88 Mon Sep 17 00:00:00 2001 From: minima Date: Tue, 27 Mar 2001 22:58:40 +0000 Subject: [PATCH] add a first cut at an incoming only AGW engine shim for M$ --- Changes | 7 + perl/AGWConnect.pm | 36 +++++ perl/AGWMsg.pm | 317 +++++++++++++++++++++++++++++++++++++++++++++ perl/Msg.pm | 27 +++- perl/cluster.pl | 8 +- 5 files changed, 391 insertions(+), 4 deletions(-) create mode 100644 perl/AGWConnect.pm create mode 100644 perl/AGWMsg.pm diff --git a/Changes b/Changes index 37ada6af..7ebe03ef 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,10 @@ +27Mar01======================================================================= +1. add first cut at an AGW Engine. Copy /spider/perl/AGWConnect.pm to +/spider/local and edit it appropriately. You shouldn't need a login and passwd +if you are using the default setup. It may allow incoming connects (and then +again it may not - I don't have a reliable infrostructure to test with at the +moment). The AGW Engine is a M$ thingy, but that don't preclude you connecting +to it from a unix box. 22Mar01======================================================================= 1. edit the helpfile for set/debug and add help for show/debug 2. Allow ^Z again on messages diff --git a/perl/AGWConnect.pm b/perl/AGWConnect.pm new file mode 100644 index 00000000..c19055ef --- /dev/null +++ b/perl/AGWConnect.pm @@ -0,0 +1,36 @@ +# +# Copy this file to /spider/local and modify it to your requirements +# +# +# This file specifies whether you want to connect to an AGW Engine +# You are only likely to want to do this in a Microsoft Windows +# environment +# + +package AGWMsg; + +use strict; +use vars qw($enable $login $passwd $addr $port $monitor); + +# set this to 1 to enable AGW Engine handling +$enable = 0; + +# user name you are logging in as +$login = ''; + +# password required +$passwd = ''; + +# +# -- don't change these unless you know what you are doing -- +# +# the ip address of the AGW engine you are connecting to +$addr = "localhost"; + +# the port number the AGW engine is listening to +$port = 8000; + +# default monitor status +$monitor = 0; + +1; diff --git a/perl/AGWMsg.pm b/perl/AGWMsg.pm new file mode 100644 index 00000000..d80f4235 --- /dev/null +++ b/perl/AGWMsg.pm @@ -0,0 +1,317 @@ +# +# This class is the internal subclass that deals with AGW Engine connections +# +# The complication here is that there only one 'real' (and from the node's point +# of view, invisible) IP connection. This connection then has multiplexed +# connections passed down it, a la BPQ native host ports (but not as nicely). +# +# It is a shame that the author has chosen an inherently dangerous binary format +# which is non-framed and has the potential for getting out of sync and not +# being able to recover. Relying on length fields is recipe for disaster (esp. +# for him!). DoS attacks are a wonderful thing.... +# +# Also making the user handle the distinction between a level 2 and 4 connection +# and especially Digis, in the way that he has, is a bit of a cop out! If I can +# be arsed to do anything other than straight ax25 connects then it will only +# because I have the 'power of perl' available that avoids me getting +# terminally bored sorting out other people's sloppyness. +# +# $Id$ +# +# Copyright (c) 2001 - Dirk Koopman G1TLH +# + +package AGWMsg; + +use strict; +use IO::Socket; +use Msg; +use AGWConnect; +use DXDebug; + +use vars qw(@ISA $sock @outqueue $send_offset $inmsg $rproc); + +@ISA = qw(Msg ExtMsg); +$sock = undef; +@outqueue = (); +$send_offset = 0; +$inmsg = ''; +$rproc = undef; + +sub init +{ + return unless $enable; + $rproc = shift; + + finish(); + dbg('err', "AGW initialising and connecting to $addr/$port ..."); + $sock = IO::Socket::INET->new(PeerAddr => $addr, PeerPort => $port, Proto=>'tcp'); + unless ($sock) { + dbg('err', "Cannot connect to AGW Engine at $addr/$port $!"); + return; + } + Msg::blocking($sock, 0); + Msg::set_event_handler($sock, read=>\&_rcv, error=>\&_error); + + # send a P frame for the login if required + if ($login) { + my $data = pack "a255 a255", $login, $passwd; + _sendf('P', undef, undef, undef, undef, $data); + } + + # send: + # R frame for the release number + # G frame to ask for ports + # X frame to say who we are + _sendf('R'); + _sendf('G'); + _sendf('X', $main::mycall); + if ($monitor) { + _sendf('m') + } +} + +sub finish +{ + if ($sock) { + dbg('err', "AGW ending..."); + for (values %Msg::conns) { + next unless $_->isa('AGWMsg'); + $_->disconnect; + } + # say we are going + _sendf('x', $main::mycall); + Msg->sleep(2); + Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef); + $sock->close; + } +} + +sub _sendf +{ + my $sort = shift || confess "need a valid AGW command letter"; + my $from = shift || ''; + my $to = shift || ''; + my $port = shift || 0; + my $pid = shift || 0; + my $data = shift || ''; + my $len = 0; + + $len = length $data; + dbg('agw', "AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$data\""); + push @outqueue, pack('C x3 a1 x1 C x1 a10 a10 V x4 a*', $port, $sort, $pid, $from, $to, $len, $data); + Msg::set_event_handler($sock, write=>\&_send); +} + +sub _send +{ + return unless $sock; + + # If $flush is set, set the socket to blocking, and send all + # messages in the queue - return only if there's an error + # If $flush is 0 (deferred mode) make the socket non-blocking, and + # return to the event loop only after every message, or if it + # is likely to block in the middle of a message. + + my $offset = $send_offset; + + while (@outqueue) { + my $msg = $outqueue[0]; + my $mlth = length($msg); + my $bytes_to_write = $mlth - $offset; + my $bytes_written = 0; + confess("Negative Length! msg: '$msg' lth: $mlth offset: $offset") if $bytes_to_write < 0; + while ($bytes_to_write > 0) { + $bytes_written = syswrite ($sock, $msg, + $bytes_to_write, $offset); + if (!defined($bytes_written)) { + if (Msg::_err_will_block($!)) { + # Should happen only in deferred mode. Record how + # much we have already sent. + $send_offset = $offset; + # Event handler should already be set, so we will + # be called back eventually, and will resume sending + return 1; + } else { # Uh, oh + _error(); + return 0; # fail. Message remains in queue .. + } + } + $offset += $bytes_written; + $bytes_to_write -= $bytes_written; + } + $send_offset = $offset = 0; + shift @outqueue; + last; # Go back to select and wait + # for it to fire again. + } + + # Call me back if queue has not been drained. + if (@outqueue) { + Msg::set_event_handler ($sock, write => \&_send); + } else { + Msg::set_event_handler ($sock, write => undef); + } + 1; # Success +} + +sub _rcv { # Complement to _send + return unless $sock; + my ($msg, $offset, $bytes_read); + + $bytes_read = sysread ($sock, $msg, 1024, 0); + if (defined ($bytes_read)) { + if ($bytes_read > 0) { + $inmsg .= $msg; + } + } else { + if (Msg::_err_will_block($!)) { + return; + } else { + $bytes_read = 0; + } + } + +FINISH: + if (defined $bytes_read && $bytes_read == 0) { + finish(); + } else { + _decode() if length $inmsg > 36; + } +} + +sub _error +{ + dbg('agw', "error on AGW connection $addr/$port $!"); + Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef); + $sock = undef; + for (values %Msg::conns) { + next unless $_->isa('AGWMsg'); + $_->disconnect; + } +} + +sub _decode +{ + return unless $sock; + + # we have at least 36 bytes of data (ugh!) + my ($port, $sort, $pid, $from, $to, $len) = unpack('C x3 a1 x1 C x1 a10 a10 V x4', $inmsg); + my $data; + + # do a sanity check on the length + if ($len > 2000) { + dbg('err', "AGW: invalid length $len > 2000 received ($sort $port $pid '$from'->'$to')"); + finish(); + return; + } + if ($len == 0){ + if (length $inmsg > 36) { + $inmsg = substr($inmsg, 36); + } else { + $inmsg = ''; + } + } elsif (length $inmsg > $len + 36) { + $data = substr($inmsg, 36, $len); + $inmsg = substr($inmsg, $len + 36); + } elsif (length $inmsg == $len + 36) { + $data = substr($inmsg, 36); + $inmsg = ''; + } else { + # we don't have enough data or something + # or we have screwed up + return; + } + + $data = '' unless defined $data; + if ($sort eq 'D') { + $data =~ s/\cR//g; + dbg('agw', "AGW Data In port: $port pid: $pid '$from'->'$to' length: $len \"$data\""); + my $conn = Msg->conns($from eq $main::mycall ? $to : $from); + if ($conn) { + if ($conn->{state} eq 'WC') { + if (exists $conn->{cmd}) { + if (@{$conn->{cmd}}) { + dbg('connect', $conn->{msg}); + $conn->_docmd($conn->{msg}); + } + } + if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) { + $conn->to_connected($conn->{call}, 'O', $conn->{csort}); + } + } else { + &{$conn->{rproc}}($conn, "I$conn->{call}|$data"); + } + } else { + dbg('err', "AGW error Unsolicited Data!"); + } + } elsif ($sort eq 'I' || $sort eq 'S' || $sort eq 'U' || $sort eq 'M') { + dbg('agw', "AGW Monitor \"$data\""); + } elsif ($sort eq 'C') { + dbg('agw', "AGW Connect port: $port pid: $pid '$from'->'$to'"); + my $call = $from eq $main::mycall ? $to : $from; + my $conn = Msg->conns($call); + if ($conn) { + if ($conn->{state} eq 'WC') { + if (exists $conn->{cmd} && @{$conn->{cmd}}) { + $conn->_docmd($data); + if ($conn->{state} eq 'WC' && exists $conn->{cmd} && @{$conn->{cmd}} == 0) { + $conn->to_connected($conn->{call}, 'O', $conn->{csort}); + } + } + } + } else { + $conn = AGWMsg->new($rproc); + $conn->to_connected($call, 'A', $conn->{csort} = 'ax25'); + } + } elsif ($sort eq 'd') { + dbg('agw', "AGW '$from'->'$to' Disconnected"); + my $conn = Msg->conns($from eq $main::mycall ? $to : $from); + $conn->in_disconnect if $conn; + } elsif ($sort eq 'y') { + my ($frames) = unpack "V", $data; + dbg('agw', "AGW Frames Outstanding on port $port = $frames"); + my $conn = Msg->conns($from); + $conn->{oframes} = $frames if $conn; + } elsif ($sort eq 'Y') { + my ($frames) = unpack "V", $data; + dbg('agw', "AGW Frames Outstanding on circuit '$from'->'$to' = $frames"); + my $conn = Msg->conns($from eq $main::mycall ? $to : $from); + $conn->{oframes} = $frames if $conn; + } elsif ($sort eq 'X') { + my ($r) = unpack "C", $data; + $r = $r ? "Successful" : "Failed"; + dbg('err', "AGW Register $from $r"); + finish() unless $r; + } elsif ($sort eq 'R') { + my ($major, $minor) = unpack "v x2 v x2", $data; + dbg('agw', "AGW Version $major.$minor"); + } elsif ($sort eq 'G') { + my @ports = split /;/, $data; + dbg('agw', "AGW $ports[0] Ports available"); + my $n = shift @ports; + pop @ports while @ports > $n; + for (@ports) { + next unless $_; + dbg('agw', "AGW Port: $_"); + } + } else { + dbg('agw', "AGW decode $sort port: $port pid: $pid '$from'->'$to' length: $len \"$data\""); + } +} + +sub in_disconnect +{ + my $conn = shift; + $conn->SUPER->disconnect; +} + +sub disconnect +{ + my $conn = shift; + _sendf('d', $main::mycall, $conn->{call}); + $conn->SUPER->disconnect; +} + +1; + diff --git a/perl/Msg.pm b/perl/Msg.pm index ec07d61d..e1672693 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -66,6 +66,7 @@ sub new lineend => "\r\n", csort => 'telnet', timeval => 60, + blocking => 0, }; $noconns++; @@ -154,7 +155,11 @@ sub connect { my $proto = getprotobyname('tcp'); $sock->socket(AF_INET, SOCK_STREAM, $proto) or return undef; - blocking($sock, 0); + if ($conn->{blocking}) { + blocking($sock, 0); + $conn->{blocking} = 0; + } + my $ip = gethostbyname($to_host); # my $r = $sock->connect($to_port, $ip); my $r = connect($sock, pack_sockaddr_in($to_port, $ip)); @@ -235,7 +240,10 @@ sub _send { # return to the event loop only after every message, or if it # is likely to block in the middle of a message. - blocking($sock, $flush); + if ($conn->{blocking} != $flush) { + blocking($sock, $flush); + $conn->{blocking} = $flush; + } my $offset = (exists $conn->{send_offset}) ? $conn->{send_offset} : 0; while (@$rq) { @@ -354,7 +362,10 @@ sub _rcv { # Complement to _send return unless defined($sock); my @lines; - blocking($sock, 0); + if ($conn->{blocking}) { + blocking($sock, 0); + $conn->{blocking} = 0; + } $bytes_read = sysread ($sock, $msg, 1024, 0); if (defined ($bytes_read)) { if ($bytes_read > 0) { @@ -413,6 +424,7 @@ sub close_all_clients } } +# #---------------------------------------------------- # Event loop routines used by both client and server @@ -480,6 +492,15 @@ sub event_loop { } } +sub sleep +{ + my ($pkg, $interval) = @_; + my $now = time; + while (time - $now < $interval) { + $pkg->event_loop(10, 0.01); + } +} + sub DESTROY { my $conn = shift; diff --git a/perl/cluster.pl b/perl/cluster.pl index b3b4c5a6..b4cfc482 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -41,6 +41,7 @@ BEGIN { use Msg; use IntMsg; use ExtMsg; +use AGWMsg; use DXVars; use DXDebug; use DXLog; @@ -97,7 +98,7 @@ sub already_conn dbg('chan', "-> D $call $mess\n"); $conn->send_now("D$call|$mess"); - sleep(2); + Msg->sleep(2); $conn->disconnect; } @@ -214,6 +215,10 @@ sub cease next if $dxchan->is_node; $dxchan->disconnect unless $dxchan == $DXProt::me; } + + # disconnect AGW + AGWMsg::finish(); + Msg->event_loop(1, 0.05); Msg->event_loop(1, 0.05); Msg->event_loop(1, 0.05); @@ -363,6 +368,7 @@ for (@main::listen) { push @listeners, $conn; dbg('err', "External Port: $_->[0] $_->[1]"); } +AGWMsg::init(\&new_channel); # load bad words dbg('err', "load badwords: " . (BadWords::load or "Ok")); -- 2.43.0