--- loncom/lond	2004/03/16 10:52:30	1.178.2.8
+++ loncom/lond	2004/03/22 09:16:26	1.178.2.10
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.178.2.8 2004/03/16 10:52:30 foxr Exp $
+# $Id: lond,v 1.178.2.10 2004/03/22 09:16:26 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -53,7 +53,7 @@ my $DEBUG = 1;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.178.2.8 $'; #' stupid emacs
+my $VERSION='$Revision: 1.178.2.10 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid;
 my $currentdomainid;
@@ -162,7 +162,56 @@ sub isClient {
     return (($ConnectionType eq "client") || ($ConnectionType eq "both"));
 }
 #
-#   Ties a resource file to a hash.  If necessary, an appropriate history
+#  Ties a domain level resource file to a hash.
+#  If requested a history entry is created in the associated hist file.
+#
+#  Parameters:
+#     domain    - Name of the domain in which the resource file lives.
+#     namespace - Name of the hash within that domain.
+#     how       - How to tie the hash (e.g. GDBM_WRCREAT()).
+#     loghead   - Optional parameter, if present a log entry is created
+#                 in the associated history file and this is the first part
+#                  of that entry.
+#     logtail   - Goes along with loghead,  The actual logentry is of the
+#                 form $loghead:<timestamp>:logtail.
+# Returns:
+#    Reference to a hash bound to the db file or alternatively undef
+#    if the tie failed.
+#
+sub TieDomainHash {
+    my $domain    = shift;
+    my $namespace = shift;
+    my $how       = shift;
+    
+    # Filter out any whitespace in the domain name:
+    
+    $domain =~ s/\W//g;
+    
+    # We have enough to go on to tie the hash:
+    
+    my $UserTopDir   = $perlvar{'lonUsersDir'};
+    my $DomainDir    = $UserTopDir."/$domain";
+    my $ResourceFile = $DomainDir."/$namespace.db";
+    my %hash;
+    if(tie(%hash, 'GDBM_File', $ResourceFile, $how, 0640)) {
+	if (scalar @_) {	# Need to log the operation.
+	    my $logFh = IO::File->new(">>$DomainDir/$namespace.hist");
+	    if($logFh) {
+		my $TimeStamp = time;
+		my ($loghead, $logtail) = @_;
+		print $logFh "$loghead:$TimeStamp:$logtail\n";
+	    }
+	}
+	return \%hash;		# Return the tied hash.
+    }
+    else {
+	return undef;		# Tie failed.
+    }
+}
+
+#
+#   Ties a user's resource file to a hash.  
+#   If necessary, an appropriate history
 #   log file entry is made as well.
 #   This sub factors out common code from the subs that manipulate
 #   the various gdbm files that keep keyword value pairs.
@@ -179,40 +228,40 @@ sub isClient {
 #   hash to which the database is tied.  It's up to the caller to untie.
 #   undef if the has could not be tied.
 #
-sub TieResourceHash {
-  my $domain      = shift;
-  my $user        = shift;
-  my $namespace   = shift;
-  my $how         = shift;
-
-  $namespace=~s/\//\_/g;	# / -> _
-  $namespace=~s/\W//g;		# whitespace eliminated.
-  my $proname     = propath($domain, $user);
-
-  # If this is a namespace for which a history is kept,
-  # make the history log entry:
-
-
-  unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) {
-    my $hfh = IO::File->new(">>$proname/$namespace.hist"); 
-    if($hfh) {
-      my $now = time;
-      my $loghead  = shift;
-      my $what    = shift;
-      print $hfh "$loghead:$now:$what\n";
-    }
-  }
-  #  Tie the database.
-
-  my %hash;
-  if(tie(%hash, 'GDBM_FILE', "$proname/$namespace.db",
-	 $how, 0640)) {
-    return \%hash;
-  }
-  else {
-    return undef;
-  }
-  
+sub TieUserHash {
+    my $domain      = shift;
+    my $user        = shift;
+    my $namespace   = shift;
+    my $how         = shift;
+    
+    $namespace=~s/\//\_/g;	# / -> _
+    $namespace=~s/\W//g;		# whitespace eliminated.
+    my $proname     = propath($domain, $user);
+    
+    # If this is a namespace for which a history is kept,
+    # make the history log entry:
+    
+    
+    unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) {
+	my $hfh = IO::File->new(">>$proname/$namespace.hist"); 
+	if($hfh) {
+	    my $now = time;
+	    my $loghead  = shift;
+	    my $what    = shift;
+	    print $hfh "$loghead:$now:$what\n";
+	}
+    }
+    #  Tie the database.
+    
+    my %hash;
+    if(tie(%hash, 'GDBM_FILE', "$proname/$namespace.db",
+	   $how, 0640)) {
+	return \%hash;
+    }
+    else {
+	return undef;
+    }
+    
 }
 
 #
