add checks for other Win32 POSIX substitutes

[spider.git] / perl / AGWMsg.pm

diff --git a/perl/AGWMsg.pm b/perl/AGWMsg.pm
index 69c63c1ef702423bd4a1d2df1aca0f8443dad531..fdd4bc18314fa3cd5caab58afc0674abec2043a6 100644 (file)
--- a/perl/AGWMsg.pm
+++ b/perl/AGWMsg.pm
@@ -16,7 +16,7 @@
 # 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
 #
@@ -30,7 +30,8 @@ use AGWConnect;
 use DXDebug;
 
 use vars qw(@ISA $sock @outqueue $send_offset $inmsg $rproc $noports $lastytime 
-                       $lasthtime $ypolltime $hpolltime %circuit);
+                       $lasthtime $ypolltime $hpolltime %circuit $total_in $total_out
+                   $lastconnect $connectinterval);
 
 @ISA = qw(Msg ExtMsg);
 $sock = undef;
@@ -43,21 +44,23 @@ $lastytime = $lasthtime = time;
 $ypolltime = 10 unless defined $ypolltime;
 $hpolltime = 300 unless defined $hpolltime;
 %circuit = ();
-
-use vars qw($VERSION $BRANCH);
-$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
-$main::build += $VERSION;
-$main::branch += $BRANCH;
+$total_in = $total_out = 0;
+$lastconnect = 0;
+$connectinterval = 30;
 
 sub init
 {
        return unless $enable;
-       $rproc = shift;
        
+       # only set $rproc if there is something to set rproc from!
+       my $rp = shift;
+       $rproc = $rp if defined $rp;
+
        finish();
+
        dbg("AGW initialising and connecting to $addr/$port ...");
-       $sock = IO::Socket::INET->new(PeerAddr => $addr, PeerPort => $port, Proto=>'tcp', Timeout=>15);
+       $sock = IO::Socket::INET->new(PeerAddr => $addr, PeerPort => $port, Proto=>'tcp', Timeout=>3);
+       $lastconnect = $main::systime;
        unless ($sock) {
                dbg("Cannot connect to AGW Engine at $addr/$port $!");
                return;
@@ -100,7 +103,15 @@ sub finish
                Msg->sleep(2);
                Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef);
                $sock->close;
+               $lastconnect = $main::systime;
+               $sock = undef;
        }
+       $finishing = 0;
+}
+
+sub login
+{
+       goto &main::login;        # save some writing, this was the default
 }
 
 sub active
@@ -117,6 +128,8 @@ sub _sendf
        my $pid  = shift || 0;
        my $data = shift || '';
        my $len  = 0;
+
+       return unless $sock;
        
        $len = length $data; 
        if ($sort eq 'y' || $sort eq 'H') {
@@ -171,6 +184,7 @@ sub _send
                        if (isdbg('raw')) {
                                dbgdump('raw', "AGW send $bytes_written: ", $msg);
                        }
+            $total_out      += $bytes_written;
             $offset         += $bytes_written;
             $bytes_to_write -= $bytes_written;
         }
