From 97d5445b1e468d9228367640421b2f90ac021224 Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 21 Dec 1998 15:08:09 +0000 Subject: [PATCH] fixed one ot two little buglets --- cmd/connect.pl | 2 +- perl/DXProt.pm | 49 +++++++++++++++++++++++++++++-------------------- perl/client.pl | 24 ++++++++++++++---------- perl/cluster.pl | 15 +++++---------- 4 files changed, 49 insertions(+), 41 deletions(-) diff --git a/cmd/connect.pl b/cmd/connect.pl index e1263887..93f62b71 100644 --- a/cmd/connect.pl +++ b/cmd/connect.pl @@ -7,7 +7,7 @@ my $lccall = lc $call; return (0) if $self->priv < 8; return (1, $self->msg('e6')) unless $call gt ' '; -return (1, $self->msg('already', $call)) if DXChannel::get($call); +return (1, $self->msg('already', $call)) if DXChannel->get($call); return (1, $self->msg('conscript', $lccall)) unless -e "$main::root/connect/$lccall"; my $prog = "$main::root/local/client.pl"; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 655da52b..15466e36 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -133,8 +133,12 @@ sub normal # convert the date to a unix date my $d = cltounix($field[3], $field[4]); - return if !$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age); # bang out (and don't pass on) if date is invalid or the spot is too old - + # bang out (and don't pass on) if date is invalid or the spot is too old + if (!$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age)) { + dbg('chan', "Spot ignored, invalid date or too old"); + return; + } + # strip off the leading & trailing spaces from the comment my $text = unpad($field[5]); @@ -144,7 +148,11 @@ sub normal # do some de-duping my $dupkey = "$field[1]$field[2]$d$text$field[6]"; - return if $dup{$dupkey}; + if ($dup{$dupkey}) { + dbg('chan', "Duplicate Spot ignored"); + return; + } + $dup{$dupkey} = $d; my $spot = Spot::add($field[1], $field[2], $d, $text, $spotter); @@ -250,7 +258,7 @@ sub normal $self->send_local_config(); $self->send(pc20()); $self->state('init'); - last SWITCH; + return; # we don't pass these on } if ($pcno == 19) { # incoming cluster list @@ -529,8 +537,8 @@ sub finish my $node; foreach $node (@gonenodes) { - next if $node->call eq $call; - broadcast_ak1a(pc21($node->call, 'Gone'), $self) unless $self->{isolate}; # done like this 'cos DXNodes don't have a pc21 method + next if $node->call eq $call; + broadcast_ak1a(pc21($node->call, 'Gone') , $self) unless $self->{isolate}; $node->del(); } @@ -566,7 +574,7 @@ sub send_local_config my @s = $me->pc19(@nodes); for (@s) { my $routeit = adjust_hops($self, $_); - $self->send($_) if $routeit; + $self->send($routeit) if $routeit; } # get all the users connected on the above nodes and send them out @@ -575,7 +583,7 @@ sub send_local_config my @s = pc16($n, @users); for (@s) { my $routeit = adjust_hops($self, $_); - $self->send($_) if $routeit; + $self->send($routeit) if $routeit; } } } @@ -595,7 +603,7 @@ sub route if ($dxchan) { my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name if ($routeit) { - $dxchan->send($line) if $dxchan; + $dxchan->send($routeit) if $dxchan; } } } @@ -612,8 +620,8 @@ sub broadcast_ak1a # send it if it isn't the except list and isn't isolated and still has a hop count foreach $dxchan (@dxchan) { next if grep $dxchan == $_, @except; - my $routeit = adjust_hops($dxchan, $s); # adjust its hop count by node name - $dxchan->send($s) unless $dxchan->{isolate} || !$routeit; + my $routeit = adjust_hops($dxchan, $s); # adjust its hop count by node name + $dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit; } } @@ -701,28 +709,29 @@ sub get_hops sub adjust_hops { my $self = shift; + my $s = shift; my $call = $self->{call}; my $hops; - if (($hops) = $_[0] =~ /\^H(\d+)\^~?$/o) { - my ($pcno) = $_[0] =~ /^PC(\d\d)/o; - confess "$call called adjust_hops with '$_[0]'" unless $pcno; + if (($hops) = $s =~ /\^H(\d+)\^~?$/o) { + my ($pcno) = $s =~ /^PC(\d\d)/o; + confess "$call called adjust_hops with '$s'" unless $pcno; my $ref = $nodehops{$call} if %nodehops; if ($ref) { my $newhops = $ref->{$pcno}; - return 0 if defined $newhops && $newhops == 0; + return "" if defined $newhops && $newhops == 0; $newhops = $ref->{default} unless $newhops; - return 0 if defined $newhops && $newhops == 0; + return "" if defined $newhops && $newhops == 0; $newhops = $hops if !$newhops; - $_[0] =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops; + $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops; } else { # simply decrement it $hops--; - return 0 if !$hops; - $_[0] =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops; + return "" if !$hops; + $s =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops; } } - return 1; + return $s; } # diff --git a/perl/client.pl b/perl/client.pl index 8d2d683b..c39bda4c 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -26,6 +26,7 @@ # $Id$ # +require 5.004; # search local then perl directories BEGIN { @@ -55,7 +56,10 @@ sub cease $conn->send_now("Z$call|bye...\n"); } $stdout->flush if $stdout; - kill(15, $pid) if $pid; + if ($pid) { + dbg('connect', "killing $pid"); + kill(9, $pid); + } sleep(1); exit(0); } @@ -71,6 +75,7 @@ sub sig_chld { $SIG{CHLD} = \&sig_chld; $waitedpid = wait; + dbg('connect', "caught $pid"); } @@ -201,19 +206,18 @@ sub doconnect my ($host, $port) = split /\s+/, $line; $port = 23 if !$port; - if ($port == 23) { - $sock = new Net::Telnet (Timeout => $timeout); +# if ($port == 23) { + $sock = new Net::Telnet (Timeout => $timeout, Port => $port); $sock->option_callback(\&optioncb); $sock->output_record_separator(''); $sock->option_log('option_log'); $sock->dump_log('dump'); $sock->option_accept(Wont => TELOPT_ECHO); $sock->open($host) or die "Can't connect to $host port $port $!"; - } else { - $sock = IO::Socket::INET->new(PeerAddr => "$host:$port", Proto => 'tcp') - or die "Can't connect to $host port $port $!"; - - } +# } else { +# $sock = IO::Socket::INET->new(PeerAddr => "$host:$port", Proto => 'tcp') +# or die "Can't connect to $host port $port $!"; +# } } elsif ($sort eq 'ax25' || $sort eq 'prog') { my @args = split /\s+/, $line; $rfh = new IO::File; @@ -282,7 +286,7 @@ sub dochat sub timeout { dbg('connect', "timed out after $timeout seconds"); - cease(10); + cease(0); } @@ -411,7 +415,7 @@ if ($connsort eq "connect") { @in = ; close IN; - # alarm($timeout); + alarm($timeout); for (@in) { chomp; diff --git a/perl/cluster.pl b/perl/cluster.pl index 16a03037..32f90d88 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -10,6 +10,8 @@ # $Id$ # +require 5.004; + # make sure that modules are searched in the order local then perl BEGIN { # root of directory tree for this system @@ -98,23 +100,16 @@ sub rec return; } } + $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems } else { - if (DXCluster->get($call) || DXChannel->get($call)) { + if (DXCluster->get($call)) { my $mess = DXM::msg($lang, 'conother', $call); already_conn($conn, $call, $mess); return; } - } - - - # the user MAY have an SSID if local, but otherwise doesn't - $user = DXUser->get($call); - if (!defined $user) { $user = DXUser->new($call); - } else { - $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems } - + # is he locked out ? if ($user->lockout) { Log('DXCommand', "$call is locked out, disconnected"); -- 2.34.1