@@ -676,15 +725,15 @@ sub AuthenticateHandler {
     my $cmd        = shift;
     my $tail       = shift;
     my $client     = shift;
-   
+    
     #  Regenerate the full input line 
-   
+    
     my $userinput  = $cmd.":".$tail;
-
+    
     #  udom    - User's domain.
     #  uname   - Username.
     #  upass   - User's password.
-   
+    
     my ($udom,$uname,$upass)=split(/:/,$tail);
     Debug(" Authenticate domain = $udom, user = $uname, password = $upass");
     chomp($upass);
@@ -1360,34 +1409,34 @@ sub PutUserProfileEntry {
     my $tail      = shift;
     my $client    = shift;
     my $userinput = "$cmd:$tail";
-
+    
     my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
     if ($namespace ne 'roles') {
-       chomp($what);
-       my $hashref = TieResourceHash($udom, $uname, $namespace,
-				     &GDBM_WRCREAT(),"P",$what);
-       if($hashref) {
-	 my @pairs=split(/\&/,$what);
-	 foreach my $pair (@pairs) {
-	    my ($key,$value)=split(/=/,$pair);
-	    $hashref->{$key}=$value;
-	  }
-	  if (untie(%$hashref)) {
-	     Reply( $client, "ok\n", $userinput);
-	  } else {
-	     Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
-		     "while attempting put\n", 
-		     $userinput);
-	  }
-       } else {
-	  Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
-		   "while attempting put\n", $userinput);
-       }
-     } else {
+	chomp($what);
+	my $hashref = TieUserHash($udom, $uname, $namespace,
+				  &GDBM_WRCREAT(),"P",$what);
+	if($hashref) {
+	    my @pairs=split(/\&/,$what);
+	    foreach my $pair (@pairs) {
+		my ($key,$value)=split(/=/,$pair);
+		$hashref->{$key}=$value;
+	    }
+	    if (untie(%$hashref)) {
+		Reply( $client, "ok\n", $userinput);
+	    } else {
+		Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
+			"while attempting put\n", 
+			$userinput);
+	    }
+	} else {
+	    Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
+		     "while attempting put\n", $userinput);
+	}
+    } else {
         Failure( $client, "refused\n", $userinput);
-     }
+    }
     
-     return 1;
+    return 1;
 }
 RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0);
 
@@ -1415,32 +1464,32 @@ sub IncrementUserValueHandler {
     my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
     if ($namespace ne 'roles') {
         chomp($what);
-	my $hashref = TieResourceHash($udom, $uname,
-				      $namespace, &GDBM_WRCREAT(),
-				      "P",$what);
+	my $hashref = TieUserHash($udom, $uname,
+				  $namespace, &GDBM_WRCREAT(),
+				  "P",$what);
 	if ($hashref) {
-	   my @pairs=split(/\&/,$what);
-	   foreach my $pair (@pairs) {
-	     my ($key,$value)=split(/=/,$pair);
-	     # We could check that we have a number...
-	     if (! defined($value) || $value eq '') {
-	        $value = 1;
-	     }
-	     $hashref->{$key}+=$value;
-	   }
-	   if (untie(%$hashref)) {
-	      Reply( $client, "ok\n", $userinput);
-	   } else {
-	      Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
-		      "while attempting inc\n", $userinput);
-	   }
-	 } else {
-	   Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
-		   "while attempting inc\n", $userinput);
-	 }
-      } else {
-	 Failure($client, "refused\n", $userinput);
-      }
+	    my @pairs=split(/\&/,$what);
+	    foreach my $pair (@pairs) {
+		my ($key,$value)=split(/=/,$pair);
+		# We could check that we have a number...
+		if (! defined($value) || $value eq '') {
+		    $value = 1;
+		}
+		$hashref->{$key}+=$value;
+	    }
+	    if (untie(%$hashref)) {
+		Reply( $client, "ok\n", $userinput);
+	    } else {
+		Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
+			"while attempting inc\n", $userinput);
+	    }
+	} else {
+	    Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+		    "while attempting inc\n", $userinput);
+	}
+    } else {
+	Failure($client, "refused\n", $userinput);
+    }
     
     return 1;
 }
@@ -1476,9 +1525,9 @@ sub RolesPutHandler {
 	   "what = ".$what);
     my $namespace='roles';
     chomp($what);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
