From 8ac487c0c3297023df07493b11fe166d4c857081 Mon Sep 17 00:00:00 2001 From: djk Date: Wed, 17 Feb 1999 00:06:52 +0000 Subject: [PATCH] 1. added export_user.pl to export user files (for interest and safety) 2. changed DXUser::init to allow O_RDONLY access which may limit the number of coredumps G0RDI seems to get. --- Changes | 4 +++ perl/DXUser.pm | 9 +++++-- perl/client.pl | 3 ++- perl/cluster.pl | 2 +- perl/create_sysop.pl | 6 ++--- perl/export_user.pl | 58 ++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 75 insertions(+), 7 deletions(-) create mode 100755 perl/export_user.pl diff --git a/Changes b/Changes index 081db095..884a861d 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,7 @@ +17Feb99======================================================================== +1. added export_user.pl to export user files (for interest and safety) +2. changed DXUser::init to allow O_RDONLY access which may limit the number +of coredumps G0RDI seems to get. 15Feb99======================================================================== 1. Added msg forwarding code which uses $main::root/msg/forward.pl. 14Feb99======================================================================== diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 810bb768..c84598af 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -73,10 +73,15 @@ sub AUTOLOAD # sub init { - my ($pkg, $fn) = @_; + my ($pkg, $fn, $mode) = @_; confess "need a filename in User" if !$fn; - $dbm = tie (%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666) or confess "can't open user file: $fn ($!)"; + if ($mode) { + $dbm = tie (%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666) or confess "can't open user file: $fn ($!)"; + } else { + $dbm = tie (%u, MLDBM, $fn, O_RDONLY) or confess "can't open user file: $fn ($!)"; + } + $filename = $fn; } diff --git a/perl/client.pl b/perl/client.pl index ffae6e58..2392dfa8 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -41,7 +41,6 @@ BEGIN { use Msg; use DXVars; use DXDebug; -use DXUser; use IO::File; use IO::Socket; use IPC::Open2; @@ -365,6 +364,8 @@ if ($loginreq) { } + use DXUser; + DXUser->init($userfn); # allow a login from an existing user. I could create a user but diff --git a/perl/cluster.pl b/perl/cluster.pl index 1c1ba3c8..0de499f6 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -254,7 +254,7 @@ Bands::load(); # initialise User file system print "loading user file system ...\n"; -DXUser->init($userfn); +DXUser->init($userfn, 1); # start listening for incoming messages/connects print "starting listener ...\n"; diff --git a/perl/create_sysop.pl b/perl/create_sysop.pl index 840ddef4..95fc0636 100755 --- a/perl/create_sysop.pl +++ b/perl/create_sysop.pl @@ -80,19 +80,19 @@ if (-e "$userfn") { $ans = ; if ($ans =~ /^[Yy]/) { delete_it(); - DXUser->init($userfn); + DXUser->init($userfn, 1); create_it(); } else { print "Do you wish to reset your cluster and sysop information? [y/N]: "; $ans = ; if ($ans =~ /^[Yy]/) { - DXUser->init($userfn); + DXUser->init($userfn, 1); create_it(); } } } else { - DXUser->init($userfn); + DXUser->init($userfn, 1); create_it(); } DXUser->finish(); diff --git a/perl/export_user.pl b/perl/export_user.pl new file mode 100755 index 00000000..950b72e5 --- /dev/null +++ b/perl/export_user.pl @@ -0,0 +1,58 @@ +#!/usr/bin/perl +# +# Export the user file in a form that can be directly imported +# back with a do statement +# + +require 5.004; + +# search local then perl directories +BEGIN { + # root of directory tree for this system + $root = "/spider"; + $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; + + unshift @INC, "$root/perl"; # this IS the right way round! + unshift @INC, "$root/local"; +} + +use DXVars; +use DXUser; + +$userfn = $ARGV[0] if @ARGV; + +DXUser->init($userfn); + +@all = DXUser::get_all_calls(); +$t = scalar time; +print "#!/usr/bin/perl +# +# The exported userfile for a DXSpider System +# +# Input file: $userfn +# Time: $t +# + +package DXUser; + +%u = ( +"; + +for $a (@all) { + my $ref = DXUser->get($a); + print "'$a' => bless ( { "; + + my $f; + for $f (sort keys %{$ref}) { + my $val = ${$ref}{$f}; + $val =~ s/'/\\'/og; + print "'$f' => '$val', "; + } + print " }, 'DXUser'),\n"; + $count++; +} +print ");\n +# +# there were $count records +#\n"; + -- 2.43.0