From 942cdc8c6434db4e2cf77b43ec26c0059768f853 Mon Sep 17 00:00:00 2001 From: minima Date: Mon, 20 Jan 2003 23:30:23 +0000 Subject: [PATCH] *** empty log message *** --- cmd/dbshow.pl | 2 +- cmd/ping.pl | 1 + data/wpxloc.raw | 1 + perl/AGWMsg.pm | 22 +++ perl/DXChannel.pm | 111 ++++++++++- perl/DXProt.pm | 412 +++++++++------------------------------ perl/DXUser.pm | 39 ++-- perl/QXProt.pm | 163 +++++----------- perl/Route/Node.pm | 26 +-- perl/Route/User.pm | 26 ++- perl/Thingy.pm | 84 ++++++++ perl/Thingy/RouteUser.pm | 90 +++++++++ perl/cluster.pl | 32 +-- perl/create_sysop.pl | 2 +- perl/lock_nodes.pl | 2 +- perl/update_sysop.pl | 2 +- 16 files changed, 509 insertions(+), 506 deletions(-) create mode 100644 perl/Thingy.pm create mode 100644 perl/Thingy/RouteUser.pm diff --git a/cmd/dbshow.pl b/cmd/dbshow.pl index 1835ed39..36879ff5 100644 --- a/cmd/dbshow.pl +++ b/cmd/dbshow.pl @@ -33,7 +33,7 @@ foreach $n (@db) { push @f, " " unless @f; for (@f) { my $n = DXDb::newstream($self->call); - DXProt::route(undef, $db->remote, DXProt::pc44($main::mycall, $db->remote, $n, uc $db->name,uc $_, $self->call)); + DXChannel::route(undef, $db->remote, DXProt::pc44($main::mycall, $db->remote, $n, uc $db->name,uc $_, $self->call)); } last; } else { diff --git a/cmd/ping.pl b/cmd/ping.pl index 05ccd829..ca585b0b 100644 --- a/cmd/ping.pl +++ b/cmd/ping.pl @@ -25,6 +25,7 @@ my $noderef = Route::Node::get($call); return (1, $self->msg('e7', $call)) unless $noderef; # ping it + DXProt::addping($self->call, $call); return (1, $self->msg('pingo', $call)); diff --git a/data/wpxloc.raw b/data/wpxloc.raw index 7deab366..b4bd1ab8 100644 --- a/data/wpxloc.raw +++ b/data/wpxloc.raw @@ -309,6 +309,7 @@ MO3,MQ3,MR3,MS,MV3,MY3,MZ3 Scotland-GM 65 27 14 0.0 55 48 0 N 4 2A3,2B3,2C3,2D3,2E3,2F3,2G3,2H3,2I3,2J3,2K3,2L3,2M3 Scotland-GM 65 27 14 0.0 55 48 0 N 4 18 0 W 2N3,2O3,2P3,2Q3,2R3,2S3,2T3,2U3,2V3,2W3,2X3,2Y3,2Z3 Scotland-GM 65 27 14 0.0 55 48 0 N 4 18 0 W GU Guernsey-GU 66 27 14 0.0 49 30 0 N 2 42 0 W @ +GP Guernsey-GU 66 27 14 0.0 49 30 0 N 2 42 0 W MA8,MB8,ME8,MF8,MG8,MK8,ML8 Guernsey-GU 66 27 14 0.0 49 30 0 N 2 42 0 W MO8,MQ8,MR8,MU,MV8,MY8,MZ8 Guernsey-GU 66 27 14 0.0 49 30 0 N 2 42 0 W 2A8,2B8,2C8,2D8,2E8,2F8,2G8,2H8,2I8,2J8,2K8,2L8,2M8 Guernsey-GU 66 27 14 0.0 49 30 0 N 2 42 0 W diff --git a/perl/AGWMsg.pm b/perl/AGWMsg.pm index f6fc5074..5e1c05e0 100644 --- a/perl/AGWMsg.pm +++ b/perl/AGWMsg.pm @@ -268,6 +268,8 @@ sub _decode $data = '' unless defined $data; if ($sort eq 'D') { + + # incoming data my $d = unpack "Z*", $data; $d =~ s/\cM\cJ?$//; $d =~ s/^\cJ//; @@ -295,6 +297,8 @@ sub _decode dbg("AGW error Unsolicited Data!"); } } elsif ($sort eq 'I' || $sort eq 'S' || $sort eq 'U' || $sort eq 'M' || $sort eq 'T') { + + # incoming monitoring my $d = unpack "Z*", $data; $d =~ s/^\cJ//; $d =~ s/\cM\cJ?$//; @@ -305,6 +309,8 @@ sub _decode dbg("AGW Monitor port: $port \"$_\"") if isdbg('agw'); } } elsif ($sort eq 'C') { + + # incoming connection my $d = unpack "Z*", $data; $d =~ s/\cM\cJ?$//; dbg("AGW Connect port: $port pid: $pid '$from'->'$to' \"$d\"") if isdbg('agw'); @@ -334,6 +340,8 @@ sub _decode $conn->to_connected($call, 'A', $conn->{csort} = 'ax25'); } } elsif ($sort eq 'd') { + + # incoming disconnection my $d = unpack "Z*", $data; $d =~ s/\cM\cJ?$//; dbg("AGW '$from'->'$to' port: $port Disconnected ($d)") if isdbg('agw'); @@ -343,30 +351,42 @@ sub _decode $conn->in_disconnect; } } elsif ($sort eq 'y') { + + # outstanding frames statistics (unconnected) my ($frames) = unpack "V", $data; dbg("AGW Frames Outstanding on port $port = $frames") if isdbg('agwpollans'); my $conn = _find($from); $conn->{oframes} = $frames if $conn; } elsif ($sort eq 'Y') { + + # outstanding frames statistics (connected) my ($frames) = unpack "V", $data; 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') { + + # heard stations unless ($from =~ /^\s+$/) { my $d = unpack "Z*", $data; $d =~ s/\cM\cJ?$//; dbg("AGW Heard port: $port \"$d\"") if isdbg('agw'); } } elsif ($sort eq 'X') { + + # registration reply my ($r) = unpack "C", $data; $r = $r ? "Successful" : "Failed"; dbg("AGW Register $from $r"); finish() unless $r; } elsif ($sort eq 'R') { + + # version string my ($major, $minor) = unpack "v x2 v x2", $data; dbg("AGW Version $major.$minor") if isdbg('agw'); } elsif ($sort eq 'G') { + + # list of ports my @ports = split /;/, $data; $noports = shift @ports || '0'; dbg("AGW $noports Ports available") if isdbg('agw'); @@ -380,6 +400,8 @@ sub _decode _sendf('g', undef, undef, $i); } } else { + + # some other frame my $d = unpack "Z*", $data; dbg("AGW decode $sort port: $port pid: $pid '$from'->'$to' length: $len \"$d\"") if isdbg('agw'); } diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 3b3ac62f..85145c85 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -33,12 +33,19 @@ use DXDebug; use Filter; use Prefix; use Route; +use Time::HiRes qw(gettimeofday tv_interval); use strict; -use vars qw(%channels %valid @ISA $count); +use vars qw( + %channels %pings %valid @ISA $count + $pingint $obscount + ); -%channels = (); +%pings = (); # outstanding ping requests outbound +%channels = (); # the channel list $count = 0; +$pingint = 5*60; # default pinginterval +$obscount = 2; # default obscount for pings %valid = ( call => '0,Callsign', @@ -185,6 +192,43 @@ sub get_all return values(%channels); } +# +# route a message down an appropriate interface for a callsign +# +# is called route(to, pcline); +# + +sub route +{ + my ($self, $call, $line) = @_; + + if (ref $self && $call eq $self->{call}) { + dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr'); + return; + } + + # always send it down the local interface if available + my $dxchan = DXChannel->get($call); + unless ($dxchan) { + my $cl = Route::get($call); + $dxchan = $cl->dxchan if $cl; + if (ref $dxchan) { + if (ref $self && $dxchan eq $self) { + dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr'); + return; + } + } + } + if ($dxchan) { + my $routeit = $dxchan->adjust_hops($line); # adjust its hop count by node name + if ($routeit) { + $dxchan->send($routeit) unless $dxchan == $main::me; + } + } else { + dbg("PCPROT: No route available, dropped") if isdbg('chanerr'); + } +} + # # gimme all the ak1a nodes # @@ -253,6 +297,21 @@ sub is_node my $self = shift; return $self->{'sort'} =~ /[ACRSX]/; } + +# is a node and uses old protocol +sub is_op +{ + my $self = shift; + return $self->is_node && !$self->user->wantnp; +} + +# is a node and uses new protocol +sub is_np +{ + my $self = shift; + return $self->is_node && $self->user->wantnp; +} + # is it an ak1a node ? sub is_ak1a { @@ -425,8 +484,10 @@ sub disconnect { my $self = shift; my $user = $self->{user}; + + # remove outstanding pings + delete $pings{$self->{call}}; - main::clean_inqueue($self); # clear out any remaining incoming frames $user->close() if defined $user; $self->{conn}->disconnect; $self->del(); @@ -623,10 +684,50 @@ sub broadcast_list } } +sub handlepingreply +{ + my ($self, $from) = @_; + + my $ref = $pings{$from}; + if ($ref) { + my $tochan = DXChannel->get($from); + while (@$ref) { + my $r = shift @$ref; + my $dxchan = DXChannel->get($r->{call}); + next unless $dxchan; + my $t = tv_interval($r->{t}, [ gettimeofday ]); + if ($dxchan->is_user) { + my $s = sprintf "%.2f", $t; + my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t; + $dxchan->send($dxchan->msg('pingi', $from, $s, $ave)) + } elsif ($dxchan->is_node) { + if ($tochan) { + my $nopings = $tochan->user->nopings || 2; + push @{$tochan->{pingtime}}, $t; + shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6; + + # cope with a missed ping, this means you must set the pingint large enough + if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) { + $t -= $tochan->{pingint}; + } + + # calc smoothed RTT a la TCP + if (@{$tochan->{pingtime}} == 1) { + $tochan->{pingave} = $t; + } else { + $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6); + } + $tochan->{nopings} = $nopings; # pump up the timer + } + } + } + } +} #no strict; sub AUTOLOAD { + my $self = shift; no strict; my $name = $AUTOLOAD; return if $name =~ /::DESTROY$/; @@ -637,7 +738,9 @@ sub AUTOLOAD # this clever line of code creates a subroutine which takes over from autoload # from OO Perl - Conway *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; - goto &$AUTOLOAD; + &$AUTOLOAD($self, @_); +# *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ; +# @_ ? $self->{$name} = shift : $self->{$name} ; } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 2fe92625..a6b4270f 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -43,8 +43,7 @@ $main::build += $VERSION; $main::branch += $BRANCH; use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime - $last_hour $last10 %eph %pings %rcmds $ann_to_talk - $pingint $obscount %pc19list + $last_hour $last10 %eph %rcmds $ann_to_talk %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck $allowzero $decode_dk0wcy $send_opernam @checklist); @@ -52,11 +51,8 @@ $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 $pc23_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc23 $last_hour = time; # last time I did an hourly periodic update -%pings = (); # outstanding ping requests outbound %rcmds = (); # outstanding rcmd requests outbound %nodehops = (); # node specific hop control -%pc19list = (); # list of outstanding PC19s that haven't had PC16s on them - $censorpc = 1; # Do a BadWords::check on text fields and reject things # loads of 'bad things' $baddx = new DXHash "baddx"; @@ -68,8 +64,6 @@ $rspfcheck = 1; $eph_restime = 180; $eph_info_restime = 60*60; $eph_pc34_restime = 30; -$pingint = 5*60; -$obscount = 2; @checklist = ( @@ -260,9 +254,9 @@ sub start # ping neighbour node stuff my $ping = $user->pingint; - $ping = $pingint unless defined $ping; + $ping = $DXChannel::pingint unless defined $ping; $self->{pingint} = $ping; - $self->{nopings} = $user->nopings || $obscount; + $self->{nopings} = $user->nopings || $DXChannel::obscount; $self->{pingtime} = [ ]; $self->{pingave} = 999; $self->{metric} ||= 100; @@ -516,9 +510,9 @@ sub normal # send the rcmd but we aren't interested in the replies... my $dxchan = $node->dxchan; if ($dxchan && $dxchan->is_clx) { - route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); + DXChannel::route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); } else { - route(undef, $to, pc34($main::mycall, $to, $cmd)); + DXChannel::route(undef, $to, pc34($main::mycall, $to, $cmd)); } if ($to ne $field[7]) { $to = $field[7]; @@ -526,9 +520,9 @@ sub normal if ($node) { $dxchan = $node->dxchan; if ($dxchan && $dxchan->is_clx) { - route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); + DXChannel::route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); } else { - route(undef, $to, pc34($main::mycall, $to, $cmd)); + DXChannel::route(undef, $to, pc34($main::mycall, $to, $cmd)); } } } @@ -641,76 +635,25 @@ sub normal return; } my $parent = Route::Node::get($ncall); - - # if there is a parent, proceed, otherwise if there is a latent PC19 in the PC19list, - # fix it up in the routing tables and issue it forth before the PC16 unless ($parent) { - my $nl = $pc19list{$ncall}; - - if ($nl && @field > 3) { # 3 because of the hop count! - - # this is a new (remembered) node, now attach it to me if it isn't in filtered - # and we haven't disallowed it - my $user = DXUser->get_current($ncall); - if (!$user) { - $user = DXUser->new($ncall); - $user->sort('A'); - $user->priv(1); # I have relented and defaulted nodes - $user->lockout(1); - $user->homenode($ncall); - $user->node($ncall); - } - - my $wantpc19 = $user->wantroutepc19; - if ($wantpc19 || !defined $wantpc19) { - my $new = Route->new($ncall); # throw away - if ($self->in_filter_route($new)) { - my @nrout; - for (@$nl) { - $parent = Route::Node::get($_->[0]); - $dxchan = $parent->dxchan if $parent; - if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC19 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); - $parent = undef; - } - if ($parent) { - my $r = $parent->add($ncall, $_->[1], $_->[2]); - push @nrout, $r unless @nrout; - } - } - $user->wantroutepc19(1) unless defined $wantpc19; # for now we work on the basis that pc16 = real route - $user->lastin($main::systime) unless DXChannel->get($ncall); - $user->put; - - # route the pc19 - this will cause 'stuttering PC19s' for a while - $self->route_pc19(@nrout) if @nrout ; - $parent = Route::Node::get($ncall); - unless ($parent) { - dbg("PCPROT: lost $ncall after sending PC19 for it?"); - return; - } - } else { - return; - } - delete $pc19list{$ncall}; - } - } else { - dbg("PCPROT: Node $ncall not in config") if isdbg('chanerr'); - return; - } - } else { - - $dxchan = $parent->dxchan; - if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); - return; - } - - # input filter if required - return unless $self->in_filter_route($parent); + dbg("PCPROT: Node $ncall not in config") if isdbg('chanerr'); + return; + } + $dxchan = $parent->dxchan; + if ($dxchan && $dxchan ne $self) { + dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); + return; } + my ($hops) = $field[-1] =~ /H(\d+)/; + my $thing = Thingy::Route->new(fromnode => $ncall, fromdxchan => $self, pcline=>$line, hops=>$hops); + + + # input filter if required + return unless $self->in_filter_route($parent); + my $i; + my @list; my @rout; for ($i = 2; $i < $#field; $i++) { my ($call, $conf, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o; @@ -729,35 +672,14 @@ sub normal next; } - $r = Route::User::get($call); my $flags = Route::here($here)|Route::conf($conf); - - if ($r) { - my $au = $r->addparent($parent); - if ($r->flags != $flags) { - $r->flags($flags); - $au = $r; - } - push @rout, $r if $au; - } else { - push @rout, $parent->add_user($call, $flags); - } - - - # add this station to the user database, if required - $call =~ s/-\d+$//o; # remove ssid for users - my $user = DXUser->get_current($call); - $user = DXUser->new($call) if !$user; - $user->homenode($parent->call) if !$user->homenode; - $user->node($parent->call); - $user->lastin($main::systime) unless DXChannel->get($call); - $user->put; + $r = Route::User::new($call, $ncall, $flags); + push @list, $r; } - - # queue up any messages (look for privates only) - DXMsg::queue_msg(1) if $self->state eq 'normal'; - $self->route_pc16($parent, @rout) if @rout; + $thing->list(\@list); + $thing->add; + $thing->route; return; } @@ -849,14 +771,19 @@ sub normal # new routing list my @rout; - my $parent = Route::Node::get($self->{call}); + my $ncall = $self->{call}; + my $parent = Route::Node::get($ncall); unless ($parent) { - dbg("DXPROT: my parent $self->{call} has disappeared"); + dbg("DXPROT: my parent $ncall has disappeared"); $self->disconnect; return; } + my ($hops) = $field[-1] =~ /H(\d+)/; + my $thing = Thingy::Route->new(fromnode=>$ncall, fromdxchan => $self, pcline=>$line, hops=>$hops); + # parse the PC19 + my @list; for ($i = 1; $i < $#field-1; $i += 4) { my $here = $field[$i]; my $call = uc $field[$i+1]; @@ -879,65 +806,15 @@ sub normal next; } - # add this station to the user database, if required (don't remove SSID from nodes) - my $user = DXUser->get_current($call); - if (!$user) { - $user = DXUser->new($call); - $user->sort('A'); - $user->priv(1); # I have relented and defaulted nodes - $user->lockout(1); - $user->homenode($call); - $user->node($call); - } - - my $r = Route::Node::get($call); - my $flags = Route::here($here)|Route::conf($conf); - - # modify the routing table if it is in it, otherwise store it in the pc19list for now - if ($r) { - my $ar; - if ($call ne $parent->call) { - if ($self->in_filter_route($r)) { - $ar = $parent->add($call, $ver, $flags); - push @rout, $ar if $ar; - } else { - next; - } - } - if ($r->version ne $ver || $r->flags != $flags) { - $r->version($ver); - $r->flags($flags); - push @rout, $r unless $ar; - } - } else { - - # if he is directly connected or allowed then add him, otherwise store him up for later - if ($call eq $self->{call} || $user->wantroutepc19) { - my $new = Route->new($call); # throw away - if ($self->in_filter_route($new)) { - my $ar = $parent->add($call, $ver, $flags); - $user->wantroutepc19(1) unless defined $user->wantroutepc19; - push @rout, $ar if $ar; - } else { - next; - } - } else { - $pc19list{$call} = [] unless exists $pc19list{$call}; - my $nl = $pc19list{$call}; - push @{$pc19list{$call}}, [$self->{call}, $ver, $flags] unless grep $_->[0] eq $self->{call}, @$nl; - } - } - - # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect) - my $mref = DXMsg::get_busy($call); - $mref->stop_msg($call) if $mref; - - $user->lastin($main::systime) unless DXChannel->get($call); - $user->put; + # decide whether we want this or not? + my $r = Route::Node->new($call, $ver, $flags); + push @list, $r if $call ne $ncall && $self->in_filter_route($r); + } + if (@list) { + $thing->list(\@list); + $thing->add; + $thing->route; } - - - $self->route_pc19(@rout) if @rout; return; } @@ -952,7 +829,7 @@ sub normal if ($pcno == 21) { # delete a cluster from the list my $call = uc $field[1]; - eph_del_regex("^PC1[679].*$call"); + eph_del_regex("^PC1[79].*$call"); # if I get a PC21 from the same callsign as self then treat it # as a PC39: I have gone away @@ -961,42 +838,39 @@ sub normal return; } - # check to see if we are in the pc19list, if we are then don't bother with any of - # this routing table manipulation, just remove it from the list and dump it my @rout; - if (my $nl = $pc19list{$call}) { - $pc19list{$call} = [ grep {$_->[0] ne $self->{call}} @$nl ]; - delete $pc19list{$call} unless @{$pc19list{$call}}; - } else { - - my $parent = Route::Node::get($self->{call}); - unless ($parent) { - dbg("DXPROT: my parent $self->{call} has disappeared"); - $self->disconnect; - return; - } - if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me! - my $node = Route::Node::get($call); - if ($node) { - - my $dxchan = DXChannel->get($call); - if ($dxchan && $dxchan != $self) { - dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr'); - return; - } - - # input filter it - return unless $self->in_filter_route($node); - - # routing objects - push @rout, $node->del($parent); + my $parent = Route::Node::get($self->{call}); + unless ($parent) { + dbg("DXPROT: my parent $self->{call} has disappeared"); + $self->disconnect; + return; + } + if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me! + my $node = Route::Node::get($call); + if ($node) { + + my $dxchan = DXChannel->get($call); + if ($dxchan && $dxchan != $self) { + dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr'); + return; } - } else { - dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr'); - return; + + # input filter it + return unless $self->in_filter_route($node); + + # routing objects + push @rout, $node->del($parent); } + } else { + dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr'); + return; } +# if (eph_dup($line)) { +# dbg("PCPROT: dup PC21 detected") if isdbg('chanerr'); +# return; +# } + $self->route_pc21(@rout) if @rout; return; } @@ -1145,9 +1019,7 @@ sub normal if ($pcno == 41) { # user info my $call = $field[1]; - my $l = $line; - $l =~ s/[\x00-\x20\x7f-\xff]+//g; # remove all funny characters and spaces for dup checking - if (eph_dup($l, $eph_info_restime)) { + if (eph_dup($line, $eph_info_restime)) { dbg("PCPROT: dupe") if isdbg('chanerr'); return; } @@ -1240,40 +1112,7 @@ sub normal $self->send(pc51($from, $to, '0')); } else { # it's a reply, look in the ping list for this one - my $ref = $pings{$from}; - if ($ref) { - my $tochan = DXChannel->get($from); - while (@$ref) { - my $r = shift @$ref; - my $dxchan = DXChannel->get($r->{call}); - next unless $dxchan; - my $t = tv_interval($r->{t}, [ gettimeofday ]); - if ($dxchan->is_user) { - my $s = sprintf "%.2f", $t; - my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t; - $dxchan->send($dxchan->msg('pingi', $from, $s, $ave)) - } elsif ($dxchan->is_node) { - if ($tochan) { - my $nopings = $tochan->user->nopings || 2; - push @{$tochan->{pingtime}}, $t; - shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6; - - # cope with a missed ping, this means you must set the pingint large enough - if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) { - $t -= $tochan->{pingint}; - } - - # calc smoothed RTT a la TCP - if (@{$tochan->{pingtime}} == 1) { - $tochan->{pingave} = $t; - } else { - $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6); - } - $tochan->{nopings} = $nopings; # pump up the timer - } - } - } - } + $self->handlepingreply($from); } } else { if (eph_dup($line)) { @@ -1374,7 +1213,7 @@ sub process } foreach $dxchan (@dxchan) { - next unless $dxchan->is_node(); + next unless $dxchan->is_op(); next if $dxchan == $main::me; # send the pc50 or PC90 @@ -1385,7 +1224,7 @@ sub process if ($dxchan->{nopings} <= 0) { $dxchan->disconnect; } else { - addping($main::mycall, $dxchan->call); + $dxchan->addping($main::mycall, $dxchan->call); $dxchan->{nopings} -= 1; $dxchan->{lastping} = $t; } @@ -1414,7 +1253,6 @@ sub process # some active measures # - sub send_dx_spot { my $self = shift; @@ -1678,49 +1516,15 @@ sub send_local_config # get all the users connected on the above nodes and send them out foreach $node (@localnodes, @remotenodes) { if ($node) { - my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users; - $self->send_route(\&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16; + $self->send_route(\&pc16, 1, $node, + map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users) + if $self->user->wantsendpc16; } else { dbg("sent a null value") if isdbg('chanerr'); } } } -# -# route a message down an appropriate interface for a callsign -# -# is called route(to, pcline); -# -sub route -{ - my ($self, $call, $line) = @_; - - if (ref $self && $call eq $self->{call}) { - dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr'); - return; - } - - # always send it down the local interface if available - my $dxchan = DXChannel->get($call); - unless ($dxchan) { - my $cl = Route::get($call); - $dxchan = $cl->dxchan if $cl; - if (ref $dxchan) { - if (ref $self && $dxchan eq $self) { - dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr'); - return; - } - } - } - if ($dxchan) { - my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name - if ($routeit) { - $dxchan->send($routeit) unless $dxchan == $main::me; - } - } else { - dbg("PCPROT: No route available, dropped") if isdbg('chanerr'); - } -} # # obtain the hops from the list for this callsign and pc no @@ -1779,20 +1583,6 @@ sub load_hops return (); } - -# add a ping request to the ping queues -sub addping -{ - my ($from, $to) = @_; - my $ref = $pings{$to} || []; - my $r = {}; - $r->{call} = $from; - $r->{t} = [ gettimeofday ]; - route(undef, $to, pc51($to, $main::mycall, 1)); - push @$ref, $r; - $pings{$to} = $ref; -} - sub process_rcmd { my ($self, $tonode, $fromnode, $user, $cmd) = @_; @@ -1882,9 +1672,9 @@ sub addrcmd my $ref = Route::Node::get($to); my $dxchan = $ref->dxchan; if ($dxchan && $dxchan->is_clx) { - route(undef, $to, pc84($main::mycall, $to, $self->{call}, $cmd)); + DXChannel::route(undef, $to, pc84($main::mycall, $to, $self->{call}, $cmd)); } else { - route(undef, $to, pc34($main::mycall, $to, $cmd)); + DXChannel::route(undef, $to, pc34($main::mycall, $to, $cmd)); } } @@ -1900,35 +1690,17 @@ sub disconnect $self->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', "System Op"))); } - # get rid of any PC16/17/19 - eph_del_regex("^PC1[679]*$call"); + # get rid of any PC16 and 19s + eph_del_regex("^PC16\\^$call"); + eph_del_regex("^PC19\\^.*$call"); - # do routing stuff, remove me from routing table + # do routing stuff my $node = Route::Node::get($call); my @rout; if ($node) { @rout = $node->del($main::routeroot); - - # and all my ephemera as well - for (@rout) { - my $c = $_->call; - eph_del_regex("^PC1[679].*$c"); - } } - # remove them from the pc19list as well - while (my ($k,$v) = each %pc19list) { - my @l = grep {$_->[0] ne $call} @{$pc19list{$k}}; - if (@l) { - $pc19list{$k} = \@l; - } else { - delete $pc19list{$k}; - } - - # and the ephemera - eph_del_regex("^PC1[679].*$k"); - } - # unbusy and stop and outgoing mail my $mref = DXMsg::get_busy($call); $mref->stop_msg($call) if $mref; @@ -1938,9 +1710,6 @@ sub disconnect $self->route_pc21(@rout) if @rout; } - # remove outstanding pings - delete $pings{$call}; - # I was the last node visited $self->user->node($main::mycall); @@ -2092,6 +1861,19 @@ sub in_filter_route return $filter; } +# add a ping request to the ping queues +sub addping +{ + my ($self, $from, $to) = @_; + my $ref = $DXChannel::pings{$to} || []; + my $r = {}; + $r->{call} = $from; + $r->{t} = [ gettimeofday ]; + DXChannel::route(undef, $to, pc51($to, $main::mycall, 1)); + push @$ref, $r; + $DXCHannel::pings{$to} = $ref; +} + sub eph_dup { my $s = shift; diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 7c9a4b36..892f1a59 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -25,7 +25,7 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)) $main::build += $VERSION; $main::branch += $BRANCH; -use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold); +use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize); %u = (); $dbm = undef; @@ -33,7 +33,6 @@ $filename = undef; $lastoperinterval = 60*24*60*60; $lasttime = 0; $lrusize = 2000; -$tooold = 86400 * 365; # this marks an old user who hasn't given enough info to be useful # hash of valid elements and a simple prompt %valid = ( @@ -80,8 +79,7 @@ $tooold = 86400 * 365; # this marks an old user who hasn't given enough info to wantpc90 => '1,Req PC90,yesno', wantnp => '1,Req New Protocol,yesno', wantpc16 => '9,Want Users from node,yesno', - wantsendpc16 => '9,Send PC16,yesno', - wantroutepc19 => '9,Route PC19,yesno', + wantsendpc16 => '9,Send users to node,yesno', lastoper => '9,Last for/oper,cldatetime', nothere => '0,Not Here Text', registered => '9,Registered?,yesno', @@ -93,6 +91,7 @@ $tooold = 86400 * 365; # this marks an old user who hasn't given enough info to #no strict; sub AUTOLOAD { + my $self = shift; no strict; my $name = $AUTOLOAD; @@ -103,7 +102,12 @@ sub AUTOLOAD # this clever line of code creates a subroutine which takes over from autoload # from OO Perl - Conway *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; - goto &$AUTOLOAD; + &$AUTOLOAD($self, @_); +# *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ; +# if (@_) { +# $self->{$name} = shift; +# } +# return $self->{$name}; } #use strict; @@ -342,7 +346,6 @@ sub export my $count = 0; my $err = 0; - my $del = 0; my $fh = new IO::File ">$fn" or return "cannot open $fn ($!)"; if ($fh) { my $key = 0; @@ -372,7 +375,7 @@ BEGIN { # try to detect a lockfile (this isn't atomic but # should do for now - $lockfn = "$root/perl/cluster.lck"; # lock file name + $lockfn = "$root/local/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -424,29 +427,18 @@ print "There are $count user records and $err errors\n"; } my $ref = decode($val); if ($ref) { - my $t = $ref->{lastin} || 0; - if ($main::systime > $t + $tooold) { - unless ($ref->{lat} && $ref->{long} || $ref->{qth} || $ref->{qra}) { - eval {$dbm->del($key)}; - dbg(carp("Export Error2: $key\t$val\n$@")) if $@; - Log('DXCommand', "$ref->{call} deleted, too old"); - $del++; - next; - } - } - # only store users that are reasonably active or have useful information print $fh "$key\t" . $ref->encode . "\n"; ++$count; } else { - Log('DXCommand', "Export Error3: $key\t$val"); + Log('DXCommand', "Export Error2: $key\t$val"); eval {$dbm->del($key)}; - dbg(carp("Export Error3: $key\t$val\n$@")) if $@; + dbg(carp("Export Error2: $key\t$val\n$@")) if $@; ++$err; } } $fh->close; } - return "$count Users $del Deleted $err Errors ('sh/log Export' for details)"; + return "$count Users $err Errors ('sh/log Export' for details)"; } # @@ -603,11 +595,6 @@ sub wantsendpc16 return _want('sendpc16', @_); } -sub wantroutepc16 -{ - return _want('routepc16', @_); -} - sub wantlogininfo { my $self = shift; diff --git a/perl/QXProt.pm b/perl/QXProt.pm index b9cf952c..d12a6a4e 100644 --- a/perl/QXProt.pm +++ b/perl/QXProt.pm @@ -31,6 +31,11 @@ use Script; use DXProt; use Verify; +# sub modules +use QXProt::QXI; +use QXProt::QXP; +use QXProt::QXR; + use strict; use vars qw($VERSION $BRANCH); @@ -67,7 +72,7 @@ sub sendinit { my $self = shift; - $self->send($self->genI); + $self->send($self->QXI::gen); } sub normal @@ -76,8 +81,8 @@ sub normal DXProt::normal(@_); return; } - my ($sort, $tonode, $fromnode, $msgid, $incs); - return unless ($sort, $tonode, $fromnode, $msgid, $incs) = $_[1] =~ /^QX([A-Z])\^(\*|[-A-Z0-9]+)\^([-A-Z0-9]+)\^([0-9A-F]{1,4})\^.*\^([0-9A-F]{2})$/; + my ($sort, $tonode, $fromnode, $msgid, $line, $incs); + return unless ($sort, $tonode, $fromnode, $msgid, $line, $incs) = $_[1] =~ /^QX([A-Z])\^(\*|[-A-Z0-9]+)\^([-A-Z0-9]+)\^([0-9A-F]{1,4})\^(.*)\^([0-9A-F]{2})$/; $msgid = hex $msgid; my $noderef = Route::Node::get($fromnode); @@ -92,27 +97,11 @@ sub normal return unless $noderef->newid($msgid); - $_[0]->handle($sort, $tonode, $fromnode, $msgid, $_[1]); - return; -} - -sub handle -{ - no strict 'subs'; - my $self = shift; - my $sort = shift; - my $sub = "handle$sort"; - $self->$sub(@_) if $self->can($sub); - return; -} - -sub gen -{ - no strict 'subs'; - my $self = shift; - my $sort = shift; - my $sub = "gen$sort"; - $self->$sub(@_) if $self->can($sub); + { + no strict 'subs'; + my $sub = "QX${sort}::handle"; + $_[0]->$sub($tonode, $fromnode, $msgid, $line) if $_[0]->can($sub); + } return; } @@ -121,13 +110,37 @@ my $node_update_interval = 60*15; sub process { - if ($main::systime >= $last_node_update+$node_update_interval) { + + my $t = $main::systime; + + foreach my $dxchan (DXChannel->get_all()) { + next unless $dxchan->is_np; + next if $dxchan == $main::me; + + # send a ping out on this channel + if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) { + if ($dxchan->{nopings} <= 0) { + $dxchan->disconnect; + } else { + $dxchan->addping($main::mycall, $dxchan->call); + $dxchan->{nopings} -= 1; + $dxchan->{lastping} = $t; + } + } + } + + if ($t >= $last_node_update+$node_update_interval) { # sendallnodes(); # sendallusers(); $last_node_update = $main::systime; } } +sub adjust_hops +{ + return $_[1]; +} + sub disconnect { my $self = shift; @@ -138,6 +151,7 @@ my $msgid = 1; sub frame { + my $self = shift; my $sort = shift; my $to = shift || "*"; my $ht; @@ -149,98 +163,19 @@ sub frame return "$line^$cs"; } -sub handleI -{ - my $self = shift; - - my @f = split /\^/, $_[3]; - if ($self->passphrase && $f[7] && $f[8]) { - my $inv = Verify->new($f[7]); - unless ($inv->verify($f[8], $main::me->user->passphrase, $main::mycall, $self->call)) { - $self->sendnow('D','Sorry...'); - $self->disconnect; - } - $self->{verified} = 1; - } else { - $self->{verified} = 0; - } - if ($self->{outbound}) { - $self->send($self->genI); - } - if ($self->{sort} ne 'S' && $f[4] eq 'DXSpider') { - $self->{user}->{sort} = $self->{sort} = 'S'; - $self->{user}->{priv} = $self->{priv} = 1 unless $self->{priv}; - } - $self->{version} = $f[5]; - $self->{build} = $f[6]; - $self->state('init1'); - $self->{lastping} = 0; -} - -sub genI -{ - my $self = shift; - my @out = ('I', $self->call, "DXSpider", ($main::version + 53) * 100, $main::build); - if (my $pass = $self->user->passphrase) { - my $inp = Verify->new; - push @out, $inp->challenge, $inp->response($pass, $self->call, $main::mycall); - } - return frame(@out); -} - -sub handleR -{ - -} - -sub genR -{ - -} - -sub handleP +# add a ping request to the ping queues +sub addping { - + my ($self, $usercall, $to) = @_; + my $ref = $DXChannel::pings{$to} || []; + my $r = {}; + $r->{call} = $usercall; + $r->{t} = [ gettimeofday ]; + DXChannel::route(undef, $to, $self->QXP::gen($to, 1, $usercall, @{$r->{t}})); + push @$ref, $r; + $DXCHannel::pings{$to} = $ref; } -sub genP -{ - -} -sub gen2 -{ - my $self = shift; - - my $node = shift; - my $sort = shift; - my @out; - my $dxchan; - - while (@_) { - my $str = ''; - for (; @_ && length $str <= 230;) { - my $ref = shift; - my $call = $ref->call; - my $flag = 0; - - $flag += 1 if $ref->here; - $flag += 2 if $ref->conf; - if ($ref->is_node) { - my $ping = int($ref->pingave * 10); - $str .= "^N$flag$call,$ping"; - my $v = $ref->build || $ref->version; - $str .= ",$v" if defined $v; - } else { - $str .= "^U$flag$call"; - } - } - push @out, $str if $str; - } - my $n = @out; - my $h = get_hops(90); - @out = map { sprintf "PC90^%s^%X^%s%d%s^%s^", $node->call, $main::systime, $sort, --$n, $_, $h } @out; - return @out; -} 1; diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 0c2b2e4a..a3cded54 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -74,6 +74,7 @@ sub add return undef; } $self = $parent->new($call, @_); + $self->register; $parent->_addnode($self); return $self; } @@ -145,6 +146,7 @@ sub add_user @out = $uref->addparent($self); } else { $uref = Route::User->new($ucall, $self->{call}, @_); + $uref->register; @out = $uref; } $self->_adduser($uref); @@ -215,9 +217,6 @@ sub new { my $pkg = shift; my $call = uc shift; - - confess "already have $call in $pkg" if $list{$call}; - my $self = $pkg->SUPER::new($call); $self->{parent} = ref $pkg ? [ $pkg->{call} ] : [ ]; $self->{version} = shift; @@ -226,11 +225,16 @@ sub new $self->{nodes} = []; $self->{lid} = 0; - $list{$call} = $self; - return $self; } +sub register +{ + my $self = shift; + confess "already have $call in $pkg" if $list{$self->{call}}; + $list{$call} = $self; +} + sub get { my $call = shift; @@ -315,16 +319,16 @@ sub DESTROY sub AUTOLOAD { no strict; - my $name = $AUTOLOAD; + + my $self = shift; + $name = $AUTOLOAD; return if $name =~ /::DESTROY$/; - $name =~ s/^.*:://o; + $name =~ s/.*:://o; confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::valid{$name}; - # this clever line of code creates a subroutine which takes over from autoload - # from OO Perl - Conway - *$AUTOLOAD = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}}; - goto &$AUTOLOAD; + *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; + &$AUTOLOAD($self, @_); } 1; diff --git a/perl/Route/User.pm b/perl/Route/User.pm index b9862e6d..eb9958dc 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -49,16 +49,23 @@ sub new my $call = uc shift; my $ncall = uc shift; my $flags = shift; - confess "already have $call in $pkg" if $list{$call}; my $self = $pkg->SUPER::new($call); $self->{parent} = [ $ncall ]; $self->{flags} = $flags; - $list{$call} = $self; return $self; } +sub register +{ + my $self = shift; + + confess "already have $call in $pkg" if $list{$self->{call}}; + + $list{$call} = $self; +} + sub get_all { return values %list; @@ -104,17 +111,16 @@ sub delparent sub AUTOLOAD { no strict; - my ($pkg,$name) = $AUTOLOAD =~ /^(.*)::(\w+)$/; - return if $name eq 'DESTROY'; + + my $self = shift; + $name = $AUTOLOAD; + return if $name =~ /::DESTROY$/; + $name =~ s/.*:://o; confess "Non-existant field '$AUTOLOAD'" unless $valid{$name} || $Route::valid{$name}; - # this clever line of code creates a subroutine which takes over from autoload - # from OO Perl - Conway - *$AUTOLOAD = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}}; - goto &$AUTOLOAD; -# *{"${pkg}::$name"} = sub {$_[0]->{$name} = $_[1] if @_ > 1; return $_[0]->{$name}}; -# goto &{"${pkg}::$name"}; + *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; + &$AUTOLOAD($self, @_); } 1; diff --git a/perl/Thingy.pm b/perl/Thingy.pm new file mode 100644 index 00000000..36410e89 --- /dev/null +++ b/perl/Thingy.pm @@ -0,0 +1,84 @@ +# +# This module is part of the new structure of the cluster +# +# What happens when a sentence comes in is that it is sanity +# checked and then is converted into a Thingy. This Thingy is what +# is the passed around the system. +# +# Copyright (c) 2001 Dirk Koopman G1TLH +# +# $Id$ +# + +use strict; + +package Thingy; + +use DXDebug; + +use vars qw($VERSION $BRANCH %valid); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); +$main::build += $VERSION; +$main::branch += $BRANCH; + +%valid = ( + tonode => '0,To Node', + fromnode => '0,From Node', + fromchan => '0,DXChannel Ref', + pcline => '0,Original PC Line', + qxline => '0,Original QX Line', + hops => '0,Hops', + ); + +sub _valid +{ + my @pkg = split /::/, ref shift; + my $field = shift; + + # iterate down the packages looking for a 'valid' + no strict 'refs'; + while (@pkg >= 1) { + my $n = join('::'. @pkg, 'valid'); + my $r = $$n{$field}; + return $r if defined $r; + pop @pkg; + } + return undef; +} + +sub new +{ + my $pkg = shift; + my $self = bless {}, $pkg; + while (my ($k, $v) = each %{\@_}) { + confess "Non-existant field '$k'" unless $self->_valid($k); + $self->{lc $k} = $v; + } + return $self; +} + +sub AUTOLOAD +{ + my $self = shift; + no strict; + my $name = $AUTOLOAD; + return if $name =~ /::DESTROY$/; + $name =~ s/^.*:://o; + + confess "Non-existant field '$AUTOLOAD'" unless $self->_valid($name); + + *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; + &$AUTOLOAD($self, @_); +} + + + + + + + + + + +1; diff --git a/perl/Thingy/RouteUser.pm b/perl/Thingy/RouteUser.pm new file mode 100644 index 00000000..6a69f093 --- /dev/null +++ b/perl/Thingy/RouteUser.pm @@ -0,0 +1,90 @@ +package Thingy::RouteUser; + +use vars qw($VERSION $BRANCH %valid); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); +$main::build += $VERSION; +$main::branch += $BRANCH; + +%valid = ( + list => '0,List of Calls,parray', + new => '0,List of new Routes,parray', + ); + +sub add +{ + my $self = shift; + + my $dxchan = DXChannel->get($self->{fromdxchan}); + my $parent = Route::Node::get($self->{fromnode}); + + my @rout; + foreach my $r (@{$self->{list}}) { + + my $user; + if ($sort eq 'U') { + my $old = Route::User::get($r->call); + if ($old) { + if ($old->flags != $r->flags) { + $old->flags($r->flags); + push @rout, $r; + } + $old->addparent($parent); + } else { + $r->register; + $parent->add_user($r->call); + $r->add_parent($parent); + push @rout, $r; + } + + # add this station to the user database, if required + $call =~ s/-\d+$//o; # remove ssid for users + $user = DXUser->get_current($call) || DXUser->new($call); + $user->homenode($parent->call) unless $user->homenode; + $user->node($parent->call); + } elsif ($sort eq 'N') { + my $old = Route::Node::get($call); + if ($old) { + my $ar; + $ar = $parent->add($call, $ver, $flags); + push @rout, $ar if $ar; + } else { + next; + } + } + if ($r->version ne $ver || $r->flags != $flags) { + $r->version($ver); + $r->flags($flags); + push @rout, $r unless $ar; + } + } else { + if ($call eq $self->{call}) { + dbg("DXPROT: my channel route for $call has disappeared"); + next; + }; + + my $new = Route->new($call); # throw away + if ($dxchan->in_filter_route($new)) { + my $r = $parent->add($call, $ver, $flags); + push @rout, $r; + } else { + next; + } + } + + # add this station to the user database, if required (don't remove SSID from nodes) + my $user = DXUser->get_current($call); + unless ($user) { + $user = DXUser->new($call); + $user->sort('A'); + $user->priv(1); # I have relented and defaulted nodes + $user->lockout(1); + $user->homenode($call); + $user->node($call); + } + } + $user->lastin($main::systime) unless DXChannel->get($call); + $user->put; + } + $self->{new} = \@rout; +} diff --git a/perl/cluster.pl b/perl/cluster.pl index 5d102e4f..c1301b29 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -33,7 +33,7 @@ BEGIN { # try to create and lock a lockfile (this isn't atomic but # should do for now - $lockfn = "$root/perl/cluster.lck"; # lock file name + $lockfn = "$root/local/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -194,19 +194,14 @@ sub new_channel # create the channel if ($user->wantnp) { - if ($user->passphrase && $main::me->user->passphrase) { - $dxchan = QXProt->new($call, $conn, $user); - } else { - unless ($user->passphrase) { - Log('DXCommand', "$call using NP but has no passphrase"); - dbg("$call using NP but has no passphrase"); - } - unless ($main::me->user->passphrase) { - Log('DXCommand', "$main::mycall using NP but has no passphrase"); - dbg("$main::mycall using NP but has no passphrase"); - } - already_conn($conn, $call, "Need to exchange passphrases"); - return; + $dxchan = QXProt->new($call, $conn, $user); + unless ($user->passphrase) { + Log('DXCommand', "$call using NP but has no passphrase"); + dbg("$call using NP but has no passphrase"); + } + unless ($main::me->user->passphrase) { + Log('DXCommand', "$main::mycall using NP but has no passphrase"); + dbg("$main::mycall using NP but has no passphrase"); } } elsif ($user->is_node) { $dxchan = DXProt->new($call, $conn, $user); @@ -240,13 +235,6 @@ sub rec } } -# remove any outstanding entries on the inqueue after a disconnection (usually) -sub clean_inqueue -{ - my $dxchan = shift; - @inqueue = grep {$_->{dxchan} != $dxchan} @inqueue; -} - sub login { return \&new_channel; @@ -406,7 +394,7 @@ dbg("DXSpider Version $version, build $build started"); # load Prefixes dbg("loading prefixes ..."); -my $r = Prefix::init(); +my $r = Prefix::load(); confess $r if $r; dbg(USDB::init()); diff --git a/perl/create_sysop.pl b/perl/create_sysop.pl index fbfc7764..11673e31 100755 --- a/perl/create_sysop.pl +++ b/perl/create_sysop.pl @@ -75,7 +75,7 @@ sub create_it } -$lockfn = "$root/perl/cluster.lck"; # lock file name +$lockfn = "$root/local/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; diff --git a/perl/lock_nodes.pl b/perl/lock_nodes.pl index c80c6973..9480c481 100755 --- a/perl/lock_nodes.pl +++ b/perl/lock_nodes.pl @@ -26,7 +26,7 @@ BEGIN { use DXVars; use DXUser; -my $lockfn = "$root/perl/cluster.lck"; # lock file name +my $lockfn = "$root/local/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; diff --git a/perl/update_sysop.pl b/perl/update_sysop.pl index af128c94..d93e096b 100755 --- a/perl/update_sysop.pl +++ b/perl/update_sysop.pl @@ -82,7 +82,7 @@ sub create_it } -$lockfn = "$root/perl/cluster.lck"; # lock file name +$lockfn = "$root/local/cluster.lck"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; -- 2.34.1