add a first cut at an incoming only AGW engine shim for M$
authorminima <minima>
Tue, 27 Mar 2001 22:58:40 +0000 (22:58 +0000)
committerminima <minima>
Tue, 27 Mar 2001 22:58:40 +0000 (22:58 +0000)
Changes
perl/AGWConnect.pm [new file with mode: 0644]
perl/AGWMsg.pm [new file with mode: 0644]
perl/Msg.pm
perl/cluster.pl

diff --git a/Changes b/Changes
index 37ada6af131911b7b2dce595a5b21488083ab651..7ebe03efbb53bda9d93c5cebd97a241268d6ae4a 100644 (file)
--- 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 (file)
index 0000000..c19055e
--- /dev/null
@@ -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 (file)
index 0000000..d80f423
--- /dev/null
@@ -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;
+
index ec07d61da6878851f6b8f11f19aba403e5729cbd..e167269363d6f674ac24a016ce2fbabea51a7c0b 100644 (file)
@@ -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;
index b3b4c5a64595547862a84b244d7d0ab14850b0eb..b4cfc4823fd01f9d62691cdceb55ec11d6663a20 100755 (executable)
@@ -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"));