X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUser.pm;h=3497fa8af71e4eb41b3d8bba230dc26e5449ff86;hb=c7a3cfda9336d765d387e9328f817d1f0e5230d1;hp=60d49eafe72e3d7b7f613f068f75cc132f273324;hpb=c6a62ff483f8887b4157e111a405fef971ade8d9;p=spider.git diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 60d49eaf..3497fa8a 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -20,7 +20,7 @@ use File::Copy; use strict; -use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold $v3); +use vars qw(%u $dbm $filename %valid $lastoperinterval $lasttime $lru $lrusize $tooold $v3 $noips); %u = (); $dbm = undef; @@ -30,6 +30,7 @@ $lasttime = 0; $lrusize = 2000; $tooold = 86400 * 365; # this marks an old user who hasn't given enough info to be useful $v3 = 0; +$noips = 4; # hash of valid elements and a simple prompt %valid = ( @@ -91,6 +92,7 @@ $v3 = 0; believe => '1,Believable nodes,parray', lastping => '1,Last Ping at,ptimelist', maxconnect => '1,Max Connections', + ip => '1,IP address', ); #no strict; @@ -160,12 +162,17 @@ sub init dbg("This will take a while, I suggest you go and have cup of strong tea"); my $odbm = tie (%oldu, 'DB_File', localdata("users.v2"), O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v2 ($!) [rebuild it from user_asc?]"; for ($action = R_FIRST; !$odbm->seq($key, $val, $action); $action = R_NEXT) { - my $ref = asc_decode($val); - if ($ref) { - $ref->put; - $count++; + my $ref; + eval { $ref = asc_decode($val) }; + unless ($@) { + if ($ref) { + $ref->put; + $count++; + } else { + $err++ + } } else { - $err++ + Log('err', "DXUser: error decoding $@"); } } undef $odbm; @@ -177,9 +184,9 @@ sub init sub del_file { - my $fn = localdata("users"); - $fn .= $v3 ? ".v3" : ".v2"; - unlink $fn; + # with extreme prejudice + unlink "$main::data/users.v3"; + unlink "$main::local_data/users.v3"; } # @@ -244,7 +251,8 @@ sub get # search for it unless ($dbm->get($call, $data)) { - $ref = decode($data); + eval { $ref = decode($data); }; + if ($ref) { if (!UNIVERSAL::isa($ref, 'DXUser')) { dbg("DXUser::get: got strange answer from decode of $call". ref $ref. " ignoring"); @@ -252,7 +260,11 @@ sub get } # we have a reference and it *is* a DXUser } else { - dbg("DXUser::get: no reference returned from decode of $call $!"); + if ($@) { + LogDbg('err', "DXUser::get decode error on $call '$@'"); + } else { + dbg("DXUser::get: no reference returned from decode of $call $!"); + } return undef; } $lru->put($call, $ref); @@ -323,7 +335,9 @@ sub encode sub decode { goto &asc_decode unless $v3; - return thaw(shift); + my $ref; + $ref = thaw(shift); + return $ref; } # @@ -358,7 +372,7 @@ sub asc_decode $s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; eval '$ref = ' . $s; if ($@) { - LogDbg('err', $@); + LogDbg('err', "DXUser::asc_decode: on '$s' $@"); $ref = undef; } return $ref; @@ -412,10 +426,10 @@ sub fields sub export { - my $name = shift; + my $name = shift || 'user_asc'; my $basic_info_only = shift; - my $fn = "$main::local_data/$name"; + my $fn = $name ne 'user_asc' ? $name : "$main::local_data/$name"; # force use of local # save old ones move "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo"; @@ -466,8 +480,6 @@ BEGIN { } } -package DXUser; - use SysVar; use DXUser; @@ -476,8 +488,10 @@ if (@ARGV) { print "user filename now $userfn\n"; } -DXUser::del_file(); -DXUser::init(); +package DXUser; + +del_file(); +init(1); %u = (); my $count = 0; my $err = 0; @@ -488,12 +502,13 @@ while () { if ($ref) { $ref->put(); $count++; + DXUser::sync() unless $count % 10000; } else { print "# Error: $f[0]\t$f[1]\n"; $err++ } } -DXUser::sync; DXUser::finish; +DXUser::sync(); DXUser::finish(); print "There are $count user records and $err errors\n"; }; print $fh "__DATA__\n"; @@ -510,7 +525,8 @@ print "There are $count user records and $err errors\n"; ++$err; next; } - my $ref = decode($val); + my $ref; + eval {$ref = decode($val); }; if ($ref) { my $t = $ref->{lastin} || 0; if ($ref->is_user && !$ref->{priv} && $main::systime > $t + $tooold) { @@ -526,15 +542,17 @@ print "There are $count user records and $err errors\n"; print $fh "$key\t" . $ref->asc_encode($basic_info_only) . "\n"; ++$count; } else { - LogDbg('DXCommand', "Export Error3: $key\t$val"); + LogDbg('DXCommand', "Export Error3: $key\t" . carp($val) ."\n$@"); eval {$dbm->del($key)}; dbg(carp("Export Error3: $key\t$val\n$@")) if $@; ++$err; } } $fh->close; - } - return "$count Users $del Deleted $err Errors ('sh/log Export' for details)"; + } + my $s = qq{Exported users to $fn - $count Users $del Deleted $err Errors ('sh/log Export' for details)}; + LogDbg('command', $s); + return $s; } #