@@ -196,6 +210,7 @@ sub _rcv {                     # Complement to _send
        $bytes_read = sysread ($sock, $msg, 1024, 0);
        if (defined ($bytes_read)) {
                if ($bytes_read > 0) {
+            $total_in += $bytes_read;
                        $inmsg .= $msg;
                        if (isdbg('raw')) {
                                dbgdump('raw', "AGW read $bytes_read: ", $msg);
@@ -203,9 +218,10 @@ sub _rcv {                     # Complement to _send
                } 
        } else {
                if (Msg::_err_will_block($!)) {
-                       return; 
+                       return;
                } else {
-                       $bytes_read = 0;
+                       _error();
+                       return;
                }
     }
 
@@ -219,13 +235,17 @@ FINISH:
 
 sub _error
 {
-       dbg("error on AGW connection $addr/$port $!");
+       return if $finishing;
+       $finishing++;
+       dbg("AGW connection error on $addr/$port $!");
        Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef);
-       $sock = undef;
        for (%circuit) {
                &{$_->{eproc}}() if $_->{eproc};
                $_->disconnect;
        }
+       $sock = undef;
+       $lastconnect = $main::systime;
+       $finishing = 0;
 }
 
 sub _decode
@@ -266,7 +286,8 @@ sub _decode
                $data = '' unless defined $data;
                if ($sort eq 'D') {
                        my $d = unpack "Z*", $data;
-                       $d =~ s/\cM$//;
+                       $d =~ s/\cM\cJ?$//;
+                       $d =~ s/^\cJ//;
                        dbg("AGW Data In port: $port pid: $pid '$from'->'$to' length: $len \"$d\"") if isdbg('agw');
                        my $conn = _find($from eq $main::mycall ? $to : $from);
                        if ($conn) {
@@ -281,13 +302,10 @@ sub _decode
                                                $conn->to_connected($conn->{call}, 'O', $conn->{csort});
                                        }
                                } else {
-                                       my @lines = split /\cM/, $data;
-                                       if (@lines) {
-                                               for (@lines) {
-                                                       &{$conn->{rproc}}($conn, "I$conn->{call}|$_");
-                                               }
-                                       } else {
-                                               &{$conn->{rproc}}($conn, "I$conn->{call}|");
+                                       my @lines = split /\cM\cJ?/, $d;
+                                       push @lines, $d unless @lines;
+                                       for (@lines) {
+                                               &{$conn->{rproc}}($conn, "I$conn->{call}|$_");
                                        }
                                }
                        } else {
@@ -295,8 +313,9 @@ sub _decode
                        }
                } elsif ($sort eq 'I' || $sort eq 'S' || $sort eq 'U' || $sort eq 'M' || $sort eq 'T') {
                        my $d = unpack "Z*", $data;
-                       $d =~ s/\cM$//;
-                       my @lines = split /\cM/, $d;
+                       $d =~ s/^\cJ//;
+                       $d =~ s/\cM\cJ?$//;
+                       my @lines = split /\cM\cJ?/, $d;
                        
                        for (@lines) {
 #                              s/([\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; 
@@ -304,7 +323,7 @@ sub _decode
                        }
                } elsif ($sort eq 'C') {
                        my $d = unpack "Z*", $data;
-                       $d =~ s/\cM$//;
+                       $d =~ s/\cM\cJ?$//;
                        dbg("AGW Connect port: $port pid: $pid '$from'->'$to' \"$d\"") if isdbg('agw');
                        my $call = $from eq $main::mycall ? $to : $from;
                        my $conn = _find($call);
@@ -325,21 +344,15 @@ sub _decode
                                $conn->{incoming} = 1;
                                $conn->{agwcall} = $call;
                                $circuit{$call} = $conn;
-                               if ($call =~ /^(\w+)-(\d\d?)$/) {
-                                       my $c = $1;
-                                       my $s = $2;
-                                       $s = 15 - $s;
-                                       if ($s <= 8 && $s > 0) {
-                                               $call = "${c}-${s}";
-                                       } else {
-                                               $call = $c;
-                                       }
+                               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');
                        }
                } elsif ($sort eq 'd') {
                        my $d = unpack "Z*", $data;
-                       $d =~ s/\cM$//;
+                       $d =~ s/\cM\cJ?$//;
                        dbg("AGW '$from'->'$to' port: $port Disconnected ($d)") if isdbg('agw');
                        my $conn = _find($from eq $main::mycall ? $to : $from);
                        if ($conn) {
@@ -359,7 +372,7 @@ sub _decode
                } elsif ($sort eq 'H') {
                        unless ($from =~ /^\s+$/) {
                                my $d = unpack "Z*", $data;
-                               $d =~ s/\cM$//;
+                               $d =~ s/\cM\cJ?$//;
                                dbg("AGW Heard port: $port \"$d\"") if isdbg('agw');
                        }
                } elsif ($sort eq 'X') {
@@ -448,7 +461,12 @@ sub enqueue
 
 sub process
 {
+       # try to reconnect to AGW if we could not previously or there was an error
+       if ($enable && !$sock && $main::systime >= $lastconnect + $connectinterval) {
+               init();
+       }
        return unless $sock;
+
        if ($ypolltime && $main::systime - $lastytime >= $ypolltime) {
                for (my $i = 0; $i < $noports; $i++) {
                        _sendf('y', undef, undef, $i );