--- loncom/lond	2006/02/10 09:48:17	1.305.2.4
+++ loncom/lond	2006/01/21 08:26:52	1.306
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.305.2.4 2006/02/10 09:48:17 albertel Exp $
+# $Id: lond,v 1.306 2006/01/21 08:26:52 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -53,15 +53,13 @@ use LONCAPA::ConfigFileEdit;
 use LONCAPA::lonlocal;
 use LONCAPA::lonssl;
 use Fcntl qw(:flock);
-use Symbol;
 
 my $DEBUG = 0;		       # Non zero to enable debug log entries.
 
 my $status='';
 my $lastlog='';
-my $lond_max_wait_time = 13;
 
-my $VERSION='$Revision: 1.305.2.4 $'; #' stupid emacs
+my $VERSION='$Revision: 1.306 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -972,13 +970,23 @@ sub tie_domain_hash {
     
     my $user_top_dir   = $perlvar{'lonUsersDir'};
     my $domain_dir     = $user_top_dir."/$domain";
-    my $resource_file  = $domain_dir."/$namespace";
-    return &_locking_hash_tie($resource_file,$namespace,$how,$loghead,$logtail);
+    my $resource_file  = $domain_dir."/$namespace.db";
+    my %hash;
+    if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) {
+	if (defined($loghead)) {	# Need to log the operation.
+	    my $logFh = IO::File->new(">>$domain_dir/$namespace.hist");
+	    if($logFh) {
+		my $timestamp = time;
+		print $logFh "$loghead:$timestamp:$logtail\n";
+	    }
+	    $logFh->close;
+	}
+	return \%hash;		# Return the tied hash.
+    } else {
+	return undef;		# Tie failed.
+    }
 }
 
-sub untie_domain_hash {
-    return &_locking_hash_untie(@_);
-}
 #
 #   Ties a user's resource file to a hash.  
 #   If necessary, an appropriate history
