X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FAGWMsg.pm;h=76b80fde344ef5601c97df9df3f5837e1d744575;hb=7c7080ad7019d6e23a8ad401256122e81fa03a5a;hp=46d3f39206491d8607f402aee1d8a7eced5c91a4;hpb=3b299fff024e01d8a5838ef2066288bee0d54bf1;p=spider.git diff --git a/perl/AGWMsg.pm b/perl/AGWMsg.pm index 46d3f392..76b80fde 100644 --- 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,17 +44,25 @@ $lastytime = $lasthtime = time; $ypolltime = 10 unless defined $ypolltime; $hpolltime = 300 unless defined $hpolltime; %circuit = (); +$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('err', "AGW initialising and connecting to $addr/$port ..."); - $sock = IO::Socket::INET->new(PeerAddr => $addr, PeerPort => $port, Proto=>'tcp', Timeout=>15); + + dbg("AGW initialising and connecting to $addr/$port ..."); + $sock = IO::Socket::INET->new(PeerAddr => $addr, PeerPort => $port, Proto=>'tcp', Timeout=>3); + $lastconnect = $main::systime; unless ($sock) { - dbg('err', "Cannot connect to AGW Engine at $addr/$port $!"); + dbg("Cannot connect to AGW Engine at $addr/$port $!"); return; } Msg::blocking($sock, 0); @@ -83,7 +92,7 @@ sub finish return if $finishing; if ($sock) { $finishing = 1; - dbg('err', "AGW ending..."); + dbg("AGW ending..."); for (values %circuit) { &{$_->{eproc}}() if $_->{eproc}; $_->disconnect; @@ -94,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 @@ -111,18 +128,20 @@ 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') { - dbg('agwpoll', "AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$data\""); + dbg("AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$data\"") if isdbg('agwpoll'); } elsif ($sort eq 'D') { if (isdbg('agw')) { my $d = $data; $d =~ s/\cM$//; - dbg('agw', "AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$d\""); + dbg("AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$d\"") if isdbg('agw'); } } else { - dbg('agw', "AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$data\""); + dbg("AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$data\"") if isdbg('agw'); } 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); @@ -165,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; } @@ -190,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); @@ -197,9 +218,10 @@ sub _rcv { # Complement to _send } } else { if (Msg::_err_will_block($!)) { - return; + return; } else { - $bytes_read = 0; + _error(); + return; } } @@ -213,13 +235,17 @@ FINISH: sub _error { - dbg('agw', "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 @@ -233,7 +259,7 @@ sub _decode # do a sanity check on the length if ($len > 2000) { - dbg('err', "AGW: invalid length $len > 2000 received ($sort $port $pid '$from'->'$to')"); + dbg("AGW: invalid length $len > 2000 received ($sort $port $pid '$from'->'$to')"); finish(); return; } @@ -260,14 +286,15 @@ sub _decode $data = '' unless defined $data; if ($sort eq 'D') { my $d = unpack "Z*", $data; - $d =~ s/\cM$//; - dbg('agw', "AGW Data In port: $port pid: $pid '$from'->'$to' length: $len \"$d\""); + $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) { if ($conn->{state} eq 'WC') { if (exists $conn->{cmd}) { if (@{$conn->{cmd}}) { - dbg('connect', $d); + dbg($d) if isdbg('connect'); $conn->_docmd($d); } } @@ -275,31 +302,29 @@ 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 { - dbg('err', "AGW error Unsolicited Data!"); + dbg("AGW error Unsolicited Data!"); } } 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; - dbg('agw', "AGW Monitor port: $port \"$_\""); +# s/([\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; + dbg("AGW Monitor port: $port \"$_\"") if isdbg('agw'); } } elsif ($sort eq 'C') { my $d = unpack "Z*", $data; - $d =~ s/\cM$//; - dbg('agw', "AGW Connect port: $port pid: $pid '$from'->'$to' \"$d\""); + $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); if ($conn) { @@ -319,22 +344,16 @@ 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$//; - dbg('agw', "AGW '$from'->'$to' port: $port Disconnected ($d)"); + $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) { &{$conn->{eproc}}() if $conn->{eproc}; @@ -342,36 +361,36 @@ sub _decode } } elsif ($sort eq 'y') { my ($frames) = unpack "V", $data; - dbg('agwpollans', "AGW Frames Outstanding on port $port = $frames"); + dbg("AGW Frames Outstanding on port $port = $frames") if isdbg('agwpollans'); my $conn = _find($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"); + dbg("AGW Frames Outstanding on circuit '$from'->'$to' = $frames") if isdbg('agw'); my $conn = _find($from eq $main::mycall ? $to : $from); $conn->{oframes} = $frames if $conn; } elsif ($sort eq 'H') { unless ($from =~ /^\s+$/) { my $d = unpack "Z*", $data; - $d =~ s/\cM$//; - dbg('agw', "AGW Heard port: $port \"$d\""); + $d =~ s/\cM\cJ?$//; + dbg("AGW Heard port: $port \"$d\"") if isdbg('agw'); } } elsif ($sort eq 'X') { my ($r) = unpack "C", $data; $r = $r ? "Successful" : "Failed"; - dbg('err', "AGW Register $from $r"); + dbg("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"); + dbg("AGW Version $major.$minor") if isdbg('agw'); } elsif ($sort eq 'G') { my @ports = split /;/, $data; $noports = shift @ports || '0'; - dbg('agw', "AGW $noports Ports available"); + dbg("AGW $noports Ports available") if isdbg('agw'); pop @ports while @ports > $noports; for (@ports) { next unless $_; - dbg('agw', "AGW Port: $_"); + dbg("AGW Port: $_") if isdbg('agw'); } for (my $i = 0; $i < $noports; $i++) { _sendf('y', undef, undef, $i); @@ -379,7 +398,7 @@ sub _decode } } else { my $d = unpack "Z*", $data; - dbg('agw', "AGW decode $sort port: $port pid: $pid '$from'->'$to' length: $len \"$d\""); + dbg("AGW decode $sort port: $port pid: $pid '$from'->'$to' length: $len \"$d\"") if isdbg('agw'); } } } @@ -390,6 +409,13 @@ sub _find return $circuit{$call}; } +sub peerhost +{ + my $conn = shift; + $conn->{peerhost} ||= $conn->{agwcall} || "UNKNOWN"; + return $conn->{peerhost}; +} + sub connect { my ($conn, $line) = @_; @@ -436,13 +462,18 @@ sub enqueue # _sendf('Y', $main::mycall, $conn->{call}, $conn->{agwport}, $conn->{agwpid}); _sendf('D', $main::mycall, $conn->{agwcall}, $conn->{agwport}, $conn->{agwpid}, $msg . $conn->{lineend}); my $len = length($msg) + 1; - dbg('agw', "AGW Data Out port: $conn->{agwport} pid: $conn->{agwpid} '$main::mycall'->'$conn->{agwcall}' length: $len \"$msg\""); + dbg("AGW Data Out port: $conn->{agwport} pid: $conn->{agwpid} '$main::mycall'->'$conn->{agwcall}' length: $len \"$msg\"") if isdbg('agw'); } } 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 );