-				  &GDBM_WRCREAT(), "P",
-				  "$exedom:$exeuser:$what");
+    my $hashref = TieUserHash($udom, $uname, $namespace,
+			      &GDBM_WRCREAT(), "P",
+			      "$exedom:$exeuser:$what");
     #
     #  Log the attempt to set a role.  The {}'s here ensure that the file 
     #  handle is open for the minimal amount of time.  Since the flush
@@ -1533,26 +1582,26 @@ sub RolesDeleteHandler {
 	   "what = ".$what);
     my $namespace='roles';
     chomp($what);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
-				  &GDBM_WRCREAT(), "D",
-				  "$exedom:$exeuser:$what");
-
+    my $hashref = TieUserHash($udom, $uname, $namespace,
+			      &GDBM_WRCREAT(), "D",
+			      "$exedom:$exeuser:$what");
+    
     if ($hashref) {
-       my @rolekeys=split(/\&/,$what);
-       
-       foreach my $key (@rolekeys) {
-	  delete $hashref->{$key};
-       }
-       if (untie(%$hashref)) {
-	  Reply($client, "ok\n", $userinput);
+	my @rolekeys=split(/\&/,$what);
+	
+	foreach my $key (@rolekeys) {
+	    delete $hashref->{$key};
+	}
+	if (untie(%$hashref)) {
+	    Reply($client, "ok\n", $userinput);
 	} else {
-	   Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
-		    "while attempting rolesdel\n", $userinput);
+	    Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+		     "while attempting rolesdel\n", $userinput);
 	}
-     } else {
+    } else {
         Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
 		 "while attempting rolesdel\n", $userinput);
-     }
+    }
     
     return 1;
 }
