From ca828d0e2a21d9a6540361ca4878df71f125e120 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Tue, 19 May 2020 16:07:12 +0100 Subject: [PATCH] Fix all the DXUser API changes to use JSON --- Changes | 4 + cmd/crontab | 1 + cmd/forward/latlong.pl | 2 + cmd/nospawn.pl | 4 +- cmd/show/dxuser_stats.pl | 20 +++++ cmd/show/isolate.pl | 31 ++++---- cmd/show/lockout.pl | 114 ++++++++++++++++++----------- cmd/show/node.pl | 153 +++++++++++++++++++++++---------------- cmd/show/registered.pl | 42 ++++++++--- perl/DXUser.pm | 125 ++++++++++++++++++++++---------- perl/cluster.pl | 2 - perl/create_sysop.pl | 14 ++-- perl/lock_nodes.pl | 47 +++++++----- perl/update_sysop.pl | 6 +- 14 files changed, 362 insertions(+), 203 deletions(-) create mode 100644 cmd/show/dxuser_stats.pl diff --git a/Changes b/Changes index 38bc71a3..445b8c3f 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,7 @@ +19May20======================================================================= +1. Convert all remaining commands and areas within the program that used the + DB_File/Storable interface to DXUsers.pm to use the (hopefully) more stable + JSON text file + caching interface. Here's hoping. 16May20======================================================================= 1. Crontab can now spawn_cmd('export_users') - very safely. 15May20======================================================================= diff --git a/cmd/crontab b/cmd/crontab index e569ed31..e864a17e 100644 --- a/cmd/crontab +++ b/cmd/crontab @@ -8,3 +8,4 @@ 2 0 * * * DXDebug::dbgclean() 30 2 * * 3 spawn_cmd("export_users") 0 3 * * * Spot::daily() +13,43 * * * spawn_cmd('saveuserfile') diff --git a/cmd/forward/latlong.pl b/cmd/forward/latlong.pl index e9afd710..951b5d56 100644 --- a/cmd/forward/latlong.pl +++ b/cmd/forward/latlong.pl @@ -11,6 +11,8 @@ my ($self, $line) = @_; return (1, $self->msg('e5')) unless $self->priv >= 6; +return (1, "I can't image why you want to use this command other than as a DoS attack", "DO NOT USE!!!"); + my @dxchan; my @out; my $dxchan; diff --git a/cmd/nospawn.pl b/cmd/nospawn.pl index ad81feb6..ab47bb7d 100644 --- a/cmd/nospawn.pl +++ b/cmd/nospawn.pl @@ -1,8 +1,6 @@ #!/usr/bin/perl # -# pretend that you are another user, useful for reseting -# those silly things that people insist on getting wrong -# like set/homenode et al +# Useful for debugging. Make sure that the command runs in foreground # # Copyright (c) 1999 Dirk Koopman G1TLH # diff --git a/cmd/show/dxuser_stats.pl b/cmd/show/dxuser_stats.pl new file mode 100644 index 00000000..2a544777 --- /dev/null +++ b/cmd/show/dxuser_stats.pl @@ -0,0 +1,20 @@ +# +# show the state of the DXUser statistics +# +# Copyright (c) 2020 Dirk Koopman G1TLH +# +my $self = shift; + +if ($self->priv < 9) { + return (1, $self->msg('e5')); +} + +my @out; + +push @out, " New Users: $DXUser::newusers"; +push @out, " Modified Users: $DXUser::modusers"; +push @out, " Total Users: $DXUser::totusers"; +push @out, " Deleted Users: $DXUser::delusers"; +push @out, " Cached Users: $DXUser::cachedusers"; + +return (1, @out); diff --git a/cmd/show/isolate.pl b/cmd/show/isolate.pl index cefae9dc..c16515a3 100644 --- a/cmd/show/isolate.pl +++ b/cmd/show/isolate.pl @@ -8,8 +8,6 @@ # # -use DB_File; - sub handle { my ($self, $line) = @_; @@ -31,18 +29,25 @@ sub generate my @out; my @val; - my ($action, $count, $key, $data) = (0,0,0,0); - - for ($action = DXUser::R_FIRST, $count=0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) { - if ($data =~ m{isolate}) { - my $u = DXUser::get_current($key); - if ($u && $u->isolate) { - push @val, $key; - ++$count; - } - } - } +# my ($action, $count, $key, $data) = (0,0,0,0); +# +# for ($action = DXUser::R_FIRST, $count=0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) { +# if ($data =~ m{isolate}) { +# my $u = DXUser::get_current($key); +# if ($u && $u->isolate) { +# push @val, $key; +# ++$count; +# } +# } +# } + @val = DXUser::scan(sub { + my $k = shift; + my $l = shift; + # cheat, don't decode because we can easily pull it out from the json test + return $l =~ m{"isolate":1} ? $k : (); + }); + my $count = @val; my @l; foreach my $call (@val) { if (@l >= 5) { diff --git a/cmd/show/lockout.pl b/cmd/show/lockout.pl index e97b4bcf..acfb2b09 100644 --- a/cmd/show/lockout.pl +++ b/cmd/show/lockout.pl @@ -8,55 +8,83 @@ # # -my ($self, $line) = @_; -return (1, $self->msg('e5')) unless $self->priv >= 9; +sub handle +{ + my ($self, $line) = @_; + return (1, $self->msg('e5')) unless $self->priv >= 9; -my @out; + my @out; -use DB_File; + if ($line) { + $line =~ s/[^\w\-\/]+//g; + $line = "\U\Q$line"; + } -if ($line) { - $line =~ s/[^\w\-\/]+//g; - $line = "\U\Q$line"; + if ($self->{_nospawn}) { + @out = generate($self, $line); + } else { + @out = $self->spawn_cmd("show/lockout $line", sub { return (generate($self, $line)); }); + } + return (1, $self->msg('lockoutuse')) unless $line; } -return (1, $self->msg('lockoutuse')) unless $line; - -@out = $self->spawn_cmd("show lockout $line", sub { - my @out; - my @val; - my ($action, $count, $key, $data) = (0,0,0,0); - eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) { - if (\$data =~ m{lockout}) { - if (\$line eq 'ALL' || \$key =~ /^$line/) { - my \$ur = DXUser::get_current(\$key); - if (\$ur && \$ur->lockout) { - push \@val, \$key; - ++\$count; - } + +sub generate +{ + my $self = shift; + my $line = shift; + my @out; + my @val; + # my ($action, $count, $key, $data) = (0,0,0,0); + # eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) { + # if (\$data =~ m{lockout}) { + # if (\$line eq 'ALL' || \$key =~ /^$line/) { + # my \$ur = DXUser::get_current(\$key); + # if (\$ur && \$ur->lockout) { + # push \@val, \$key; + # ++\$count; + # } + # } + # } + +# $DB::single = 1; + + my @val; + if ($line eq 'ALL') { + @val = DXUser::scan(sub { + my $k = shift; + my $l = shift; + # cheat, don't decode because we can easily pull it out from the json test + return $l =~ m{"lockout":1} ? $k : (); + }); + + } else { + for my $call (split /\s+/, $line) { + my $l = DXUser::get($call, 1); + next unless $l; + next unless $l =~ m{"lockout":1}; + push @val, $call; + } + } + + my $count = @val; + my @l; + foreach my $call (@val) { + if (@l >= 5) { + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; + @l = (); } + push @l, $call; + } + if (@l) { + push @l, "" while @l < 5; + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; } -} }; - - my @l; - foreach my $call (@val) { - if (@l >= 5) { - push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; - @l = (); - } - push @l, $call; - } - if (@l) { - push @l, "" while @l < 5; - push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; - } - - push @out, $@ if $@; - push @out, $self->msg('rec', $count); - return @out; - }); - - -return (1, @out); + + push @out, $@ if $@; + push @out, $self->msg('rec', $count); + return @out; +} + diff --git a/cmd/show/node.pl b/cmd/show/node.pl index b41cd93f..4e03f4ba 100644 --- a/cmd/show/node.pl +++ b/cmd/show/node.pl @@ -9,82 +9,109 @@ # # A special millenium treat just for G4PDQ # -# Copyright (c) 2000 Dirk Koopman G1TLH +# Copyright (c) 2000-2020 Dirk Koopman G1TLH # # # -my ($self, $line) = @_; -return (1, $self->msg('e5')) unless $self->priv >= 1; -return (1, $self->msg('storable')) unless $DXUser::v3; - -my @call = map {uc $_} split /\s+/, $line; -my @out; -my $count; - -# search thru the user for nodes -if (@call == 0) { - @call = map {$_->call} DXChannel::get_all_nodes(); -} elsif ($call[0] eq 'ALL') { - shift @call; - 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{\01[ACRSX]\0\0\0\04sort}) { - push @call, $key; - ++$count; - } +sub handle +{ + my ($self, $line) = @_; + return (1, $self->msg('e5')) unless $self->priv >= 1; + my @out; + + my @call = map {uc $_} split /\s+/, $line; + if ($self->{_nospawn}) { + @out = generate($self, @call); + } else { + @out = $self->spawn_cmd("show/nodes $line", sub { return (generate($self, @call)); }); } + return (1, @out); } -my $call; -foreach $call (sort @call) { - my $clref = Route::Node::get($call); - my $uref = DXUser::get_current($call); - my ($sort, $ver, $build); - - my $pcall = sprintf "%-11s", $call; - push @out, $self->msg('snode1') unless @out > 0; - if ($uref) { - $sort = "Spider" if $uref->is_spider || ($clref && $clref->do_pc9x); - $sort = "Clx " if $uref->is_clx; - $sort = "User " if $uref->is_user; - $sort = "BBS " if $uref->is_bbs; - $sort = "DXNet " if $uref->is_dxnet; - $sort = "ARClus" if $uref->is_arcluster; - $sort = "AK1A " if !$sort && $uref->is_ak1a; - $sort = "Unknwn" unless $sort; - } else { - push @out, $self->msg('snode3', $call); - next; +sub generate +{ + my $self = shift; + my @call = @_; + my @out; + my $count; + + # search thru the user for nodes + if (@call == 0) { + @call = map {$_->call} DXChannel::get_all_nodes(); } - $ver = ""; - $build = ""; - if ($call eq $main::mycall) { - $sort = "Spider"; - $ver = $main::version; - } else { - $ver = $clref->version if $clref && $clref->version; - $ver = $uref->version if !$ver && $uref->version; - $sort = "CCClus" if $ver >= 1000 && $ver < 4000 && $sort eq "Spider"; + elsif ($call[0] eq 'ALL') { + shift @call; + # 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{\01[ACRSX]\0\0\0\04sort}) { + # push @call, $key; + # ++$count; + # } + # } + + push @call, DXUser::scan(sub { + my $k = shift; + my $l = shift; + # cheat, don't decode because we can easily pull it out from the json test + return $l =~ m{"sort":"[ACRSX]"} ? $k : (); + }); } + + my $call; + foreach $call (sort @call) { + my $clref = Route::Node::get($call); + my $l = DXUser::get($call, 1); + next unless $l; + my $uref = DXUser::json_decode($l); + next unless $uref; + my ($sort, $ver, $build); - if ($uref->is_spider || ($clref && $clref->do_pc9x)) { - $ver /= 100 if $ver > 5400; - $ver -= 53 if $ver > 54; - if ($clref && $clref->build) { - $build = "build: " . $clref->build - } elsif ($uref->build) { - $build = "build: " . $uref->build; + my $pcall = sprintf "%-11s", $call; + push @out, $self->msg('snode1') unless @out > 0; + if ($uref) { + $sort = "Spider" if $uref->is_spider || ($clref && $clref->do_pc9x); + $sort = "Clx " if $uref->is_clx; + $sort = "User " if $uref->is_user; + $sort = "BBS " if $uref->is_bbs; + $sort = "DXNet " if $uref->is_dxnet; + $sort = "ARClus" if $uref->is_arcluster; + $sort = "AK1A " if !$sort && $uref->is_ak1a; + $sort = "Unknwn" unless $sort; + } else { + push @out, $self->msg('snode3', $call); + next; } - push @out, $self->msg('snode2', $pcall, $sort, "$ver $build"); - } else { - my ($major, $minor, $subs) = unpack("AAA*", $ver) if $ver; - push @out, $self->msg('snode2', $pcall, $sort, $ver ? "$major\-$minor.$subs" : " "); + $ver = ""; + $build = ""; + if ($call eq $main::mycall) { + $sort = "Spider"; + $ver = $main::version; + } else { + $ver = $clref->version if $clref && $clref->version; + $ver = $uref->version if !$ver && $uref->version; + $sort = "CCClus" if $ver >= 1000 && $ver < 4000 && $sort eq "Spider"; + } + + if ($uref->is_spider || ($clref && $clref->do_pc9x)) { + $ver /= 100 if $ver > 5400; + $ver -= 53 if $ver > 54; + if ($clref && $clref->build) { + $build = "build: " . $clref->build + } + elsif ($uref->build) { + $build = "build: " . $uref->build; + } + push @out, $self->msg('snode2', $pcall, $sort, "$ver $build"); + } else { + my ($major, $minor, $subs) = unpack("AAA*", $ver) if $ver; + push @out, $self->msg('snode2', $pcall, $sort, $ver ? "$major\-$minor.$subs" : " "); + } + ++$count; } - ++$count; -} -return (1, @out, $self->msg('rec', $count)); + return (1, @out, $self->msg('rec', $count)); +} diff --git a/cmd/show/registered.pl b/cmd/show/registered.pl index b3f345d9..9310bd7c 100644 --- a/cmd/show/registered.pl +++ b/cmd/show/registered.pl @@ -11,15 +11,14 @@ sub handle { my ($self, $line) = @_; + return (1, $self->msg('e5')) unless $self->priv >= 9; my @out; - use DB_File; - if ($line) { $line =~ s/[^\w\-\/]+//g; - $line = "^\U\Q$line"; + $line = "\U\Q$line"; } if ($self->{_nospawn}) { @@ -40,18 +39,37 @@ sub generate my ($action, $count, $key, $data) = (0,0,0,0); - eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) { - if (\$data =~ m{registered}) { - if (!\$line || (\$line && \$key =~ /^$line/)) { - my \$u = DXUser::get_current(\$key); - if (\$u && \$u->registered) { - push \@val, \$key; - ++\$count; - } +# eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) { +# if (\$data =~ m{registered}) { +# if (!\$line || (\$line && \$key =~ /^$line/)) { +# my \$u = DXUser::get_current(\$key); +# if (\$u && \$u->registered) { +# push \@val, \$key; +# ++\$count; +# } +# } +# } + #} }; + my $count; + my @val; + if ($line eq 'ALL') { + @val = DXUser::scan(sub { + my $k = shift; + my $l = shift; + # cheat, don't decode because we can easily pull it out from the json test + return $l =~ m{"registered":1} ? $k : (); + }); + } else { + for my $call (split /\s+/, $line) { + my $l = DXUser::get($call, 1); + next unless $l; + next unless $l =~ m{"registered":1}; + push @val, $call; } } -} }; + my @l; + $count = @val; foreach my $call (@val) { if (@l >= 5) { push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; diff --git a/perl/DXUser.pm b/perl/DXUser.pm index d7c6a1ae..d9c37020 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -75,10 +75,9 @@ use IO::File; use strict; -use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold $v3 $v4); +use vars qw(%u $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold $v3 $v4); %u = (); -$dbm = undef; $filename = undef; $lastoperinterval = 60*24*60*60; $lasttime = 0; @@ -90,10 +89,11 @@ my $json; our $maxconnlist = 3; # remember this many connection time (duration) [start, end] pairs -our $newusers; # per execution stats -our $modusers; -our $totusers; -our $delusers; +our $newusers = 0; # per execution stats +our $modusers = 0; +our $totusers = 0; +our $delusers = 0; +our $cachedusers = 0; my $ifh; # the input file, initialised by readinjson() @@ -193,9 +193,9 @@ sub init my $fn = "users"; $json = JSON->new()->canonical(1); - $filename = $ufn = localdata("$fn.json"); + $filename = $ufn = localdata("$fn.v4"); - if (-e localdata("$fn.json")) { + if (-e localdata("$fn.v4")) { $v4 = 1; } else { eval { @@ -221,7 +221,7 @@ sub init my $ta = [gettimeofday]; my %oldu; - LogDbg('',"Converting the User File from V$convert to $fn.json "); + LogDbg('',"Converting the User File from V$convert to $fn.v4 "); LogDbg('',"This will take a while, I suggest you go and have cup of strong tea"); my $odbm = tie (%oldu, 'DB_File', localdata("users.v$convert"), O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v$convert ($!) [rebuild it from user_asc?]"; for ($action = R_FIRST; !$odbm->seq($key, $val, $action); $action = R_NEXT) { @@ -245,14 +245,14 @@ sub init undef $odbm; untie %oldu; my $t = _diffms($ta); - LogDbg('',"Conversion from users.v$convert to users.json completed $count records $err errors $t mS"); + LogDbg('',"Conversion from users.v$convert to users.v4 completed $count records $err errors $t mS"); # now write it away for future use $ta = [gettimeofday]; $err = 0; $count = writeoutjson(); $t = _diffms($ta); - LogDbg('',"New Userfile users.json write completed $count records $err errors $t mS"); + LogDbg('',"New Userfile users.v4 write completed $count records $err errors $t mS"); LogDbg('',"Now restarting.."); $main::ending = 10; } else { @@ -292,8 +292,8 @@ sub process sub finish { - undef $dbm; - untie %u; + + writeoutjson(); } # @@ -314,9 +314,10 @@ sub new my $call = shift; # $call =~ s/-\d+$//o; -# confess "can't create existing call $call in User\n!" if $u{$call}; + confess "can't create existing call $call in User\n!" if $u{$call}; my $self = $pkg->alloc($call); + $u{$call} = [0, $self]; $self->put; ++$newusers; ++$totusers; @@ -344,6 +345,7 @@ sub get my $j = json_decode($s); if ($j) { $ref->[1] = $j; + ++$cachedusers; } } } elsif ($nodecode) { @@ -359,44 +361,61 @@ sub get # This is not as quick as get()! But it will allow safe querying of the # user file. Probably in conjunction with get_some_calls feeding it. # -# Probably need to create a new copy of any existing records WIP +# NOTE: for cached records this, in effect, is a faster version of Storable's +# dclone - only about 3.5 times as fast! +# sub get_tmp { my $call = uc shift; - my $ref = $u{call}; + my $ref = $u{$call}; if ($ref) { + if ($ref->[1]) { + return json_decode(json_encode($ref->[1])); + } $ifh->seek($ref->[0], 0); my $l = $ifh->getline; if ($l) { my ($k,$s) = split /\t/, $l; my $j = json_decode($s); - return $; + return $j; } } return undef; } # -# get an existing either from the channel (if there is one) or from the database +# Master branch: +# get an existing record either from the channel (if there is one) or from the database # # It is important to note that if you have done a get (for the channel say) and you # want access or modify that you must use this call (and you must NOT use get's all # over the place willy nilly!) # +# NOTE: mojo branch with newusers system: +# There is no longer any function difference between get_current() +# and get() as they will always reference the same record as held in %u. This is because +# there is no more (repeated) thawing of stored records from the underlying "database". +# +# BUT: notice the difference between this and the get_tmp() function. A get() will online an +# othewise unused record, so for poking around looking for that locked out user: +# MAKE SURE you use get_tmp(). It will likely still be quicker than DB_File and Storable! +# sub get_current { - my $call = uc shift; - - my $dxchan = DXChannel::get($call); - if ($dxchan) { - my $ref = $dxchan->user; - return $ref if $ref && UNIVERSAL::isa($ref, 'DXUser'); - - dbg("DXUser::get_current: got invalid user ref for $call from dxchan $dxchan->{call} ". ref $ref. " ignoring"); - } - return get($call); + goto &get; + +# my $call = uc shift; +# +# my $dxchan = DXChannel::get($call); +# if ($dxchan) { +# my $ref = $dxchan->user; +# return $ref if $ref && UNIVERSAL::isa($ref, 'DXUser'); +# +# dbg("DXUser::get_current: got invalid user ref for $call from dxchan $dxchan->{call} ". ref $ref. " ignoring"); +# } +# return get($call); } # @@ -417,7 +436,40 @@ sub get_some_calls my $pattern = shift || qr/.*/; return sort grep {$pattern} keys %u; } + +# +# if I understand the term correctly, this is a sort of monad. +# +# Scan through the whole user file and select records that you want +# to process further. This routine returns lines of json, yu +# +# the CODE ref should look like: +# sub { +# my $key = shift; +# my $line = shift; +# # maybe do a rough check to see if this is a likely candidate +# return unless $line =~ /something/; +# my $r = json_decode($l); +# return (condition ? wanted thing : ()); +# } +# + +sub scan +{ + my $c = shift; + my @out; + if (ref($c) eq 'CODE') { + foreach my $k (get_all_calls()) { + my $l = get($k, 1); # get the offline json line or the jsoned online version + push @out, $c->($k, $l) if $l; + } + } else { + dbg("DXUser::scan supplied argument is not a code ref"); + } + return @out; +} + # # put - put a user # @@ -502,10 +554,9 @@ sub del { my $self = shift; my $call = $self->{call}; -# $lru->remove($call); - # $dbm->del($call); ++$delusers; --$totusers; + --$cachedusers if $u{$call}->[1]; delete $u{$call}; } @@ -520,10 +571,6 @@ sub close my $ip = shift; $self->{lastin} = $main::systime; # add a record to the connect list - my $ref = [$startt || $self->{startt}, $main::systime]; - push @$ref, $ip if $ip; - push @{$self->{connlist}}, $ref; - shift @{$self->{connlist}} if @{$self->{connlist}} > $maxconnlist; # $self->put(); } @@ -875,12 +922,14 @@ sub unset_passwd { my $self = shift; delete $self->{passwd}; + $self->put; } sub unset_passphrase { my $self = shift; delete $self->{passphrase}; + $self->put; } sub set_believe @@ -888,7 +937,10 @@ sub set_believe my $self = shift; my $call = uc shift; $self->{believe} ||= []; - push @{$self->{believe}}, $call unless grep $_ eq $call, @{$self->{believe}}; + unless (grep $_ eq $call, @{$self->{believe}}) { + push @{$self->{believe}}, $call; + $self->put; + }; } sub unset_believe @@ -898,6 +950,7 @@ sub unset_believe if (exists $self->{believe}) { $self->{believe} = [grep {$_ ne $call} @{$self->{believe}}]; delete $self->{believe} unless @{$self->{believe}}; + $self->put; } } @@ -923,8 +976,6 @@ sub lastping # a later (generated) copy. But, if the plain users.v4 file is all we have, we'll use that. # -use File::Copy; - sub readinjson { my $fn = $filename; diff --git a/perl/cluster.pl b/perl/cluster.pl index b7f201bd..7492368a 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -380,8 +380,6 @@ sub cease $SIG{'INT'} = 'IGNORE'; } - DXUser::sync; - DXUser::writeoutjson; if (defined &Local::finish) { eval { diff --git a/perl/create_sysop.pl b/perl/create_sysop.pl index 99f3e060..7cc0335f 100755 --- a/perl/create_sysop.pl +++ b/perl/create_sysop.pl @@ -51,7 +51,7 @@ sub create_it $self->{annok} = 1; # write it away - $self->close(); + $self->put(); # now do one for the alias $ref = DXUser::get(uc $myalias); @@ -75,7 +75,7 @@ sub create_it $self->{group} = [qw(local #9000)]; # write it away - $self->close(); + $self->put(); } @@ -90,26 +90,26 @@ if (-e $lockfn) { close CLLOCK; } -$DXUser::v3 = 1; +$DXUser::v4 = 1; -if (-e "$userfn.v2" || -e "$userfn.v3") { +if (-e localdata("users.v4")) { print "Do you wish to destroy your user database (THINK!!!) [y/N]: "; $ans = ; if ($ans =~ /^[Yy]/) { delete_it(); - DXUser::init(1); + DXUser::init(4); create_it(); } else { print "Do you wish to reset your cluster and sysop information? [y/N]: "; $ans = ; if ($ans =~ /^[Yy]/) { - DXUser::init(1); + DXUser::init(4); create_it(); } } } else { - DXUser::init(1); + DXUser::init(4); create_it(); } DXUser::finish(); diff --git a/perl/lock_nodes.pl b/perl/lock_nodes.pl index 2443e48b..c9dcbc9e 100755 --- a/perl/lock_nodes.pl +++ b/perl/lock_nodes.pl @@ -34,33 +34,40 @@ if (-e $lockfn) { my @nodes = map { uc } @ARGV; -DXUser::init(1); +DXUser::init(4); 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++; + +my @calls = scan(sub + { + my $k = shift; + return $_[0] =~ m{"sort":"[ACRSX]"} ? $k : (); + }); + +foreach my $key (@calls) { + 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++; } } } +DXUser::sync; +DXUser::writeoutjson; print "locked out $count nodes out of $nodes\n"; print scalar @ignore, " nodes ignored (", join(',', @ignore), ")\n"; diff --git a/perl/update_sysop.pl b/perl/update_sysop.pl index 74d6812a..c77d012c 100755 --- a/perl/update_sysop.pl +++ b/perl/update_sysop.pl @@ -54,7 +54,7 @@ sub create_it $self->{annok} = 1; # write it away - $self->close(); + $self->put(); print "new call $mycall added\n"; # now do one for the alias @@ -81,7 +81,7 @@ sub create_it $self->{group} = [qw(local #9000)]; # write it away - $self->close(); + $self->put(); print "new call $myalias added\n"; } @@ -97,7 +97,7 @@ if (-e $lockfn) { close CLLOCK; } -DXUser::init(1); +DXUser::init(4); create_it(); DXUser::finish(); print "Update of $myalias on cluster $mycall successful\n"; -- 2.43.0