@@ -1004,27 +1012,18 @@ sub tie_user_hash {
     $namespace=~s/\//\_/g;	# / -> _
     $namespace=~s/\W//g;		# whitespace eliminated.
     my $proname     = propath($domain, $user);
-
-    my $file_prefix="$proname/$namespace";
-    return &_locking_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
-}
-
-sub untie_user_hash {
-    return &_locking_hash_untie(@_);
-}
-
-# internal routines that handle the actual tieing and untieing process
-
-sub _do_hash_tie {
-    my ($file_prefix,$namespace,$how,$loghead,$what) = @_;
+   
+    #  Tie the database.
+    
     my %hash;
-    if(tie(%hash, 'GDBM_File', "$file_prefix.db", $how, 0640)) {
+    if(tie(%hash, 'GDBM_File', "$proname/$namespace.db",
+	   $how, 0640)) {
 	# If this is a namespace for which a history is kept,
 	# make the history log entry:    
 	if (($namespace !~/^nohist\_/) && (defined($loghead))) {
 	    my $args = scalar @_;
-	    Debug(" Opening history: $file_prefix $args");
-	    my $hfh = IO::File->new(">>$file_prefix.hist"); 
+	    Debug(" Opening history: $namespace $args");
+	    my $hfh = IO::File->new(">>$proname/$namespace.hist"); 
 	    if($hfh) {
 		my $now = time;
 		print $hfh "$loghead:$now:$what\n";
@@ -1035,72 +1034,7 @@ sub _do_hash_tie {
     } else {
 	return undef;
     }
-}
-
-sub _do_hash_untie {
-    my ($hashref) = @_;
-    my $result = untie(%$hashref);
-    return $result;
-}
-
-{
-    my $sym;
-
-    sub _locking_hash_tie {
-	my ($file_prefix,$namespace,$how,$loghead,$what) = @_;
-
-	my ($lock);
     
-	if ($how eq &GDBM_READER()) {
-	    $lock=LOCK_SH;
-	    $how=$how|&GDBM_NOLOCK();
-	    #if the db doesn't exist we can't read from it
-	    if (! -e "$file_prefix.db") {
-		$! = 2;
-		return undef;
-	    }
-	} elsif ($how eq &GDBM_WRCREAT()) {
-	    $lock=LOCK_EX;
-	    $how=$how|&GDBM_NOLOCK();
-	    if (! -e "$file_prefix.db") {
-		# doesn't exist but we need it to in order to successfully
-                # lock it so bring it into existance
-		open(TOUCH,">>$file_prefix.db");
-		close(TOUCH);
-	    }
-	} else {
-	    &logthis("Unknown method $how for $file_prefix");
-	    die();
-	}
-    
-	$sym=&Symbol::gensym();
-	open($sym,"$file_prefix.db");
-	my $failed=0;
-	eval {
-	    local $SIG{__DIE__}='DEFAULT';
-	    local $SIG{ALRM}=sub { 
-		$failed=1;
-		die("failed lock");
-	    };
-	    alarm($lond_max_wait_time);
-	    flock($sym,$lock);
-	    alarm(0);
-	};
-	if ($failed) {
-	    $! = 100; # throwing error # 100
-	    return undef;
-	}
-	return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
-    }
-
-    sub _locking_hash_untie {
-	my ($hashref) = @_;
-	my $result = untie(%$hashref);
-	flock($sym,LOCK_UN);
-	close($sym);
-	undef($sym);
-	return $result;
-    }
 }
 
 #   read_profile
@@ -1133,7 +1067,7 @@ sub read_profile {
 	    $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.
 	}
 	$qresult=~s/\&$//;              # Remove trailing & from last lookup.
-	if (&untie_user_hash($hashref)) {
+	if (untie %$hashref) {
 	    return $qresult;
 	} else {
 	    return "error: ".($!+0)." untie (GDBM) Failed";
@@ -2009,7 +1943,6 @@ sub update_resource_handler {
 	    my $since=$now-$atime;
 	    if ($since>$perlvar{'lonExpire'}) {
 		my $reply=&reply("unsub:$fname","$clientname");
-		&devalidate_meta_cache($fname);
 		unlink("$fname");
 	    } else {
 		my $transname="$fname.in.transfer";
@@ -2040,7 +1973,14 @@ sub update_resource_handler {
 			alarm(0);
 		    }
 		    rename($transname,$fname);
-		    &devalidate_meta_cache($fname);
+		    use Cache::Memcached;
+		    my $memcache=
+			new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
+		    my $url=$fname;
+		    $url=~s-^/home/httpd/html--;
+		    $url=~s-\.meta$--;
+		    my $id=&escape('meta:'.$url);
+		    $memcache->delete($id);
 		}
 	    }
 	    &Reply( $client, "ok\n", $userinput);
@@ -2054,26 +1994,6 @@ sub update_resource_handler {
 }
 &register_handler("update", \&update_resource_handler, 0 ,1, 0);
 
-sub devalidate_meta_cache {
-    my ($url) = @_;
-    use Cache::Memcached;
-    my $memcache = new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
-    $url = &declutter($url);
-    $url =~ s-\.meta$--;
-    my $id = &escape('meta:'.$url);
-    $memcache->delete($id);
-}
-
-sub declutter {
-    my $thisfn=shift;
-    $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
-    $thisfn=~s/^\///;
-    $thisfn=~s|^adm/wrapper/||;
-    $thisfn=~s|^adm/coursedocs/showdoc/||;
-    $thisfn=~s/^res\///;
-    $thisfn=~s/\?.+$//;
-    return $thisfn;
-}
 #
 #   Fetch a user file from a remote server to the user's home directory
 #   userfiles subdir.
@@ -2442,7 +2362,7 @@ sub put_user_profile_entry {
 		my ($key,$value)=split(/=/,$pair);
 		$hashref->{$key}=$value;
 	    }
-	    if (&untie_user_hash($hashref)) {
+	    if (untie(%$hashref)) {
 		&Reply( $client, "ok\n", $userinput);
 	    } else {
 		&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
@@ -2450,7 +2370,7 @@ sub put_user_profile_entry {
 			$userinput);
 	    }
 	} else {
-	    &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+	    &Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
 		     "while attempting put\n", $userinput);
 	}
     } else {
@@ -2486,7 +2406,7 @@ sub newput_user_profile_entry {
     my $hashref = &tie_user_hash($udom, $uname, $namespace,
 				 &GDBM_WRCREAT(),"N",$what);
     if(!$hashref) {
-	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+	&Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
 		  "while attempting put\n", $userinput);
 	return 1;
     }
@@ -2505,7 +2425,7 @@ sub newput_user_profile_entry {
 	$hashref->{$key}=$value;
     }
 
-    if (&untie_user_hash($hashref)) {
+    if (untie(%$hashref)) {
 	&Reply( $client, "ok\n", $userinput);
     } else {
 	&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
@@ -2558,7 +2478,7 @@ sub increment_user_value_handler {
                     }
                 }
 	    }
-	    if (&untie_user_hash($hashref)) {
+	    if (untie(%$hashref)) {
 		&Reply( $client, "ok\n", $userinput);
 	    } else {
 		&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
@@ -2625,7 +2545,7 @@ sub roles_put_handler {
 			       $auth_type);
 	    $hashref->{$key}=$value;
 	}
-	if (&untie_user_hash($hashref)) {
+	if (untie($hashref)) {
 	    &Reply($client, "ok\n", $userinput);
 	} else {
 	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2676,7 +2596,7 @@ sub roles_delete_handler {
 	foreach my $key (@rolekeys) {
 	    delete $hashref->{$key};
 	}
-	if (&untie_user_hash($hashref)) {
+	if (untie(%$hashref)) {
 	    &Reply($client, "ok\n", $userinput);
 	} else {
 	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2817,7 +2737,7 @@ sub delete_profile_entry {
 	foreach my $key (@keys) {
 	    delete($hashref->{$key});
 	}
-	if (&untie_user_hash($hashref)) {
+	if (untie(%$hashref)) {
 	    &Reply($client, "ok\n", $userinput);
 	} else {
 	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2859,7 +2779,7 @@ sub get_profile_keys {
 	foreach my $key (keys %$hashref) {
 	    $qresult.="$key&";
 	}
-	if (&untie_user_hash($hashref)) {
+	if (untie(%$hashref)) {
 	    $qresult=~s/\&$//;
 	    &Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -2920,7 +2840,7 @@ sub dump_profile_database {
 	    $data{$symb}->{$param}=$value;
 	    $data{$symb}->{'v.'.$param}=$v;
 	}
-	if (&untie_user_hash($hashref)) {
+	if (untie(%$hashref)) {
 	    while (my ($symb,$param_hash) = each(%data)) {
 		while(my ($param,$value) = each (%$param_hash)){
 		    next if ($param =~ /^v\./);       # Ignore versions...
@@ -2975,27 +2895,44 @@ sub dump_with_regexp {
 
     my $userinput = "$cmd:$tail";
 
-    my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail);
+    my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail);
     if (defined($regexp)) {
 	$regexp=&unescape($regexp);
     } else {
 	$regexp='.';
     }
+    my ($start,$end);
+    if (defined($range)) {
+	if ($range =~/^(\d+)\-(\d+)$/) {
+	    ($start,$end) = ($1,$2);
+	} elsif ($range =~/^(\d+)$/) {
+	    ($start,$end) = (0,$1);
+	} else {
+	    undef($range);
+	}
+    }
     my $hashref = &tie_user_hash($udom, $uname, $namespace,
 				 &GDBM_READER());
     if ($hashref) {
         my $qresult='';
+	my $count=0;
 	while (my ($key,$value) = each(%$hashref)) {
 	    if ($regexp eq '.') {
+		$count++;
+		if (defined($range) && $count >= $end)   { last; }
+		if (defined($range) && $count <  $start) { next; }
 		$qresult.=$key.'='.$value.'&';
 	    } else {
 		my $unescapeKey = &unescape($key);
 		if (eval('$unescapeKey=~/$regexp/')) {
+		    $count++;
+		    if (defined($range) && $count >= $end)   { last; }
+		    if (defined($range) && $count <  $start) { next; }
 		    $qresult.="$key=$value&";
 		}
 	    }
 	}
-	if (&untie_user_hash($hashref)) {
+	if (untie(%$hashref)) {
 	    chop($qresult);
 	    &Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -3057,7 +2994,7 @@ sub store_handler {
 	    $hashref->{"$version:$rid:timestamp"}=$now;
 	    $allkeys.='timestamp';
 	    $hashref->{"$version:keys:$rid"}=$allkeys;
-	    if (&untie_user_hash($hashref)) {
+	    if (untie($hashref)) {
 		&Reply($client, "ok\n", $userinput);
 	    } else {
 		&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -3109,22 +3046,24 @@ sub restore_handler {
     $namespace=~s/\//\_/g;
     $namespace=~s/\W//g;
     chomp($rid);
+    my $proname=&propath($udom,$uname);
     my $qresult='';
-    my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER());
-    if ($hashref) {
-	my $version=$hashref->{"version:$rid"};
+    my %hash;
+    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",
+	    &GDBM_READER(),0640)) {
+	my $version=$hash{"version:$rid"};
 	$qresult.="version=$version&";
 	my $scope;
 	for ($scope=1;$scope<=$version;$scope++) {
-	    my $vkeys=$hashref->{"$scope:keys:$rid"};
+	    my $vkeys=$hash{"$scope:keys:$rid"};
 	    my @keys=split(/:/,$vkeys);
 	    my $key;
 	    $qresult.="$scope:keys=$vkeys&";
 	    foreach $key (@keys) {
-		$qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
+		$qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";
 	    }                                  
 	}
-	if (&untie_user_hash($hashref)) {
+	if (untie(%hash)) {
 	    $qresult=~s/\&$//;
 	    &Reply( $client, "$qresult\n", $userinput);
 	} else {
@@ -3357,7 +3296,7 @@ sub put_course_id_handler {
             }
 	    $hashref->{$key}=$courseinfo.':'.$now;
 	}
-	if (&untie_domain_hash($hashref)) {
+	if (untie(%$hashref)) {
 	    &Reply( $client, "ok\n", $userinput);
 	} else {
 	    &Failure($client, "error: ".($!+0)
@@ -3473,7 +3412,7 @@ sub dump_course_id_handler {
                 $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';
             }
 	}
-	if (&untie_domain_hash($hashref)) {
+	if (untie(%$hashref)) {
 	    chop($qresult);
 	    &Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -3522,7 +3461,7 @@ sub put_id_handler {
 	    my ($key,$value)=split(/=/,$pair);
 	    $hashref->{$key}=$value;
 	}
-	if (&untie_domain_hash($hashref)) {
+	if (untie(%$hashref)) {
 	    &Reply($client, "ok\n", $userinput);
 	} else {
 	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -3571,7 +3510,7 @@ sub get_id_handler {
 	for (my $i=0;$i<=$#queries;$i++) {
 	    $qresult.="$hashref->{$queries[$i]}&";
 	}
-	if (&untie_domain_hash($hashref)) {
+	if (untie(%$hashref)) {
 	    $qresult=~s/\&$//;
 	    &Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -3615,7 +3554,7 @@ sub put_dcmail_handler {
         my ($key,$value)=split(/=/,$what);
         $hashref->{$key}=$value;
     }
-    if (&untie_domain_hash($hashref)) {
+    if (untie(%$hashref)) {
         &Reply($client, "ok\n", $userinput);
     } else {
         &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -3695,7 +3634,7 @@ sub dump_dcmail_handler {
                 $qresult.=$key.'='.$value.'&';
             }
         }
-        if (&untie_domain_hash($hashref)) {
+        if (untie(%$hashref)) {
             chop($qresult);
             &Reply($client, "$qresult\n", $userinput);
         } else {
@@ -3742,7 +3681,7 @@ sub put_domainroles_handler {
             my ($key,$value)=split(/=/,$pair);
             $hashref->{$key}=$value;
         }
-        if (&untie_domain_hash($hashref)) {
+        if (untie(%$hashref)) {
             &Reply($client, "ok\n", $userinput);
         } else {
             &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -3823,7 +3762,7 @@ sub dump_domainroles_handler {
                 $qresult.=$key.'='.$value.'&';
             }
         }
-        if (&untie_domain_hash($hashref)) {
+        if (untie(%$hashref)) {
             chop($qresult);
             &Reply($client, "$qresult\n", $userinput);
         } else {
@@ -4318,83 +4257,6 @@ sub get_institutional_code_format_handle
 &register_handler("autoinstcodeformat",
 		  \&get_institutional_code_format_handler,0,1,0);
 
-# Get domain specific conditions for import of student photographs to a course
-#
-# Retrieves information from photo_permission subroutine in localenroll.
-# Returns outcome (ok) if no processing errors, and whether course owner is 
-# required to accept conditions of use (yes/no).
-#
-#    
-sub photo_permission_handler {
-    my ($cmd, $tail, $client)   = @_;
-    my $userinput               = "$cmd:$tail";
-    my $cdom = $tail;
-    my ($perm_reqd,$conditions);
-    my $outcome;
-    eval {
-	local($SIG{__DIE__})='DEFAULT';
-	$outcome = &localenroll::photo_permission($cdom,\$perm_reqd,
-						  \$conditions);
-    };
-    if (!$@) {
-	&Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n",
-	       $userinput);
-    } else {
-	&Failure($client,"unknown_cmd\n",$userinput);
-    }
-    return 1;
-}
-&register_handler("autophotopermission",\&photo_permission_handler,0,1,0);
-
-#
-# Checks if student photo is available for a user in the domain, in the user's
-# directory (in /userfiles/internal/studentphoto.jpg).
-# Uses localstudentphoto:fetch() to ensure there is an up to date copy of
-# the student's photo.   
-
-sub photo_check_handler {
-    my ($cmd, $tail, $client)   = @_;
-    my $userinput               = "$cmd:$tail";
-    my ($udom,$uname,$pid) = split(/:/,$tail);
-    $udom = &unescape($udom);
-    $uname = &unescape($uname);
-    $pid = &unescape($pid);
-    my $path=&propath($udom,$uname).'/userfiles/internal/';
-    if (!-e $path) {
-        &mkpath($path);
-    }
-    my $response;
-    my $result = &localstudentphoto::fetch($udom,$uname,$pid,\$response);
-    $result .= ':'.$response;
-    &Reply($client, &escape($result)."\n",$userinput);
-    return 1;
-}
-&register_handler("autophotocheck",\&photo_check_handler,0,1,0);
-
-#
-# Retrieve information from localenroll about whether to provide a button     
-# for users who have enbled import of student photos to initiate an 
-# update of photo files for registered students. Also include 
-# comment to display alongside button.  
-
-sub photo_choice_handler {
-    my ($cmd, $tail, $client) = @_;
-    my $userinput             = "$cmd:$tail";
-    my $cdom                  = &unescape($tail);
-    my ($update,$comment);
-    eval {
-	local($SIG{__DIE__})='DEFAULT';
-	($update,$comment)    = &localenroll::manager_photo_update($cdom);
-    };
-    if (!$@) {
-	&Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput);
-    } else {
-	&Failure($client,"unknown_cmd\n",$userinput);
-    }
-    return 1;
-}
-&register_handler("autophotochoice",\&photo_choice_handler,0,1,0);
-
 #
 # Gets a student's photo to exist (in the correct image type) in the user's 
 # directory.
@@ -4407,36 +4269,24 @@ sub photo_choice_handler {
 #    $client  - The socket open on the client.
 # Returns:
 #    1 - continue processing.
-
 sub student_photo_handler {
     my ($cmd, $tail, $client) = @_;
-    my ($domain,$uname,$ext,$type) = split(/:/, $tail);
+    my ($domain,$uname,$type) = split(/:/, $tail);
 
-    my $path=&propath($domain,$uname). '/userfiles/internal/';
-    my $filename = 'studentphoto.'.$ext;
-    if ($type eq 'thumbnail') {
-        $filename = 'studentphoto_tn.'.$ext;
-    }
-    if (-e $path.$filename) {
+    my $path=&propath($domain,$uname).
+	'/userfiles/internal/studentphoto.'.$type;
+    if (-e $path) {
 	&Reply($client,"ok\n","$cmd:$tail");
 	return 1;
     }
     &mkpath($path);
-    my $file;
-    if ($type eq 'thumbnail') {
-	eval {
-	    local($SIG{__DIE__})='DEFAULT';
-	    $file=&localstudentphoto::fetch_thumbnail($domain,$uname);
-	};
-    } else {
-        $file=&localstudentphoto::fetch($domain,$uname);
-    }
+    my $file=&localstudentphoto::fetch($domain,$uname);
     if (!$file) {
 	&Failure($client,"unavailable\n","$cmd:$tail");
 	return 1;
     }
-    if (!-e $path.$filename) { &convert_photo($file,$path.$filename); }
-    if (-e $path.$filename) {
+    if (!-e $path) { &convert_photo($file,$path); }
+    if (-e $path) {
 	&Reply($client,"ok\n","$cmd:$tail");
 	return 1;
     }
@@ -5759,38 +5609,38 @@ sub addline {
 
 sub get_chat {
     my ($cdom,$cname,$udom,$uname)=@_;
-
+    my %hash;
+    my $proname=&propath($cdom,$cname);
     my @entries=();
-    my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom',
-				 &GDBM_READER());
-    if ($hashref) {
-	@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
-	&untie_user_hash($hashref);
+    if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
+	    &GDBM_READER(),0640)) {
+	@entries=map { $_.':'.$hash{$_} } sort keys %hash;
+	untie %hash;
     }
     my @participants=();
     my $cutoff=time-60;
-    $hashref = &tie_user_hash($cdom, $cname, 'nohist_inchatroom',
-			      &GDBM_WRCREAT());
-    if ($hashref) {
-        $hashref->{$uname.':'.$udom}=time;
-        foreach my $user (sort(keys(%$hashref))) {
-	    if ($hashref->{$user}>$cutoff) {
-		push(@participants, 'active_participant:'.$user);
+    if (tie(%hash,'GDBM_File',"$proname/nohist_inchatroom.db",
+	    &GDBM_WRCREAT(),0640)) {
+        $hash{$uname.':'.$udom}=time;
+        foreach (sort keys %hash) {
+	    if ($hash{$_}>$cutoff) {
+		$participants[$#participants+1]='active_participant:'.$_;
             }
         }
-        &untie_user_hash($hashref);
+        untie %hash;
     }
     return (@participants,@entries);
 }
 
 sub chat_add {
     my ($cdom,$cname,$newchat)=@_;
+    my %hash;
+    my $proname=&propath($cdom,$cname);
     my @entries=();
     my $time=time;
-    my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom',
-				 &GDBM_WRCREAT());
-    if ($hashref) {
-	@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
+    if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
+	    &GDBM_WRCREAT(),0640)) {
+	@entries=map { $_.':'.$hash{$_} } sort keys %hash;
 	my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
 	my ($thentime,$idnum)=split(/\_/,$lastid);
 	my $newid=$time.'_000000';
@@ -5800,22 +5650,21 @@ sub chat_add {
 	    $idnum=substr('000000'.$idnum,-6,6);
 	    $newid=$time.'_'.$idnum;
 	}
-	$hashref->{$newid}=$newchat;
+	$hash{$newid}=$newchat;
 	my $expired=$time-3600;
-	foreach my $comment (keys(%$hashref)) {
-	    my ($thistime) = ($comment=~/(\d+)\_/);
+	foreach (keys %hash) {
+	    my ($thistime)=($_=~/(\d+)\_/);
 	    if ($thistime<$expired) {
-		delete $hashref->{$comment};
+		delete $hash{$_};
 	    }
 	}
-	{
-	    my $proname=&propath($cdom,$cname);
-	    if (open(CHATLOG,">>$proname/chatroom.log")) { 
-		print CHATLOG ("$time:".&unescape($newchat)."\n");
-	    }
-	    close(CHATLOG);
+	untie %hash;
+    }
+    {
+	my $hfh;
+	if ($hfh=IO::File->new(">>$proname/chatroom.log")) { 
+	    print $hfh "$time:".&unescape($newchat)."\n";
 	}
-	&untie_user_hash($hashref);
     }
 }
 
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>500 Internal Server Error</title>
</head><body>
<h1>Internal Server Error</h1>
<p>The server encountered an internal error or
misconfiguration and was unable to complete
your request.</p>
<p>Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.</p>
<p>More information about this error may be available
in the server error log.</p>
</body></html>