+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=======================================================================
2 0 * * * DXDebug::dbgclean()
30 2 * * 3 spawn_cmd("export_users")
0 3 * * * Spot::daily()
+13,43 * * * spawn_cmd('saveuserfile')
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;
#!/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
#
--- /dev/null
+#
+# 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);
#
#
-use DB_File;
-
sub handle
{
my ($self, $line) = @_;
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) {
#
#
-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;
+}
+
#
# 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));
+}
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}) {
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;
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;
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()
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 {
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) {
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 {
sub finish
{
- undef $dbm;
- untie %u;
+
+ writeoutjson();
}
#
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;
my $j = json_decode($s);
if ($j) {
$ref->[1] = $j;
+ ++$cachedusers;
}
}
} elsif ($nodecode) {
# 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);
}
#
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
#
{
my $self = shift;
my $call = $self->{call};
-# $lru->remove($call);
- # $dbm->del($call);
++$delusers;
--$totusers;
+ --$cachedusers if $u{$call}->[1];
delete $u{$call};
}
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();
}
{
my $self = shift;
delete $self->{passwd};
+ $self->put;
}
sub unset_passphrase
{
my $self = shift;
delete $self->{passphrase};
+ $self->put;
}
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
if (exists $self->{believe}) {
$self->{believe} = [grep {$_ ne $call} @{$self->{believe}}];
delete $self->{believe} unless @{$self->{believe}};
+ $self->put;
}
}
# 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;
$SIG{'INT'} = 'IGNORE';
}
- DXUser::sync;
- DXUser::writeoutjson;
if (defined &Local::finish) {
eval {
$self->{annok} = 1;
# write it away
- $self->close();
+ $self->put();
# now do one for the alias
$ref = DXUser::get(uc $myalias);
$self->{group} = [qw(local #9000)];
# write it away
- $self->close();
+ $self->put();
}
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 = <STDIN>;
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 = <STDIN>;
if ($ans =~ /^[Yy]/) {
- DXUser::init(1);
+ DXUser::init(4);
create_it();
}
}
} else {
- DXUser::init(1);
+ DXUser::init(4);
create_it();
}
DXUser::finish();
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";
$self->{annok} = 1;
# write it away
- $self->close();
+ $self->put();
print "new call $mycall added\n";
# now do one for the alias
$self->{group} = [qw(local #9000)];
# write it away
- $self->close();
+ $self->put();
print "new call $myalias added\n";
}
close CLLOCK;
}
-DXUser::init(1);
+DXUser::init(4);
create_it();
DXUser::finish();
print "Update of $myalias on cluster $mycall successful\n";
projects / spider.git / commitdiff