@@ -1585,12 +1634,12 @@ sub GetProfileEntry {
    
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
-				 &GDBM_READER());
+    my $hashref = TieUserHash($udom, $uname, $namespace,
+			      &GDBM_READER());
     if ($hashref) {
         my @queries=split(/\&/,$what);
         my $qresult='';
-
+	
 	for (my $i=0;$i<=$#queries;$i++) {
 	    $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.
 	}
@@ -1640,7 +1689,7 @@ sub GetProfileEntryEncrypted {
    
     my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);
     chomp($what);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
+    my $hashref = TieUserHash($udom, $uname, $namespace,
 				  &GDBM_READER());
     if ($hashref) {
         my @queries=split(/\&/,$what);
@@ -1655,9 +1704,10 @@ sub GetProfileEntryEncrypted {
 		$qresult.="         ";
 		my $encqresult='';
 		for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
-		    $encqresult.= unpack("H16", $cipher->encrypt(substr($qresult,
-									$encidx,
-									8)));
+		    $encqresult.= unpack("H16", 
+					 $cipher->encrypt(substr($qresult,
+								 $encidx,
+								 8)));
 		}
 		Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);
 	    } else {
@@ -1703,7 +1753,7 @@ sub DeleteProfileEntry {
 
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
+    my $hashref = TieUserHash($udom, $uname, $namespace,
 				  &GDBM_WRCREAT(),
 				  "D",$what);
     if ($hashref) {
@@ -1747,7 +1797,7 @@ sub GetProfileKeys {
 
     my ($udom,$uname,$namespace)=split(/:/,$tail);
     my $qresult='';
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
+    my $hashref = TieUserHash($udom, $uname, $namespace,
 				  &GDBM_READER());
     if ($hashref) {
 	foreach my $key (keys %$hashref) {
@@ -1794,7 +1844,7 @@ sub DumpProfileDatabase {
     my $userinput = "$cmd:$tail";
    
     my ($udom,$uname,$namespace) = split(/:/,$tail);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
+    my $hashref = TieUserHash($udom, $uname, $namespace,
 				  &GDBM_READER());
     if ($hashref) {
 	# Structure of %data:
@@ -1802,7 +1852,7 @@ sub DumpProfileDatabase {
 	# $data{$symb}->{'v.'.$parameter}=$version;
 	# since $parameter will be unescaped, we do not
  	# have to worry about silly parameter names...
-
+	
         my $qresult='';
 	my %data = ();                     # A hash of anonymous hashes..
 	while (my ($key,$value) = each(%$hashref)) {
@@ -1875,7 +1925,7 @@ sub DumpWithRegexp {
     } else {
 	$regexp='.';
     }
-    my $hashref =TieResourceHash($udom, $uname, $namespace,
+    my $hashref =TieUserHash($udom, $uname, $namespace,
 				 &GDBM_READER());
     if ($hashref) {
         my $qresult='';
@@ -1935,7 +1985,7 @@ sub StoreHandler {
 
 	chomp($what);
 	my @pairs=split(/\&/,$what);
-	my $hashref  = TieResourceHash($udom, $uname, $namespace,
+	my $hashref  = TieUserHash($udom, $uname, $namespace,
 				       &GDBM_WRCREAT(), "P",
 				       "$rid:$what");
 	if ($hashref) {
@@ -2214,20 +2264,18 @@ sub PutCourseIdHandler {
 
     my $userinput = "$cmd:$tail";
 
-    my ($udom,$what)=split(/:/,$tail);
+    my ($udom, $what) = split(/:/, $tail);
     chomp($what);
-    $udom=~s/\W//g;
-    my $proname=
-	"$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
     my $now=time;
     my @pairs=split(/\&/,$what);
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
+
+    my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
+    if ($hashref) {
 	foreach my $pair (@pairs) {
 	    my ($key,$value)=split(/=/,$pair);
-	    $hash{$key}=$value.':'.$now;
+	    $hashref->{$key}=$value.':'.$now;
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    Reply($client, "ok\n", $userinput);
 	} else {
 	    Failure( $client, "error: ".($!+0)
@@ -2282,10 +2330,10 @@ sub DumpCourseIdHandler {
     }
     unless (defined($since)) { $since=0; }
     my $qresult='';
-    my $proname = "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
-	while (my ($key,$value) = each(%hash)) {
+
+    my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
+    if ($hashref) {
+	while (my ($key,$value) = each(%$hashref)) {
 	    my ($descr,$lasttime)=split(/\:/,$value);
 	    if ($lasttime<$since) { 
 		next; 
@@ -2299,7 +2347,7 @@ sub DumpCourseIdHandler {
 		}
 	    }
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    chop($qresult);
 	    Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -2340,23 +2388,15 @@ sub PutIdHandler {
 
     my ($udom,$what)=split(/:/,$tail);
     chomp($what);
-    $udom=~s/\W//g;
-    my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
-    my $now=time;
-    {
-	my $hfh;
-	if ($hfh=IO::File->new(">>$proname.hist")) { 
-	    print $hfh "P:$now:$what\n"; 
-	}
-    }
     my @pairs=split(/\&/,$what);
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
+    my $hashref = TieDomainHash($udom, "ids", &GDBM_WRCREAT(),
+				"P", $what);
+    if ($hashref) {
 	foreach my $pair (@pairs) {
 	    my ($key,$value)=split(/=/,$pair);
-	    $hash{$key}=$value;
+	    $hashref->{$key}=$value;
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    Reply($client, "ok\n", $userinput);
 	} else {
 	    Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2394,21 +2434,19 @@ sub GetIdHandler {
     my $cmd    = shift;
     my $tail   = shift;
     my $client = shift;
-
+    
     my $userinput = "$client:$tail";
-
+    
     my ($udom,$what)=split(/:/,$tail);
     chomp($what);
-    $udom=~s/\W//g;
-    my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
     my @queries=split(/\&/,$what);
     my $qresult='';
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
+    my $hashref = TieDomainHash($udom, "ids", &GDBM_READER());
+    if ($hashref) {
 	for (my $i=0;$i<=$#queries;$i++) {
-	    $qresult.="$hash{$queries[$i]}&";
+	    $qresult.="$hashref->{$queries[$i]}&";
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    $qresult=~s/\&$//;
 	    Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -2419,7 +2457,7 @@ sub GetIdHandler {
 	Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
 		"while attempting idget\n",$userinput);
     }
-
+    
     return 1;
 }
 
@@ -2487,7 +2525,7 @@ sub TmpGetHandler {
     my $id        = shift;
     my $client    = shift;
     my $userinput = "$cmd:$id"; 
-
+    
     chomp($id);
     $id=~s/\W/\_/g;
     my $store;
@@ -2522,9 +2560,9 @@ sub TmpDelHandler {
     my $cmd      = shift;
     my $id       = shift;
     my $client   = shift;
-
+    
     my $userinput= "$cmd:$id";
-
+    
     chomp($id);
     $id=~s/\W/\_/g;
     my $execdir=$perlvar{'lonDaemons'};
@@ -2534,7 +2572,7 @@ sub TmpDelHandler {
 	Failure( $client, "error: ".($!+0)."Unlink tmp Failed ".
 		 "while attempting tmpdel\n", $userinput);
     }
-
+    
     return 1;
 
 }