use Fcntl;
use IO::File;
use DXDebug;
+use DXUtil;
+use LRU;
use strict;
use vars qw($VERSION $BRANCH);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
+$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);
+use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize);
%u = ();
$dbm = undef;
$filename = undef;
-$lastoperinterval = 30*24*60*60;
+$lastoperinterval = 60*24*60*60;
$lasttime = 0;
+$lrusize = 500;
# hash of valid elements and a simple prompt
%valid = (
priv => '9,Privilege Level',
lastin => '0,Last Time in,cldatetime',
passwd => '9,Password,yesno',
+ passphrase => '9,Pass Phrase,yesno',
addr => '0,Full Address',
'sort' => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS
xpert => '0,Expert Status,yesno',
hmsgno => '0,Highest Msgno',
group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other
isolate => '9,Isolate network,yesno',
- wantbeep => '0,Rec Beep,yesno',
- wantann => '0,Rec Announce,yesno',
- wantwwv => '0,Rec WWV,yesno',
- wantwcy => '0,Rec WCY,yesno',
- wantecho => '0,Rec Echo,yesno',
- wanttalk => '0,Rec Talk,yesno',
- wantwx => '0,Rec WX,yesno',
- wantdx => '0,Rec DX Spots,yesno',
- wantemail => '0,Rec Msgs as Email,yesno',
+ wantbeep => '0,Req Beep,yesno',
+ wantann => '0,Req Announce,yesno',
+ wantwwv => '0,Req WWV,yesno',
+ wantwcy => '0,Req WCY,yesno',
+ wantecho => '0,Req Echo,yesno',
+ wanttalk => '0,Req Talk,yesno',
+ wantwx => '0,Req WX,yesno',
+ wantdx => '0,Req DX Spots,yesno',
+ wantemail => '0,Req Msgs as Email,yesno',
pagelth => '0,Current Pagelth',
pingint => '9,Node Ping interval',
nopings => '9,Ping Obs Count',
wantlogininfo => '9,Login info req,yesno',
wantgrid => '0,DX Grid Info,yesno',
wantann_talk => '0,Talklike Anns,yesno',
+ wantpc90 => '1,Req PC90,yesno',
+ wantnp => '1,Req New Protocol,yesno',
lastoper => '9,Last for/oper,cldatetime',
nothere => '0,Not Here Text',
registered => '9,Registered?,yesno',
+ prompt => '0,Required Prompt',
+ version => '1,Version',
+ build => '1,Build',
);
no strict;
}
$filename = $fn;
+ $lru = LRU->newbase("DXUser", $lrusize);
}
sub del_file
my $pkg = shift;
my $call = uc shift;
my $data;
+
+ # is it in the LRU cache?
+ my $ref = $lru->get($call);
+ return $ref if $ref;
+
+ # search for it
unless ($dbm->get($call, $data)) {
- return decode($data);
+ $ref = decode($data);
+ $lru->put($call, $ref);
+ return $ref;
}
return undef;
}
my $dxchan = DXChannel->get($call);
return $dxchan->user if $dxchan;
- my $data;
- unless ($dbm->get($call, $data)) {
- return decode($data);
- }
- return undef;
+ my $rref = Route::get($call);
+ return $rref->user if $rref && exists $rref->{user};
+ return $pkg->get($call);
}
#
$dbm->del($call);
delete $self->{annok} if $self->{annok};
delete $self->{dxok} if $self->{dxok};
- $dbm->put($call, $self->encode);
+ $lru->put($call, $self);
+ my $ref = $self->encode;
+ $dbm->put($call, $ref);
}
#
# for ($dbm->get_dup($call)) {
# $dbm->del_dup($call, $_);
# }
+ $lru->remove($call);
$dbm->del($call);
}
rename "$fn", "$fn.o" if -e "$fn";
my $count = 0;
+ my $err = 0;
my $fh = new IO::File ">$fn" or return "cannot open $fn ($!)";
if ($fh) {
- my $ref = 0;
my $key = 0;
+ my $val = undef;
my $action;
my $t = scalar localtime;
print $fh q{#!/usr/bin/perl
DXUser->del_file($main::userfn);
DXUser->init($main::userfn, 1);
-
-%u = (
- };
-
- for ($action = R_FIRST; !$dbm->seq($key, $ref, $action); $action = R_NEXT) {
- print $fh "'$key' => q{$ref},\n";
- ++$count;
+%u = ();
+my $count = 0;
+my $err = 0;
+while (<DATA>) {
+ chomp;
+ my @f = split /\t/;
+ my $ref = decode($f[1]);
+ if ($ref) {
+ $ref->put();
+ $count++;
+ } else {
+ print "# Error: $f[0]\t$f[1]\n";
+ $err++
+ }
+}
+DXUser->sync; DXUser->finish;
+print "There are $count user records and $err errors\n";
+};
+ print $fh "__DATA__\n";
+
+ for ($action = R_FIRST; !$dbm->seq($key, $val, $action); $action = R_NEXT) {
+ if (!is_callsign($key) || $key =~ /^0/) {
+ Log('DXCommand', "Export Error1: $key\t$val");
+ eval {$dbm->del($key)};
+ dbg(carp("Export Error1: $key\t$val\n$@")) if $@;
+ ++$err;
+ next;
+ }
+ my $ref = decode($val);
+ if ($ref) {
+ print $fh "$key\t" . $ref->encode . "\n";
+ ++$count;
+ } else {
+ Log('DXCommand', "Export Error2: $key\t$val");
+ eval {$dbm->del($key)};
+ dbg(carp("Export Error2: $key\t$val\n$@")) if $@;
+ ++$err;
+ }
}
- print $fh ");\n#\nprint \"there were $count records\\n\";\n#\n";
- print $fh "DXUser->sync; DXUser->finish;\n#\n";
$fh->close;
}
- return $count;
+ return "$count Users $err Errors ('sh/log Export' for details)";
}
#
my $self = shift;
delete $self->{passwd};
}
+
+sub unset_passphrase
+{
+ my $self = shift;
+ delete $self->{passphrase};
+}
1;
__END__