From 8ac487c0c3297023df07493b11fe166d4c857081 Mon Sep 17 00:00:00 2001
From: djk <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 = <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
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