X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FAGWMsg.pm;h=1888ac6f2dcdf9e5026528c9e8449418cb06fed9;hb=b9dffeff7239952814342dad19db3a51def6fab7;hp=46d3f39206491d8607f402aee1d8a7eced5c91a4;hpb=3b299fff024e01d8a5838ef2066288bee0d54bf1;p=spider.git diff --git a/perl/AGWMsg.pm b/perl/AGWMsg.pm index 46d3f392..1888ac6f 100644 --- a/perl/AGWMsg.pm +++ b/perl/AGWMsg.pm @@ -30,7 +30,7 @@ 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); @ISA = qw(Msg ExtMsg); $sock = undef; @@ -43,6 +43,7 @@ $lastytime = $lasthtime = time; $ypolltime = 10 unless defined $ypolltime; $hpolltime = 300 unless defined $hpolltime; %circuit = (); +$total_in = $total_out = 0; sub init { @@ -50,10 +51,10 @@ sub init $rproc = shift; finish(); - dbg('err', "AGW initialising and connecting to $addr/$port ..."); + dbg("AGW initialising and connecting to $addr/$port ..."); $sock = IO::Socket::INET->new(PeerAddr => $addr, PeerPort => $port, Proto=>'tcp', Timeout=>15); 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 +84,7 @@ sub finish return if $finishing; if ($sock) { $finishing = 1; - dbg('err', "AGW ending..."); + dbg("AGW ending..."); for (values %circuit) { &{$_->{eproc}}() if $_->{eproc}; $_->disconnect; @@ -97,6 +98,11 @@ sub finish } } +sub login +{ + goto &main::login; # save some writing, this was the default +} + sub active { return $sock; @@ -114,15 +120,15 @@ sub _sendf $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 +171,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 +197,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); @@ -213,7 +221,7 @@ FINISH: sub _error { - dbg('agw', "error on AGW connection $addr/$port $!"); + dbg("error on AGW connection $addr/$port $!"); Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef); $sock = undef; for (%circuit) { @@ -233,7 +241,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 +268,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 +284,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 +326,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 +343,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 +380,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'); } } } @@ -436,7 +437,7 @@ 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'); } }