From 2a43619b670b8f9249558f814b0183262c3ba4f6 Mon Sep 17 00:00:00 2001 From: minima Date: Sun, 26 Aug 2001 13:06:11 +0000 Subject: [PATCH] 1. make all newly learned nodes locked out by default. 2. add lock_nodes.pl which locks out all the nodes in the user file whose privilege is 1 or less and which isn't mentioned as an argument to the command on the command line. 3. make set/node, set/spider and their friends unlock a node as well as make them one. 4. Make sh/log et al more efficient / less memory hungry --- Changes | 8 +++++ cmd/set/arcluster.pl | 1 + cmd/set/clx.pl | 1 + cmd/set/dxnet.pl | 1 + cmd/set/node.pl | 1 + cmd/set/spider.pl | 1 + perl/DXLogPrint.pm | 46 ++++++++++++--------------- perl/DXProt.pm | 6 ++-- perl/lock_nodes.pl | 76 ++++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 113 insertions(+), 28 deletions(-) create mode 100755 perl/lock_nodes.pl diff --git a/Changes b/Changes index ea6a1c7a..3b4d5d57 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,11 @@ +26Aug01======================================================================= +1. make all newly learned nodes locked out by default. +2. add lock_nodes.pl which locks out all the nodes in the user file whose +privilege is 1 or less and which isn't mentioned as an argument to the +command on the command line. +3. make set/node, set/spider and their friends unlock a node as well as make +them one. +4. Make sh/log et al more efficient / less memory hungry 24Aug01======================================================================= 1. Allow badmsg to reject on interface callsign ('I') 20Aug01======================================================================= diff --git a/cmd/set/arcluster.pl b/cmd/set/arcluster.pl index 9378a173..4e1dd452 100644 --- a/cmd/set/arcluster.pl +++ b/cmd/set/arcluster.pl @@ -29,6 +29,7 @@ foreach $call (@args) { if ($user) { $user->sort('R'); $user->homenode($call); + $user->lockout(0); $user->priv(1) unless $user->priv; $user->close(); push @out, $self->msg($create ? 'noderc' : 'noder', $call); diff --git a/cmd/set/clx.pl b/cmd/set/clx.pl index ba38b826..f453e41f 100644 --- a/cmd/set/clx.pl +++ b/cmd/set/clx.pl @@ -29,6 +29,7 @@ foreach $call (@args) { if ($user) { $user->sort('C'); $user->homenode($call); + $user->lockout(0); $user->priv(1) unless $user->priv; $user->close(); push @out, $self->msg($create ? 'nodecc' : 'nodec', $call); diff --git a/cmd/set/dxnet.pl b/cmd/set/dxnet.pl index 28c497cc..f8e3686f 100644 --- a/cmd/set/dxnet.pl +++ b/cmd/set/dxnet.pl @@ -29,6 +29,7 @@ foreach $call (@args) { if ($user) { $user->sort('X'); $user->homenode($call); + $user->lockout(0); $user->priv(1) unless $user->priv; $user->close(); push @out, $self->msg($create ? 'nodexc' : 'nodex', $call); diff --git a/cmd/set/node.pl b/cmd/set/node.pl index 5c9b00fa..4eeae7f1 100644 --- a/cmd/set/node.pl +++ b/cmd/set/node.pl @@ -29,6 +29,7 @@ foreach $call (@args) { if ($user) { $user->sort('A'); $user->homenode($call); + $user->lockout(0); $user->priv(1) unless $user->priv; $user->close(); push @out, $self->msg($create ? 'nodeac' : 'nodea', $call); diff --git a/cmd/set/spider.pl b/cmd/set/spider.pl index 946d92d2..7bd3e6a6 100644 --- a/cmd/set/spider.pl +++ b/cmd/set/spider.pl @@ -29,6 +29,7 @@ foreach $call (@args) { if ($user) { $user->sort('S'); $user->homenode($call); + $user->lockout(0); $user->priv(1) unless $user->priv; $user->close(); push @out, $self->msg($create ? 'nodesc' : 'nodes', $call); diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm index c2434aba..153f8f06 100644 --- a/perl/DXLogPrint.pm +++ b/perl/DXLogPrint.pm @@ -25,8 +25,9 @@ use strict; sub print { my $fcb = $DXLog::log; - my $from = shift; - my $to = shift; + my $from = shift || 0; + my $to = shift || 20; + my $count; my $jdate = $fcb->unixtoj(shift); my $pattern = shift; my $who = uc shift; @@ -34,54 +35,47 @@ sub print my @in; my @out = (); my $eval; - my $count; + my $tot = $from + $to; my $hint = ""; if ($pattern) { - $search = "\$ref->[1] =~ m{^$pattern}i"; - $hint = "m{$pattern}i"; + $hint = "m{\\Q$pattern\\E}i"; } if ($who) { - if ($search) { - $search .= ' && '; + if ($hint) { $hint .= ' && '; } - $search .= "(\$ref->[2] =~ m{$who}i || \$ref->[3] =~ m{$who}i)"; - $hint .= 'm{$who}i'; + $hint .= 'm{\\Q$who\\E}i'; } $hint = "next unless $hint" if $hint; - $search = "1" unless $search; $eval = qq( \@in = (); while (<\$fh>) { $hint; chomp; - \$ref = [ split '\\^' ]; - push \@\$ref, "" unless \@\$ref >= 4; - push \@in, \$ref; + push \@in, \$_; + shift \@in, if \@in > $tot; } - my \$c; - for (\$c = \$#in; \$c >= 0; \$c--) { - \$ref = \$in[\$c]; - if ($search) { - \$count++; - next if \$count < $from; - unshift \@out, print_item(\$ref); - last if \$count >= \$to; # stop after n - } - } - ); + ); $fcb->close; # close any open files my $fh = $fcb->open($jdate); - for ($count = 0; $count < $to; ) { + L1: for ($count = 0; $count < $to; ) { my $ref; if ($fh) { eval $eval; # do the search on this file - last if $count >= $to; # stop after n return ("Log search error", $@) if $@; + my @tmp; + while (@in) { + last L1 if $count >= $to; + my $ref = [ split /\^/, shift @in ]; + next if defined $pattern && $ref->[1] ne $pattern; + push @tmp, print_item($ref); + $count++; + } + @out = (@tmp, @out); } $fh = $fcb->openprev(); # get the next file last if !$fh; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index ab1e7572..4b96fe96 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -213,7 +213,9 @@ sub start # remember type of connection $self->{consort} = $line; $self->{outbound} = $sort eq 'O'; - $self->{priv} = $user->priv || 1; # other clusters can always be 'normal' users + my $priv = $user->priv; + $priv = $user->priv(1) unless $priv; + $self->{priv} = $priv; # other clusters can always be 'normal' users $self->{lang} = $user->lang || 'en'; $self->{isolate} = $user->{isolate}; $self->{consort} = $line; # save the connection type @@ -716,7 +718,7 @@ sub normal $user = DXUser->new($call); $user->sort('A'); $user->priv(1); # I have relented and defaulted nodes - $self->{priv} = 1; # to user RCMDs allowed + $user->lockout(1); $user->homenode($call); $user->node($call); } diff --git a/perl/lock_nodes.pl b/perl/lock_nodes.pl new file mode 100755 index 00000000..8f4875e7 --- /dev/null +++ b/perl/lock_nodes.pl @@ -0,0 +1,76 @@ +#!/usr/bin/perl +# +# remove all records with the sysop/cluster callsign and recreate +# it from the information contained in DXVars +# +# WARNING - this must be run when the cluster.pl is down! +# +# This WILL NOT delete an old sysop call if you are simply +# changing the callsign. +# +# Copyright (c) 1998 Dirk Koopman G1TLH +# +# $Id$ +# + +# make sure that modules are searched in the order local then perl + +BEGIN { + # root of directory tree for this system + $root = "/spider"; + $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; + + unshift @INC, "$root/local"; +} + +use DXVars; +use DXUser; + +my $lockfn = "$root/perl/cluster.lck"; # lock file name +if (-e $lockfn) { + open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; + my $pid = ; + chomp $pid; + die "Sorry, Lockfile ($lockfn) and process $pid exist, a cluster is running\n" if kill 0, $pid; + close CLLOCK; +} + +my @nodes = map { uc } @ARGV; + +DXUser->init($userfn, 1); + +my $count; +my $nodes; +my @ignore; +my ($action, $key, $data) = (0,0,0); +for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) { + if ($data =~ m{sort => '[ACRSX]'}) { + my $user = DXUser->get($key); + if ($user->is_node) { + $nodes ++; + if (grep $key eq $_, (@nodes, $mycall)) { + push @ignore, $key; + next; + } + my $priv = $user->priv; + if ($priv > 1) { + push @ignore, $key; + next; + } + $user->priv(1) unless $priv; + $user->lockout(1); + $user->put; + $count++; + } + } +} + +print "locked out $count nodes out of $nodes\n"; +print scalar @ignore, " nodes ignored (", join(',', @ignore), ")\n"; +print "If there are any nodes missing on the above list then you MUST do\n"; +print "a set/node (set/spider, set/clx etc) on each of them to allow them\n"; +print "to connect to you or you to them\n"; + +DXUser->finish(); +exit(0); + -- 2.34.1