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.

diff --git a/Changes b/Changes
index 081db095ed4df7781720da6051cd0ed4e999eaaa..884a861dd9f87147f4855a3079e3d97def5669f3 100644 (file)
--- 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 810bb7682d85c7f752249b013b2ef8ff3909fc81..c84598afad795680582b5fab55d9ccbff9a99567 100644 (file)
--- 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 ffae6e584ebfbc5fc4c5fa44ef7f929cbe031bc9..2392dfa8662f0b1b2d16a83e863281254471c97d 100755 (executable)
--- 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 1c1ba3c8581cac29b4b82d3ccb7e299a960231dd..0de499f62a4784b9cdbbb7271977374b04ba3a50 100755 (executable)
--- 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 840ddef4da303b324e9ef639781f0a5138c90380..95fc063600d588abccc944741b82b2731291734f 100755 (executable)
--- a/perl/create_sysop.pl
+++ b/perl/create_sysop.pl
@@ -80,19 +80,19 @@ if (-e "$userfn") {
        $ans = <STDIN>;
        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 = <STDIN>;
                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 (executable)
index 0000000..950b72e
--- /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";
+