loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.376 and 1.422

-version 1.376, 2007/07/25 22:52:07
+version 1.422, 2009/08/18 20:08:13
  Line 33  use strict;
  use lib '/home/httpd/lib/perl/';
  use LONCAPA;
  use LONCAPA::Configuration;
- use Apache::lonnet;
  use IO::Socket;
  use IO::File;
- Line 53  use File::Find;
+ Line 52  use File::Find;
  use LONCAPA::lonlocal;
  use LONCAPA::lonssl;
  use Fcntl qw(:flock);
+ use Apache::lonnet;
  my $DEBUG = 0;		       # Non zero to enable debug log entries.
  Line 135  my @adderrors    = ("ok",
  		    "lcuseradd Unable to make www member of users's group",
  		    "lcuseradd Unable to su to root",
  		    "lcuseradd Unable to set password",
- 		    "lcuseradd Usrname has invalid characters",
+ 		    "lcuseradd Username has invalid characters",
  		    "lcuseradd Password has an invalid character",
  		    "lcuseradd User already exists",
  		    "lcuseradd Could not add user.",
  		    "lcuseradd Password mismatch");
+ # This array are the errors from lcinstallfile:
+ my @installerrors = ("ok",
+ 		     "Initial user id of client not that of www",
+ 		     "Usage error, not enough command line arguments",
+ 		     "Source file name does not exist",
+ 		     "Destination file name does not exist",
+ 		     "Some file operation failed",
+ 		     "Invalid table filename."
+ 		     );
  #
  #   Statistics that are maintained and dislayed in the status line.
- Line 398  sub isClient {
+ Line 408  sub isClient {
  #
  sub ReadManagerTable {
+     &Debug("Reading manager table");
      #   Clean out the old table first..
     foreach my $key (keys %managers) {
- Line 520  sub AdjustHostContents {
+ Line 531  sub AdjustHostContents {
  }
  #
  #   InstallFile: Called to install an administrative file:
- #       - The file is created with <name>.tmp
+ #       - The file is created int a temp directory called <name>.tmp
- #       - The <name>.tmp file is then mv'd to <name>
+ #       - lcinstall file is called to install the file.
- #   This lugubrious procedure is done to ensure that we are never without
+ #         since the web app has no direct write access to the table directory
- #   a valid, even if dated, version of the file regardless of who crashes
- #   and when the crash occurs.
  #
  #  Parameters:
  #       Name of the file
- Line 532  sub AdjustHostContents {
+ Line 541  sub AdjustHostContents {
  #  Return:
  #      nonzero - success.
  #      0       - failure and $! has an errno.
+ # Assumptions:
+ #    File installtion is a relatively infrequent
  #
  sub InstallFile {
      my ($Filename, $Contents) = @_;
-     my $TempFile = $Filename.".tmp";
+ #     my $TempFile = $Filename.".tmp";
+     my $exedir = $perlvar{'lonDaemons'};
+     my $tmpdir = $exedir.'/tmp/';
+     my $TempFile = $tmpdir."TempTableFile.tmp";
      #  Open the file for write:
- Line 550  sub InstallFile {
+ Line 564  sub InstallFile {
      print $fh ($Contents);
      $fh->close;			# In case we ever have a filesystem w. locking
-     chmod(0660, $TempFile);
+     chmod(0664, $TempFile);	# Everyone can write it.
-     # Now we can move install the file in position.
+     # Use lcinstall file to put the file in the table directory...
-     move($TempFile, $Filename);
+     &Debug("Opening pipe to $exedir/lcinstallfile $TempFile $Filename");
+     my $pf = IO::File->new("| $exedir/lcinstallfile   $TempFile $Filename > $exedir/logs/lcinstallfile.log");
+     close $pf;
+     my $err = $?;
+     &Debug("Status is $err");
+     if ($err != 0) {
+ 	my $msg = $err;
+ 	if ($err < @installerrors) {
+ 	    $msg = $installerrors[$err];
+ 	}
+ 	&logthis("Install failed for table file $Filename : $msg");
+ 	return 0;
+     }
+     # Remove the temp file:
+     unlink($TempFile);
      return 1;
  }
- Line 562  sub InstallFile {
+ Line 592  sub InstallFile {
  #
  #   ConfigFileFromSelector: converts a configuration file selector
- #                 (one of host or domain at this point) into a
+ #                 into a configuration file pathname.
- #                 configuration file pathname.
+ #                 It's probably no longer necessary to preserve
+ #                 special handling of hosts or domain as those
+ #                 files have been superceded by dns_hosts, dns_domain.
+ #                 The default action is just to prepend the directory
+ #                 and append .tab
+ #
  #
  #  Parameters:
  #      selector  - Configuration file selector.
- Line 580  sub ConfigFileFromSelector {
+ Line 615  sub ConfigFileFromSelector {
      } elsif ($selector eq "domain") {
  	$tablefile = $tabledir."domain.tab";
      } else {
- 	return undef;
+ 	$tablefile =  $tabledir.$selector.'.tab';
      }
      return $tablefile;
- Line 603  sub ConfigFileFromSelector {
+ Line 638  sub ConfigFileFromSelector {
  sub PushFile {
      my $request = shift;
      my ($command, $filename, $contents) = split(":", $request, 3);
+     &Debug("PushFile");
      #  At this point in time, pushes for only the following tables are
      #  supported:
- Line 619  sub PushFile {
+ Line 655  sub PushFile {
      if(! (defined $tablefile)) {
  	return "refused";
      }
-     #
-     # >copy< the old table to the backup table
-     #        don't rename in case system crashes/reboots etc. in the time
-     #        window between a rename and write.
-     #
-     my $backupfile = $tablefile;
-     $backupfile    =~ s/\.tab$/.old/;
-     if(!CopyFile($tablefile, $backupfile)) {
- 	&logthis('<font color="green"> CopyFile from '.$tablefile." to ".$backupfile." failed </font>");
- 	return "error:$!";
-     }
-     &logthis('<font color="green"> Pushfile: backed up '
- 	    .$tablefile." to $backupfile</font>");
      #  If the file being pushed is the host file, we adjust the entry for ourself so that the
      #  IP will be our current IP as looked up in dns.  Note this is only 99% good as it's possible
      #  to conceive of conditions where we don't have a DNS entry locally.  This is possible in a
- Line 645  sub PushFile {
+ Line 668  sub PushFile {
      #  Install the new file:
+     &logthis("Installing new $tablefile contents:\n$contents");
      if(!InstallFile($tablefile, $contents)) {
  	&logthis('<font color="red"> Pushfile: unable to install '
  	 .$tablefile." $! </font>");
- Line 996  sub ping_handler {
+ Line 1020  sub ping_handler {
      my ($cmd, $tail, $client) = @_;
      Debug("$cmd $tail $client .. $currenthostid:");
-     Reply( $client,"$currenthostid\n","$cmd:$tail");
+     Reply( $client,\$currenthostid,"$cmd:$tail");
      return 1;
  }
- Line 1066  sub establish_key_handler {
+ Line 1090  sub establish_key_handler {
      $key=substr($key,0,32);
      my $cipherkey=pack("H32",$key);
      $cipher=new IDEA $cipherkey;
-     &Reply($replyfd, "$buildkey\n", "$cmd:$tail");
+     &Reply($replyfd, \$buildkey, "$cmd:$tail");
      return 1;
- Line 1103  sub load_handler {
+ Line 1127  sub load_handler {
      my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
-     &Reply( $replyfd, "$loadpercent\n", "$cmd:$tail");
+     &Reply( $replyfd, \$loadpercent, "$cmd:$tail");
      return 1;
  }
- Line 1133  sub user_load_handler {
+ Line 1157  sub user_load_handler {
      my ($cmd, $tail, $replyfd) = @_;
      my $userloadpercent=&Apache::lonnet::userload();
-     &Reply($replyfd, "$userloadpercent\n", "$cmd:$tail");
+     &Reply($replyfd, \$userloadpercent, "$cmd:$tail");
      return 1;
  }
- Line 1176  sub user_authorization_type {
+ Line 1200  sub user_authorization_type {
  	} else {
              $type .= ':';
          }
- 	&Reply( $replyfd, "$type\n", $userinput);
+ 	&Reply( $replyfd, \$type, $userinput);
      }
      return 1;
- Line 1198  sub user_authorization_type {
+ Line 1222  sub user_authorization_type {
  #    a reply is written to the client.
  sub push_file_handler {
      my ($cmd, $tail, $client) = @_;
+     &Debug("In push file handler");
      my $userinput = "$cmd:$tail";
      # At this time we only know that the IP of our partner is a valid manager
- Line 1206  sub push_file_handler {
+ Line 1230  sub push_file_handler {
      # spoofing).
      my $cert = &GetCertificate($userinput);
      if(&ValidManager($cert)) {
+ 	&Debug("Valid manager: $client");
  	# Now presumably we have the bona fides of both the peer host and the
  	# process making the request.
  	my $reply = &PushFile($userinput);
- 	&Reply($client, "$reply\n", $userinput);
+ 	&Reply($client, \$reply, $userinput);
      } else {
+ 	&logthis("push_file_handler $client is not valid");
  	&Failure( $client, "refused\n", $userinput);
      }
      return 1;
  }
  &register_handler("pushfile", \&push_file_handler, 1, 0, 1);
+ # The du_handler routine should be considered obsolete and is retained
+ # for communication with legacy servers.  Please see the du2_handler.
  #
- #   du  - list the disk usuage of a directory recursively.
+ #   du  - list the disk usage of a directory recursively.
  #
  #   note: stolen code from the ls file handler
  #   under construction by Rick Banghart
- Line 1264  sub du_handler {
+ Line 1292  sub du_handler {
  	chdir($ududir);
  	find($code,$ududir);
  	$total_size=int($total_size/1024);
- 	&Reply($client,"$total_size\n","$cmd:$ududir");
+ 	&Reply($client,\$total_size,"$cmd:$ududir");
      } else {
  	&Failure($client, "bad_directory:$ududir\n","$cmd:$ududir");
      }
- Line 1272  sub du_handler {
+ Line 1300  sub du_handler {
  }
  &register_handler("du", \&du_handler, 0, 1, 0);
+ # Please also see the du_handler, which is obsoleted by du2.
+ # du2_handler differs from du_handler in that required path to directory
+ # provided by &propath() is prepended in the handler instead of on the
+ # client side.
+ #
+ #   du2  - list the disk usage of a directory recursively.
  #
- # The ls_handler routine should be considered obosolete and is retained
+ # Parameters:
- # for communication with legacy servers.  Please see the ls2_handler.
+ #    $cmd        - The command that dispatched us (du).
+ #    $tail       - The tail of the request that invoked us.
+ #                  $tail is a : separated list of the following:
+ #                   - $ududir - directory path to list (before prepending)
+ #                   - $getpropath = 1 if &propath() should prepend
+ #                   - $uname - username to use for &propath or user dir
+ #                   - $udom - domain to use for &propath or user dir
+ #                   All are escaped.
+ #    $client     - Socket open on the client.
+ # Returns:
+ #     1 - indicating that the daemon should not disconnect.
+ # Side Effects:
+ #   The reply is written to $client.
+ #
+ sub du2_handler {
+     my ($cmd, $tail, $client) = @_;
+     my ($ududir,$getpropath,$uname,$udom) = map { &unescape($_) } (split(/:/, $tail));
+     my $userinput = "$cmd:$tail";
+     if (($ududir=~/\.\./) || (($ududir!~m|^/home/httpd/|) && (!$getpropath))) {
+         &Failure($client,"refused\n","$cmd:$tail");
+         return 1;
+     }
+     if ($getpropath) {
+         if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) {
+             $ududir = &propath($udom,$uname).'/'.$ududir;
+         } else {
+             &Failure($client,"refused\n","$cmd:$tail");
+             return 1;
+         }
+     }
+     #  Since $ududir could have some nasties in it,
+     #  we will require that ududir is a valid
+     #  directory.  Just in case someone tries to
+     #  slip us a  line like .;(cd /home/httpd rm -rf*)
+     #  etc.
+     #
+     if (-d $ududir) {
+         my $total_size=0;
+         my $code=sub {
+             if ($_=~/\.\d+\./) { return;}
+             if ($_=~/\.meta$/) { return;}
+             if (-d $_)         { return;}
+             $total_size+=(stat($_))[7];
+         };
+         chdir($ududir);
+         find($code,$ududir);
+         $total_size=int($total_size/1024);
+         &Reply($client,\$total_size,"$cmd:$ududir");
+     } else {
+         &Failure($client, "bad_directory:$ududir\n","$cmd:$tail");
+     }
+     return 1;
+ }
+ &register_handler("du2", \&du2_handler, 0, 1, 0);
+ #
+ # The ls_handler routine should be considered obsolete and is retained
+ # for communication with legacy servers.  Please see the ls3_handler.
  #
  #   ls  - list the contents of a directory.  For each file in the
  #    selected directory the filename followed by the full output of
- Line 1333  sub ls_handler {
+ Line 1425  sub ls_handler {
  	$ulsout='no_such_dir';
      }
      if ($ulsout eq '') { $ulsout='empty'; }
-     &Reply($client, "$ulsout\n", $userinput); # This supports debug logging.
+     &Reply($client, \$ulsout, $userinput); # This supports debug logging.
      return 1;
  }
  &register_handler("ls", \&ls_handler, 0, 1, 0);
- #
+ # The ls2_handler routine should be considered obsolete and is retained
- # Please also see the ls_handler, which this routine obosolets.
+ # for communication with legacy servers.  Please see the ls3_handler.
+ # Please also see the ls_handler, which was itself obsoleted by ls2.
  # ls2_handler differs from ls_handler in that it escapes its return
  # values before concatenating them together with ':'s.
  #
- Line 1402  sub ls2_handler {
+ Line 1495  sub ls2_handler {
          $ulsout='no_such_dir';
     }
     if ($ulsout eq '') { $ulsout='empty'; }
-    &Reply($client, "$ulsout\n", $userinput); # This supports debug logging.
+    &Reply($client, \$ulsout, $userinput); # This supports debug logging.
     return 1;
  }
  &register_handler("ls2", \&ls2_handler, 0, 1, 0);
+ #
+ #   ls3  - list the contents of a directory.  For each file in the
+ #    selected directory the filename followed by the full output of
+ #    the stat function is returned.  The returned info for each
+ #    file are separated by ':'.  The stat fields are separated by &'s.
+ # Parameters:
+ #    $cmd        - The command that dispatched us (ls).
+ #    $tail       - The tail of the request that invoked us.
+ #                  $tail is a : separated list of the following:
+ #                   - $ulsdir - directory path to list (before prepending)
+ #                   - $getpropath = 1 if &propath() should prepend
+ #                   - $getuserdir = 1 if path to user dir in lonUsers should
+ #                                     prepend
+ #                   - $alternate_root - path to prepend
+ #                   - $uname - username to use for &propath or user dir
+ #                   - $udom - domain to use for &propath or user dir
+ #            All of these except $getpropath and &getuserdir are escaped.
+ #                  no_such_dir.
+ #    $client     - Socket open on the client.
+ # Returns:
+ #     1 - indicating that the daemon should not disconnect.
+ # Side Effects:
+ #   The reply is written to $client.
+ #
+ sub ls3_handler {
+     my ($cmd, $tail, $client) = @_;
+     my $userinput = "$cmd:$tail";
+     my ($ulsdir,$getpropath,$getuserdir,$alternate_root,$uname,$udom) =
+         split(/:/,$tail);
+     if (defined($ulsdir)) {
+         $ulsdir = &unescape($ulsdir);
+     }
+     if (defined($alternate_root)) {
+         $alternate_root = &unescape($alternate_root);
+     }
+     if (defined($uname)) {
+         $uname = &unescape($uname);
+     }
+     if (defined($udom)) {
+         $udom = &unescape($udom);
+     }
+     my $dir_root = $perlvar{'lonDocRoot'};
+     if ($getpropath) {
+         if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) {
+             $dir_root = &propath($udom,$uname);
+             $dir_root =~ s/\/$//;
+         } else {
+             &Failure($client,"refused\n","$cmd:$tail");
+             return 1;
+         }
+     } elsif ($getuserdir) {
+         if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) {
+             my $subdir=$uname.'__';
+             $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
+             $dir_root = $Apache::lonnet::perlvar{'lonUsersDir'}
+                        ."/$udom/$subdir/$uname";
+         } else {
+             &Failure($client,"refused\n","$cmd:$tail");
+             return 1;
+         }
+     } elsif ($alternate_root ne '') {
+         $dir_root = $alternate_root;
+     }
+     if (($dir_root ne '') && ($dir_root ne '/')) {
+         if ($ulsdir =~ /^\//) {
+             $ulsdir = $dir_root.$ulsdir;
+         } else {
+             $ulsdir = $dir_root.'/'.$ulsdir;
+         }
+     }
+     my $obs;
+     my $rights;
+     my $ulsout='';
+     my $ulsfn;
+     if (-e $ulsdir) {
+         if(-d $ulsdir) {
+             if (opendir(LSDIR,$ulsdir)) {
+                 while ($ulsfn=readdir(LSDIR)) {
+                     undef($obs);
+                     undef($rights);
+                     my @ulsstats=stat($ulsdir.'/'.$ulsfn);
+                     #We do some obsolete checking here
+                     if(-e $ulsdir.'/'.$ulsfn.".meta") {
+                         open(FILE, $ulsdir.'/'.$ulsfn.".meta");
+                         my @obsolete=<FILE>;
+                         foreach my $obsolete (@obsolete) {
+                             if($obsolete =~ m/(<obsolete>)(on|1)/) { $obs = 1; }
+                             if($obsolete =~ m|(<copyright>)(default)|) {
+                                 $rights = 1;
+                             }
+                         }
+                     }
+                     my $tmp = $ulsfn.'&'.join('&',@ulsstats);
+                     if ($obs    eq '1') { $tmp.="&1"; } else { $tmp.="&0"; }
+                     if ($rights eq '1') { $tmp.="&1"; } else { $tmp.="&0"; }
+                     $ulsout.= &escape($tmp).':';
+                 }
+                 closedir(LSDIR);
+             }
+         } else {
+             my @ulsstats=stat($ulsdir);
+             $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
+         }
+     } else {
+         $ulsout='no_such_dir';
+     }
+     if ($ulsout eq '') { $ulsout='empty'; }
+     &Reply($client, \$ulsout, $userinput); # This supports debug logging.
+     return 1;
+ }
+ &register_handler("ls3", \&ls3_handler, 0, 1, 0);
+ sub server_timezone_handler {
+     my ($cmd,$tail,$client) = @_;
+     my $userinput = "$cmd:$tail";
+     my $timezone;
+     my $clockfile = '/etc/sysconfig/clock'; # Fedora/CentOS/SuSE
+     my $tzfile = '/etc/timezone'; # Debian/Ubuntu
+     if (-e $clockfile) {
+         if (open(my $fh,"<$clockfile")) {
+             while (<$fh>) {
+                 next if (/^[\#\s]/);
+                 if (/^(?:TIME)?ZONE\s*=\s*['"]?\s*([\w\/]+)/) {
+                     $timezone = $1;
+                     last;
+                 }
+             }
+             close($fh);
+         }
+     } elsif (-e $tzfile) {
+         if (open(my $fh,"<$tzfile")) {
+             $timezone = <$fh>;
+             close($fh);
+             chomp($timezone);
+             if ($timezone =~ m{^Etc/(\w+)$}) {
+                 $timezone = $1;
+             }
+         }
+     }
+     &Reply($client,\$timezone,$userinput); # This supports debug logging.
+     return 1;
+ }
+ &register_handler("servertimezone", \&server_timezone_handler, 0, 1, 0);
+ sub server_loncaparev_handler {
+     my ($cmd,$tail,$client) = @_;
+     my $userinput = "$cmd:$tail";
+     &Reply($client,\$perlvar{'lonVersion'},$userinput);
+     return 1;
+ }
+ &register_handler("serverloncaparev", \&server_loncaparev_handler, 0, 1, 0);
  #   Process a reinit request.  Reinit requests that either
  #   lonc or lond be reinitialized so that an updated
- Line 1430  sub reinit_process_handler {
+ Line 1676  sub reinit_process_handler {
      if(&ValidManager($cert)) {
  	chomp($userinput);
  	my $reply = &ReinitProcess($userinput);
- 	&Reply( $client,  "$reply\n", $userinput);
+ 	&Reply( $client,  \$reply, $userinput);
      } else {
  	&Failure( $client, "refused\n", $userinput);
      }
- Line 1514  sub authenticate_handler {
+ Line 1760  sub authenticate_handler {
      #  udom    - User's domain.
      #  uname   - Username.
      #  upass   - User's password.
+     #  checkdefauth - Pass to validate_user() to try authentication
+     #                 with default auth type(s) if no user account.
-     my ($udom,$uname,$upass)=split(/:/,$tail);
+     my ($udom, $uname, $upass, $checkdefauth)=split(/:/,$tail);
-     &Debug(" Authenticate domain = $udom, user = $uname, password = $upass");
+     &Debug(" Authenticate domain = $udom, user = $uname, password = $upass,  checkdefauth = $checkdefauth");
      chomp($upass);
      $upass=&unescape($upass);
-     my $pwdcorrect = &validate_user($udom, $uname, $upass);
+     my $pwdcorrect = &validate_user($udom,$uname,$upass,$checkdefauth);
      if($pwdcorrect) {
  	&Reply( $client, "authorized\n", $userinput);
  	#
- Line 1605  sub change_password_handler {
+ Line 1853  sub change_password_handler {
  	    my $result = &change_unix_password($uname, $npass);
  	    &logthis("Result of password change for $uname: ".
  		     $result);
- 	    &Reply($client, "$result\n", $userinput);
+ 	    &Reply($client, \$result, $userinput);
  	} else {
  	    # this just means that the current password mode is not
  	    # one we know how to change (e.g the kerberos auth modes or
- Line 1666  sub add_user_handler {
+ Line 1914  sub add_user_handler {
  	    }
  	    unless ($fperror) {
  		my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);
- 		&Reply($client, $result, $userinput);     #BUGBUG - could be fail
+ 		&Reply($client,\$result, $userinput);     #BUGBUG - could be fail
  	    } else {
- 		&Failure($client, "$fperror\n", $userinput);
+ 		&Failure($client, \$fperror, $userinput);
  	    }
  	}
  	umask($oldumask);
- Line 1735  sub change_authentication_handler {
+ Line 1983  sub change_authentication_handler {
  		my $result = &change_unix_password($uname, $npass);
  		&logthis("Result of password change for $uname: ".$result);
  		if ($result eq "ok") {
- 		    &Reply($client, "$result\n")
+ 		    &Reply($client, \$result);
  		} else {
- 		    &Failure($client, "$result\n");
+ 		    &Failure($client, \$result);
  		}
  	    } else {
  		my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
- Line 1756  sub change_authentication_handler {
+ Line 2004  sub change_authentication_handler {
  			&manage_permissions("/$udom/_au", $udom, $uname, "$umode:");
  		    }
  		}
- 		&Reply($client, $result, $userinput);
+ 		&Reply($client, \$result, $userinput);
  	    }
- Line 2095  sub rename_user_file_handler {
+ Line 2343  sub rename_user_file_handler {
  &register_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);
  #
+ #  Checks if the specified user has an active session on the server
+ #  return ok if so, not_found if not
+ #
+ # Parameters:
+ #   cmd      - The request keyword that dispatched to tus.
+ #   tail     - The tail of the request (colon separated parameters).
+ #   client   - Filehandle open on the client.
+ # Return:
+ #    1.
+ sub user_has_session_handler {
+     my ($cmd, $tail, $client) = @_;
+     my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));
+     &logthis("Looking for $udom $uname");
+     opendir(DIR,$perlvar{'lonIDsDir'});
+     my $filename;
+     while ($filename=readdir(DIR)) {
+ 	last if ($filename=~/^\Q$uname\E_\d+_\Q$udom\E_/);
+     }
+     if ($filename) {
+ 	&Reply($client, "ok\n", "$cmd:$tail");
+     } else {
+ 	&Failure($client, "not_found\n", "$cmd:$tail");
+     }
+     return 1;
+ }
+ &register_handler("userhassession", \&user_has_session_handler, 0,1,0);
+ #
  #  Authenticate access to a user file by checking that the token the user's
  #  passed also exists in their session file
  #
- Line 2110  sub token_auth_user_file_handler {
+ Line 2389  sub token_auth_user_file_handler {
      my ($fname, $session) = split(/:/, $tail);
      chomp($session);
-     my $reply="non_auth\n";
+     my $reply="non_auth";
      my $file = $perlvar{'lonIDsDir'}.'/'.$session.'.id';
      if (open(ENVIN,"$file")) {
  	flock(ENVIN,LOCK_SH);
  	tie(my %disk_env,'GDBM_File',"$file",&GDBM_READER(),0640);
  	if (exists($disk_env{"userfile.$fname"})) {
- 	    $reply="ok\n";
+ 	    $reply="ok";
  	} else {
  	    foreach my $envname (keys(%disk_env)) {
  		if ($envname=~ m|^userfile\.\Q$fname\E|) {
- 		    $reply="ok\n";
+ 		    $reply="ok";
  		    last;
  		}
  	    }
  	}
  	untie(%disk_env);
  	close(ENVIN);
- 	&Reply($client, $reply, "$cmd:$tail");
+ 	&Reply($client, \$reply, "$cmd:$tail");
      } else {
  	&Failure($client, "invalid_token\n", "$cmd:$tail");
      }
- Line 2187  sub subscribe_handler {
+ Line 2466  sub subscribe_handler {
  &register_handler("sub", \&subscribe_handler, 0, 1, 0);
  #
- #   Determine the version of a resource (?) Or is it return
+ #   Determine the latest version of a resource (it looks for the highest
- #   the top version of the resource?  Not yet clear from the
+ #   past version and then returns that +1)
- #   code in currentversion.
  #
  # Parameters:
  #    $cmd      - The command that got us here.
  #    $tail     - Tail of the command (remaining parameters).
+ #                 (Should consist of an absolute path to a file)
  #    $client   - File descriptor connected to client.
  # Returns
  #     0        - Requested to exit, caller should shut down.
- Line 2551  sub get_profile_entry {
+ Line 2830  sub get_profile_entry {
      my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
      chomp($what);
      my $replystring = read_profile($udom, $uname, $namespace, $what);
      my ($first) = split(/:/,$replystring);
      if($first ne "error") {
- 	&Reply($client, "$replystring\n", $userinput);
+ 	&Reply($client, \$replystring, $userinput);
      } else {
  	&Failure($client, $replystring." while attempting get\n", $userinput);
      }
- Line 2694  sub get_profile_keys {
+ Line 2974  sub get_profile_keys {
  	}
  	if (&untie_user_hash($hashref)) {
  	    $qresult=~s/\&$//;
- 	    &Reply($client, "$qresult\n", $userinput);
+ 	    &Reply($client, \$qresult, $userinput);
  	} else {
  	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
  		    "while attempting keys\n", $userinput);
- Line 2764  sub dump_profile_database {
+ Line 3044  sub dump_profile_database {
  		}
  	    }
  	    chop($qresult);
- 	    &Reply($client , "$qresult\n", $userinput);
+ 	    &Reply($client , \$qresult, $userinput);
  	} else {
  	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
  		     "while attempting currentdump\n", $userinput);
- Line 2847  sub dump_with_regexp {
+ Line 3127  sub dump_with_regexp {
  	}
  	if (&untie_user_hash($hashref)) {
  	    chop($qresult);
- 	    &Reply($client, "$qresult\n", $userinput);
+ 	    &Reply($client, \$qresult, $userinput);
  	} else {
  	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
  		     "while attempting dump\n", $userinput);
- Line 3055  sub restore_handler {
+ Line 3335  sub restore_handler {
  	}
  	if (&untie_user_hash($hashref)) {
  	    $qresult=~s/\&$//;
- 	    &Reply( $client, "$qresult\n", $userinput);
+ 	    &Reply( $client, \$qresult, $userinput);
  	} else {
  	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
  		    "while attempting restore\n", $userinput);
- Line 3136  sub retrieve_chat_handler {
+ Line 3416  sub retrieve_chat_handler {
  	$reply.=&escape($_).':';
      }
      $reply=~s/\:$//;
-     &Reply($client, $reply."\n", $userinput);
+     &Reply($client, \$reply, $userinput);
      return 1;
- Line 3273  sub put_course_id_handler {
+ Line 3553  sub put_course_id_handler {
  	foreach my $pair (@pairs) {
              my ($key,$courseinfo) = split(/=/,$pair,2);
              $courseinfo =~ s/=/:/g;
+             if (defined($hashref->{$key})) {
+                 my $value = &Apache::lonnet::thaw_unescape($hashref->{$key});
+                 if (ref($value) eq 'HASH') {
+                     my @items = ('description','inst_code','owner','type');
+                     my @new_items = split(/:/,$courseinfo,-1);
+                     my %storehash;
+                     for (my $i=0; $i<@new_items; $i++) {
+                         $storehash{$items[$i]} = &unescape($new_items[$i]);
+                     }
+                     $hashref->{$key} =
+                         &Apache::lonnet::freeze_escape(\%storehash);
+                     my $unesc_key = &unescape($key);
+                     $hashref->{&escape('lasttime:'.$unesc_key)} = $now;
+                     next;
+                 }
+             }
              my @current_items = split(/:/,$hashref->{$key},-1);
              shift(@current_items); # remove description
              pop(@current_items);   # remove last access
- Line 3289  sub put_course_id_handler {
+ Line 3585  sub put_course_id_handler {
                      }
                  }
              }
- 	    $hashref->{$key}=$courseinfo.':'.$now;
+             $hashref->{$key}=$courseinfo.':'.$now;
  	}
  	if (&untie_domain_hash($hashref)) {
  	    &Reply( $client, "ok\n", $userinput);
- Line 3303  sub put_course_id_handler {
+ Line 3599  sub put_course_id_handler {
  		 ." tie(GDBM) Failed ".
  		 "while attempting courseidput\n", $userinput);
      }
      return 1;
  }
  &register_handler("courseidput", \&put_course_id_handler, 0, 1, 0);
+ sub put_course_id_hash_handler {
+     my ($cmd, $tail, $client) = @_;
+     my $userinput = "$cmd:$tail";
+     my ($udom,$mode,$what) = split(/:/, $tail,3);
+     chomp($what);
+     my $now=time;
+     my @pairs=split(/\&/,$what);
+     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
+     if ($hashref) {
+         foreach my $pair (@pairs) {
+             my ($key,$value)=split(/=/,$pair);
+             my $unesc_key = &unescape($key);
+             if ($mode ne 'timeonly') {
+                 if (!defined($hashref->{&escape('lasttime:'.$unesc_key)})) {
+                     my $curritems = &Apache::lonnet::thaw_unescape($key);
+                     if (ref($curritems) ne 'HASH') {
+                         my @current_items = split(/:/,$hashref->{$key},-1);
+                         my $lasttime = pop(@current_items);
+                         $hashref->{&escape('lasttime:'.$unesc_key)} = $lasttime;
+                     } else {
+                         $hashref->{&escape('lasttime:'.$unesc_key)} = '';
+                     }
+                 }
+                 $hashref->{$key} = $value;
+             }
+             if ($mode ne 'notime') {
+                 $hashref->{&escape('lasttime:'.$unesc_key)} = $now;
+             }
+         }
+         if (&untie_domain_hash($hashref)) {
+             &Reply($client, "ok\n", $userinput);
+         } else {
+             &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+                      "while attempting courseidputhash\n", $userinput);
+         }
+     } else {
+         &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+                   "while attempting courseidputhash\n", $userinput);
+     }
+     return 1;
+ }
+ &register_handler("courseidputhash", \&put_course_id_hash_handler, 0, 1, 0);
  #  Retrieves the value of a course id resource keyword pattern
  #  defined since a starting date.  Both the starting date and the
  #  keyword pattern are optional.  If the starting date is not supplied it
- Line 3335  sub put_course_id_handler {
+ Line 3673  sub put_course_id_handler {
  #                            owner matches the supplied username and/or domain
  #                            will be returned. Pre-2.2.0 legacy entries from
  #                            nohist_courseiddump will only contain usernames.
+ #                 type     - optional parameter for selection
+ #                 regexp_ok - if 1 or -1 allow the supplied institutional code
+ #                            filter to behave as a regular expression:
+ #	                      1 will not exclude the course if the instcode matches the RE
+ #                            -1 will exclude the course if the instcode matches the RE
+ #                 rtn_as_hash - whether to return the information available for
+ #                            each matched item as a frozen hash of all
+ #                            key, value pairs in the item's hash, or as a
+ #                            colon-separated list of (in order) description,
+ #                            institutional code, and course owner.
+ #                 selfenrollonly - filter by courses allowing self-enrollment
+ #                                  now or in the future (selfenrollonly = 1).
+ #                 catfilter - filter by course category, assigned to a course
+ #                             using manually defined categories (i.e., not
+ #                             self-cataloging based on on institutional code).
+ #                 showhidden - include course in results even if course
+ #                              was set to be excluded from course catalog (DC only).
+ #                 caller -  if set to 'coursecatalog', courses set to be hidden
+ #                           from course catalog will be excluded from results (unless
+ #                           overridden by "showhidden".
+ #                 cloner - escaped username:domain of course cloner (if picking course to#
+ #                          clone).
+ #                 cc_clone_list - escaped comma separated list of courses for which
+ #                                 course cloner has active CC role (and so can clone
+ #                                 automatically).
+ #                 cloneonly - filter by courses for which cloner has rights to clone.
+ #
  #     $client  - The socket open on the client.
  # Returns:
  #    1     - Continue processing.
- Line 3342  sub put_course_id_handler {
+ Line 3707  sub put_course_id_handler {
  #   a reply is written to $client.
  sub dump_course_id_handler {
      my ($cmd, $tail, $client) = @_;
      my $userinput = "$cmd:$tail";
      my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
-         $typefilter,$regexp_ok) =split(/:/,$tail);
+         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
+         $caller,$cloner,$cc_clone_list,$cloneonly) =split(/:/,$tail);
+     my $now = time;
+     my ($cloneruname,$clonerudom,%cc_clone);
      if (defined($description)) {
  	$description=&unescape($description);
      } else {
- Line 3386  sub dump_course_id_handler {
+ Line 3753  sub dump_course_id_handler {
      if (defined($regexp_ok)) {
          $regexp_ok=&unescape($regexp_ok);
      }
+     if (defined($catfilter)) {
-     unless (defined($since)) { $since=0; }
+         $catfilter=&unescape($catfilter);
+     }
+     if (defined($cloner)) {
+         $cloner = &unescape($cloner);
+         ($cloneruname,$clonerudom) = ($cloner =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/);
+     }
+     if (defined($cc_clone_list)) {
+         $cc_clone_list = &unescape($cc_clone_list);
+         my @cc_cloners = split('&',$cc_clone_list);
+         foreach my $cid (@cc_cloners) {
+             my ($clonedom,$clonenum) = split(':',$cid);
+             next if ($clonedom ne $udom);
+             $cc_clone{$clonedom.'_'.$clonenum} = 1;
+         }
+     }
+     my $unpack = 1;
+     if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' &&
+         $typefilter eq '.') {
+         $unpack = 0;
+     }
+     if (!defined($since)) { $since=0; }
      my $qresult='';
      my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
      if ($hashref) {
  	while (my ($key,$value) = each(%$hashref)) {
- 	    my ($descr,$lasttime,$inst_code,$owner,$type);
+             my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,
-             my @courseitems = split(/:/,$value);
+                 %unesc_val,$selfenroll_end,$selfenroll_types);
-             $lasttime = pop(@courseitems);
+             $unesc_key = &unescape($key);
- 	    ($descr,$inst_code,$owner,$type)=@courseitems;
+             if ($unesc_key =~ /^lasttime:/) {
- 	    if ($lasttime<$since) { next; }
+                 next;
+             } else {
+                 $lasttime_key = &escape('lasttime:'.$unesc_key);
+             }
+             if ($hashref->{$lasttime_key} ne '') {
+                 $lasttime = $hashref->{$lasttime_key};
+                 next if ($lasttime<$since);
+             }
+             my ($canclone,$valchange);
+             my $items = &Apache::lonnet::thaw_unescape($value);
+             if (ref($items) eq 'HASH') {
+                 $is_hash =  1;
+                 if (defined($clonerudom)) {
+                     if ($items->{'cloners'}) {
+                         my @cloneable = split(',',$items->{'cloners'});
+                         if (@cloneable) {
+                             if (grep(/^\*$/,@cloneable))  {
+                                 $canclone = 1;
+                             } elsif (grep(/^\*:\Q$clonerudom\E$/,@cloneable)) {
+                                 $canclone = 1;
+                             } elsif (grep(/^\Q$cloneruname\E:\Q$clonerudom\E$/,@cloneable)) {
+                                 $canclone = 1;
+                             }
+                         }
+                         unless ($canclone) {
+                             if ($cloneruname ne '' && $clonerudom ne '') {
+                                 if ($cc_clone{$unesc_key}) {
+                                     $canclone = 1;
+                                     $items->{'cloners'} .= ','.$cloneruname.':'.
+                                                            $clonerudom;
+                                     $valchange = 1;
+                                 }
+                             }
+                         }
+                     } elsif (defined($cloneruname)) {
+                         if ($cc_clone{$unesc_key}) {
+                             $canclone = 1;
+                             $items->{'cloners'} = $cloneruname.':'.$clonerudom;
+                             $valchange = 1;
+                         }
+                     }
+                 }
+                 if ($unpack || !$rtn_as_hash) {
+                     $unesc_val{'descr'} = $items->{'description'};
+                     $unesc_val{'inst_code'} = $items->{'inst_code'};
+                     $unesc_val{'owner'} = $items->{'owner'};
+                     $unesc_val{'type'} = $items->{'type'};
+                     $unesc_val{'cloners'} = $items->{'cloners'};
+                 }
+                 $selfenroll_types = $items->{'selfenroll_types'};
+                 $selfenroll_end = $items->{'selfenroll_end_date'};
+                 if ($selfenrollonly) {
+                     next if (!$selfenroll_types);
+                     if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {
+                         next;
+                     }
+                 }
+                 if ($catfilter ne '') {
+                     next if ($items->{'categories'} eq '');
+                     my @categories = split('&',$items->{'categories'});
+                     next if (@categories == 0);
+                     my @subcats = split('&',$catfilter);
+                     my $matchcat = 0;
+                     foreach my $cat (@categories) {
+                         if (grep(/^\Q$cat\E$/,@subcats)) {
+                             $matchcat = 1;
+                             last;
+                         }
+                     }
+                     next if (!$matchcat);
+                 }
+                 if ($caller eq 'coursecatalog') {
+                     if ($items->{'hidefromcat'} eq 'yes') {
+                         next if !$showhidden;
+                     }
+                 }
+             } else {
+                 next if ($catfilter ne '');
+                 next if ($selfenrollonly);
+                 if ((defined($clonerudom)) && (defined($cloneruname)))  {
+                     if ($cc_clone{$unesc_key}) {
+                         $canclone = 1;
+                         $val{'cloners'} = &escape($cloneruname.':'.$clonerudom);
+                     }
+                 }
+                 $is_hash =  0;
+                 my @courseitems = split(/:/,$value);
+                 $lasttime = pop(@courseitems);
+                 if ($hashref->{$lasttime_key} eq '') {
+                     next if ($lasttime<$since);
+                 }
+ 	        ($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;
+             }
+             if ($cloneonly) {
+                next unless ($canclone);
+             }
              my $match = 1;
- 	    unless ($description eq '.') {
+ 	    if ($description ne '.') {
- 		my $unescapeDescr = &unescape($descr);
+                 if (!$is_hash) {
- 		unless (eval('$unescapeDescr=~/\Q$description\E/i')) {
+                     $unesc_val{'descr'} = &unescape($val{'descr'});
+                 }
+                 if (eval{$unesc_val{'descr'} !~ /\Q$description\E/i}) {
                      $match = 0;
- 		}
+                 }
              }
-             unless ($instcodefilter eq '.' || !defined($instcodefilter)) {
+             if ($instcodefilter ne '.') {
-                 my $unescapeInstcode = &unescape($inst_code);
+                 if (!$is_hash) {
-                 if ($regexp_ok) {
+                     $unesc_val{'inst_code'} = &unescape($val{'inst_code'});
-                     unless (eval('$unescapeInstcode=~/$instcodefilter/')) {
+                 }
+                 if ($regexp_ok == 1) {
+                     if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) {
+                         $match = 0;
+                     }
+                 } elsif ($regexp_ok == -1) {
+                     if (eval{$unesc_val{'inst_code'} =~ /$instcodefilter/}) {
                          $match = 0;
                      }
                  } else {
-                     unless (eval('$unescapeInstcode=~/\Q$instcodefilter\E/i')) {
+                     if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) {
                          $match = 0;
                      }
                  }
  	    }
-             unless ($ownerfilter eq '.' || !defined($ownerfilter)) {
+             if ($ownerfilter ne '.') {
-                 my $unescapeOwner = &unescape($owner);
+                 if (!$is_hash) {
+                     $unesc_val{'owner'} = &unescape($val{'owner'});
+                 }
                  if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {
-                     if ($unescapeOwner =~ /:/) {
+                     if ($unesc_val{'owner'} =~ /:/) {
-                         if (eval('$unescapeOwner !~
+                         if (eval{$unesc_val{'owner'} !~
-                              /\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i')) {
+                              /\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i}) {
                              $match = 0;
                          }
                      } else {
-                         if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {
+                         if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
                              $match = 0;
                          }
                      }
                  } elsif ($ownerunamefilter ne '') {
-                     if ($unescapeOwner =~ /:/) {
+                     if ($unesc_val{'owner'} =~ /:/) {
-                         if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E:[^:]+$/i')) {
+                         if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E:[^:]+$/i}) {
                               $match = 0;
                          }
                      } else {
-                         if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {
+                         if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
                              $match = 0;
                          }
                      }
                  } elsif ($ownerdomfilter ne '') {
-                     if ($unescapeOwner =~ /:/) {
+                     if ($unesc_val{'owner'} =~ /:/) {
-                         if (eval('$unescapeOwner!~/^[^:]+:\Q$ownerdomfilter\E/')) {
+                         if (eval{$unesc_val{'owner'} !~ /^[^:]+:\Q$ownerdomfilter\E/}) {
                               $match = 0;
                          }
                      } else {
- Line 3451  sub dump_course_id_handler {
+ Line 3944  sub dump_course_id_handler {
                      }
                  }
              }
-             unless ($coursefilter eq '.' || !defined($coursefilter)) {
+             if ($coursefilter ne '.') {
-                 my $unescapeCourse = &unescape($key);
+                 if (eval{$unesc_key !~ /^$udom(_)\Q$coursefilter\E$/}) {
-                 unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) {
                      $match = 0;
                  }
              }
-             unless ($typefilter eq '.' || !defined($typefilter)) {
+             if ($typefilter ne '.') {
-                 my $unescapeType = &unescape($type);
+                 if (!$is_hash) {
-                 if ($type eq '') {
+                     $unesc_val{'type'} = &unescape($val{'type'});
+                 }
+                 if ($unesc_val{'type'} eq '') {
                      if ($typefilter ne 'Course') {
                          $match = 0;
                      }
                  } else {
-                     unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) {
+                     if (eval{$unesc_val{'type'} !~ /^\Q$typefilter\E$/}) {
                          $match = 0;
                      }
                  }
              }
              if ($match == 1) {
-                 $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';
+                 if ($rtn_as_hash) {
+                     if ($is_hash) {
+                         if ($valchange) {
+                             my $newvalue = &Apache::lonnet::freeze_escape($items);
+                             $qresult.=$key.'='.$newvalue.'&';
+                         } else {
+                             $qresult.=$key.'='.$value.'&';
+                         }
+                     } else {
+                         my %rtnhash = ( 'description' => &unescape($val{'descr'}),
+                                         'inst_code' => &unescape($val{'inst_code'}),
+                                         'owner'     => &unescape($val{'owner'}),
+                                         'type'      => &unescape($val{'type'}),
+                                         'cloners'   => &unescape($val{'cloners'}),
+                                       );
+                         my $items = &Apache::lonnet::freeze_escape(\%rtnhash);
+                         $qresult.=$key.'='.$items.'&';
+                     }
+                 } else {
+                     if ($is_hash) {
+                         $qresult .= $key.'='.&escape($unesc_val{'descr'}).':'.
+                                     &escape($unesc_val{'inst_code'}).':'.
+                                     &escape($unesc_val{'owner'}).'&';
+                     } else {
+                         $qresult .= $key.'='.$val{'descr'}.':'.$val{'inst_code'}.
+                                     ':'.$val{'owner'}.'&';
+                     }
+                 }
              }
  	}
  	if (&untie_domain_hash($hashref)) {
  	    chop($qresult);
- 	    &Reply($client, "$qresult\n", $userinput);
+ 	    &Reply($client, \$qresult, $userinput);
  	} else {
  	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
  		    "while attempting courseiddump\n", $userinput);
- Line 3484  sub dump_course_id_handler {
+ Line 4005  sub dump_course_id_handler {
  	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
  		"while attempting courseiddump\n", $userinput);
      }
      return 1;
  }
  &register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);
- Line 3533  sub put_domain_handler {
+ Line 4052  sub put_domain_handler {
  }
  &register_handler("putdom", \&put_domain_handler, 0, 1, 0);
+ #
+ # Puts a piece of new data in a namespace db file at the domain level
+ # returns error if key already exists
+ #
+ # Parameters:
+ #    $cmd      - The command that got us here.
+ #    $tail     - Tail of the command (remaining parameters).
+ #    $client   - File descriptor connected to client.
+ # Returns
+ #     0        - Requested to exit, caller should shut down.
+ #     1        - Continue processing.
+ #  Side effects:
+ #     reply is written to $client.
+ #
+ sub newput_domain_handler {
+     my ($cmd, $tail, $client)  = @_;
+     my $userinput = "$cmd:$tail";
+     my ($udom,$namespace,$what) =split(/:/,$tail,3);
+     chomp($what);
+     my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_WRCREAT(),
+                                    "N", $what);
+     if(!$hashref) {
+         &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+                   "while attempting newputdom\n", $userinput);
+         return 1;
+     }
+     my @pairs=split(/\&/,$what);
+     foreach my $pair (@pairs) {
+         my ($key,$value)=split(/=/,$pair);
+         if (exists($hashref->{$key})) {
+             &Failure($client, "key_exists: ".$key."\n",$userinput);
+             return 1;
+         }
+     }
+     foreach my $pair (@pairs) {
+         my ($key,$value)=split(/=/,$pair);
+         $hashref->{$key}=$value;
+     }
+     if (&untie_domain_hash($hashref)) {
+         &Reply( $client, "ok\n", $userinput);
+     } else {
+         &Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
+                  "while attempting newputdom\n",
+                  $userinput);
+     }
+     return 1;
+ }
+ &register_handler("newputdom", \&newput_domain_handler, 0, 1, 0);
  # Unencrypted get from the namespace database file at the domain level.
  # This function retrieves a keyed item from a specific named database in the
  # domain directory.
- Line 3568  sub get_domain_handler {
+ Line 4141  sub get_domain_handler {
          }
          if (&untie_domain_hash($hashref)) {
              $qresult=~s/\&$//;
-             &Reply($client, "$qresult\n", $userinput);
+             &Reply($client, \$qresult, $userinput);
          } else {
              &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
                        "while attempting getdom\n",$userinput);
- Line 3582  sub get_domain_handler {
+ Line 4155  sub get_domain_handler {
  }
  &register_handler("getdom", \&get_domain_handler, 0, 1, 0);
+ #
+ #   Deletes a key in a user profile database.
+ #
+ #   Parameters:
+ #       $cmd                  - Command keyword (deldom).
+ #       $tail                 - Command tail.  IN this case a colon
+ #                               separated list containing:
+ #                               the domain to which the database file belongs;
+ #                               the namespace (name of the database file);
+ #                               & separated list of keys to delete.
+ #       $client              - File open on client socket.
+ # Returns:
+ #     1   - Continue processing
+ #     0   - Exit server.
+ #
+ #
+ sub delete_domain_entry {
+     my ($cmd, $tail, $client) = @_;
+     my $userinput = "cmd:$tail";
+     my ($udom,$namespace,$what) = split(/:/,$tail);
+     chomp($what);
+     my $hashref = &tie_domain_hash($udom, $namespace, &GDBM_WRCREAT(),
+                                  "D",$what);
+     if ($hashref) {
+         my @keys=split(/\&/,$what);
+         foreach my $key (@keys) {
+             delete($hashref->{$key});
+         }
+         if (&untie_user_hash($hashref)) {
+             &Reply($client, "ok\n", $userinput);
+         } else {
+             &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+                     "while attempting deldom\n", $userinput);
+         }
+     } else {
+         &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+                  "while attempting deldom\n", $userinput);
+     }
+     return 1;
+ }
+ &register_handler("deldom", \&delete_domain_entry, 0, 1, 0);
  #
  #  Puts an id to a domains id database.
- Line 3666  sub get_id_handler {
+ Line 4282  sub get_id_handler {
  	}
  	if (&untie_domain_hash($hashref)) {
  	    $qresult=~s/\&$//;
- 	    &Reply($client, "$qresult\n", $userinput);
+ 	    &Reply($client, \$qresult, $userinput);
  	} else {
  	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
  		      "while attempting idget\n",$userinput);
- Line 3680  sub get_id_handler {
+ Line 4296  sub get_id_handler {
  }
  &register_handler("idget", \&get_id_handler, 0, 1, 0);
+ sub dump_dom_with_regexp {
+     my ($cmd, $tail, $client) = @_;
+     my $userinput = "$cmd:$tail";
+     my ($udom,$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_domain_hash($udom, $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)) {
+             chop($qresult);
+             &Reply($client, \$qresult, $userinput);
+         } else {
+             &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+                      "while attempting dump\n", $userinput);
+         }
+     } else {
+         &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+                 "while attempting dump\n", $userinput);
+     }
+     return 1;
+ }
+ &register_handler("dumpdom", \&dump_dom_with_regexp, 0, 1, 0);
  #
  # Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database
  #
- Line 3790  sub dump_dcmail_handler {
+ Line 4460  sub dump_dcmail_handler {
          }
          if (&untie_domain_hash($hashref)) {
              chop($qresult);
-             &Reply($client, "$qresult\n", $userinput);
+             &Reply($client, \$qresult, $userinput);
          } else {
              &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
                      "while attempting dcmaildump\n", $userinput);
- Line 3889  sub dump_domainroles_handler {
+ Line 4559  sub dump_domainroles_handler {
          $rolesfilter=&unescape($rolesfilter);
  	@roles = split(/\&/,$rolesfilter);
      }
      my $hashref = &tie_domain_hash($udom, "nohist_domainroles", &GDBM_WRCREAT());
      if ($hashref) {
          my $qresult = '';
          while (my ($key,$value) = each(%$hashref)) {
              my $match = 1;
-             my ($start,$end) = split(/:/,&unescape($value));
+             my ($end,$start) = split(/:/,&unescape($value));
              my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,&unescape($key));
-             unless ($startfilter eq '.' || !defined($startfilter)) {
+             unless (@roles < 1) {
-                 if ($start >= $startfilter) {
+                 unless (grep/^\Q$trole\E$/,@roles) {
                      $match = 0;
+                     next;
                  }
              }
-             unless ($endfilter eq '.' || !defined($endfilter)) {
+             unless ($startfilter eq '.' || !defined($startfilter)) {
-                 if ($end <= $endfilter) {
+                 if ((defined($start)) && ($start >= $startfilter)) {
                      $match = 0;
+                     next;
                  }
              }
-             unless (@roles < 1) {
+             unless ($endfilter eq '.' || !defined($endfilter)) {
-                 unless (grep/^$trole$/,@roles) {
+                 if ((defined($end)) && (($end > 0) && ($end <= $endfilter))) {
                      $match = 0;
+                     next;
                  }
              }
              if ($match == 1) {
- Line 3918  sub dump_domainroles_handler {
+ Line 4591  sub dump_domainroles_handler {
          }
          if (&untie_domain_hash($hashref)) {
              chop($qresult);
-             &Reply($client, "$qresult\n", $userinput);
+             &Reply($client, \$qresult, $userinput);
          } else {
              &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
                      "while attempting domrolesdump\n", $userinput);
- Line 3972  sub tmp_put_handler {
+ Line 4645  sub tmp_put_handler {
      if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
  	print $store $record;
  	close $store;
- 	&Reply($client, "$id\n", $userinput);
+ 	&Reply($client, \$id, $userinput);
      } else {
  	&Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
  		  "while attempting tmpput\n", $userinput);
- Line 4006  sub tmp_get_handler {
+ Line 4679  sub tmp_get_handler {
      my $execdir=$perlvar{'lonDaemons'};
      if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
  	my $reply=<$store>;
- 	&Reply( $client, "$reply\n", $userinput);
+ 	&Reply( $client, \$reply, $userinput);
  	close $store;
      } else {
  	&Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
- Line 4190  sub enrollment_enabled_handler {
+ Line 4863  sub enrollment_enabled_handler {
      my ($cdom) = split(/:/, $tail, 2);   # Domain we're asking about.
      my $outcome  = &localenroll::run($cdom);
-     &Reply($client, "$outcome\n", $userinput);
+     &Reply($client, \$outcome, $userinput);
      return 1;
  }
  &register_handler("autorun", \&enrollment_enabled_handler, 0, 1, 0);
+ #
+ #   Validate an institutional code use for a LON-CAPA course.
+ #
+ # Formal Parameters:
+ #   $cmd          - The command request that got us dispatched.
+ #   $tail         - The tail of the command.  In this case,
+ #                   this is a colon separated set of words that will be split
+ #                   into:
+ #                        $inst_course_id - The institutional cod3 from the
+ #                                          institutions point of view.
+ #                        $cdom           - The domain from the institutions
+ #                                          point of view.
+ #   $client       - Socket open on the client.
+ # Returns:
+ #    1           - Indicating processing should continue.
+ #
+ sub validate_instcode_handler {
+     my ($cmd, $tail, $client) = @_;
+     my $userinput = "$cmd:$tail";
+     my ($dom,$instcode,$owner,$inststatus,$instseclist) = split(/:/, $tail);
+     $instcode = &unescape($instcode);
+     $owner = &unescape($owner);
+     $inststatus = &unescape($inststatus);
+     $instseclist = &unescape($instseclist);
+     my $outcome=&localenroll::validate_instcode($dom,$instcode,$owner,
+                                                 $inststatus,$instseclist);
+     &Reply($client, \$outcome, $userinput);
+     return 1;
+ }
+ &register_handler("autovalidateinstcode", \&validate_instcode_handler, 0, 1, 0);
  #   Get the official sections for which auto-enrollment is possible.
  #   Since the admin people won't know about 'unofficial sections'
  #   we cannot auto-enroll on them.
- Line 4217  sub get_sections_handler {
+ Line 4922  sub get_sections_handler {
      my @secs = &localenroll::get_sections($coursecode,$cdom);
      my $seclist = &escape(join(':',@secs));
-     &Reply($client, "$seclist\n", $userinput);
+     &Reply($client, \$seclist, $userinput);
      return 1;
- Line 4246  sub validate_course_owner_handler {
+ Line 4951  sub validate_course_owner_handler {
      $owner = &unescape($owner);
      my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);
-     &Reply($client, "$outcome\n", $userinput);
+     &Reply($client, \$outcome, $userinput);
- Line 4277  sub validate_course_section_handler {
+ Line 4982  sub validate_course_section_handler {
      my ($inst_course_id, $cdom) = split(/:/, $tail);
      my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom);
-     &Reply($client, "$outcome\n", $userinput);
+     &Reply($client, \$outcome, $userinput);
      return 1;
- Line 4304  sub validate_course_section_handler {
+ Line 5009  sub validate_course_section_handler {
  sub validate_class_access_handler {
      my ($cmd, $tail, $client) = @_;
      my $userinput = "$cmd:$tail";
-     my ($inst_class,$courseowner,$cdom) = split(/:/, $tail);
+     my ($inst_class,$ownerlist,$cdom) = split(/:/, $tail);
-     $courseowner = &unescape($courseowner);
+     my $owners = &unescape($ownerlist);
      my $outcome;
      eval {
  	local($SIG{__DIE__})='DEFAULT';
- 	$outcome=&localenroll::check_section($inst_class,$courseowner,$cdom);
+ 	$outcome=&localenroll::check_section($inst_class,$owners,$cdom);
      };
-     &Reply($client,"$outcome\n", $userinput);
+     &Reply($client,\$outcome, $userinput);
      return 1;
  }
- Line 4472  sub get_institutional_defaults_handler {
+ Line 5177  sub get_institutional_defaults_handler {
                  $result.=&escape($key).'='.&escape($value).'&';
              }
              $result .= 'code_order='.&escape(join('&',@code_order));
-             &Reply($client,$result."\n",$userinput);
+             &Reply($client,\$result,$userinput);
          } else {
              &Reply($client,"error\n", $userinput);
          }
- Line 4483  sub get_institutional_defaults_handler {
+ Line 5188  sub get_institutional_defaults_handler {
  &register_handler("autoinstcodedefaults",
                    \&get_institutional_defaults_handler,0,1,0);
+ sub get_possible_instcodes_handler {
+     my ($cmd, $tail, $client)   = @_;
+     my $userinput               = "$cmd:$tail";
+     my $reply;
+     my $cdom = $tail;
+     my (@codetitles,%cat_titles,%cat_order,@code_order);
+     my $formatreply = &localenroll::possible_instcodes($cdom,
+                                                        \@codetitles,
+                                                        \%cat_titles,
+                                                        \%cat_order,
+                                                        \@code_order);
+     if ($formatreply eq 'ok') {
+         my $result = join('&',map {&escape($_);} (@codetitles)).':';
+         $result .= join('&',map {&escape($_);} (@code_order)).':';
+         foreach my $key (keys(%cat_titles)) {
+             $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($cat_titles{$key}).'&';
+         }
+         $result =~ s/\&$//;
+         $result .= ':';
+         foreach my $key (keys(%cat_order)) {
+             $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($cat_order{$key}).'&';
+         }
+         $result =~ s/\&$//;
+         &Reply($client,\$result,$userinput);
+     } else {
+         &Reply($client, "format_error\n", $userinput);
+     }
+     return 1;
+ }
+ &register_handler("autopossibleinstcodes",
+                   \&get_possible_instcodes_handler,0,1,0);
+ sub get_institutional_user_rules {
+     my ($cmd, $tail, $client)   = @_;
+     my $userinput               = "$cmd:$tail";
+     my $dom = &unescape($tail);
+     my (%rules_hash,@rules_order);
+     my $outcome;
+     eval {
+         local($SIG{__DIE__})='DEFAULT';
+         $outcome = &localenroll::username_rules($dom,\%rules_hash,\@rules_order);
+     };
+     if (!$@) {
+         if ($outcome eq 'ok') {
+             my $result;
+             foreach my $key (keys(%rules_hash)) {
+                 $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
+             }
+             $result =~ s/\&$//;
+             $result .= ':';
+             if (@rules_order > 0) {
+                 foreach my $item (@rules_order) {
+                     $result .= &escape($item).'&';
+                 }
+             }
+             $result =~ s/\&$//;
+             &Reply($client,\$result,$userinput);
+         } else {
+             &Reply($client,"error\n", $userinput);
+         }
+     } else {
+         &Failure($client,"unknown_cmd\n",$userinput);
+     }
+ }
+ &register_handler("instuserrules",\&get_institutional_user_rules,0,1,0);
+ sub get_institutional_id_rules {
+     my ($cmd, $tail, $client)   = @_;
+     my $userinput               = "$cmd:$tail";
+     my $dom = &unescape($tail);
+     my (%rules_hash,@rules_order);
+     my $outcome;
+     eval {
+         local($SIG{__DIE__})='DEFAULT';
+         $outcome = &localenroll::id_rules($dom,\%rules_hash,\@rules_order);
+     };
+     if (!$@) {
+         if ($outcome eq 'ok') {
+             my $result;
+             foreach my $key (keys(%rules_hash)) {
+                 $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
+             }
+             $result =~ s/\&$//;
+             $result .= ':';
+             if (@rules_order > 0) {
+                 foreach my $item (@rules_order) {
+                     $result .= &escape($item).'&';
+                 }
+             }
+             $result =~ s/\&$//;
+             &Reply($client,\$result,$userinput);
+         } else {
+             &Reply($client,"error\n", $userinput);
+         }
+     } else {
+         &Failure($client,"unknown_cmd\n",$userinput);
+     }
+ }
+ &register_handler("instidrules",\&get_institutional_id_rules,0,1,0);
+ sub get_institutional_selfcreate_rules {
+     my ($cmd, $tail, $client)   = @_;
+     my $userinput               = "$cmd:$tail";
+     my $dom = &unescape($tail);
+     my (%rules_hash,@rules_order);
+     my $outcome;
+     eval {
+         local($SIG{__DIE__})='DEFAULT';
+         $outcome = &localenroll::selfcreate_rules($dom,\%rules_hash,\@rules_order);
+     };
+     if (!$@) {
+         if ($outcome eq 'ok') {
+             my $result;
+             foreach my $key (keys(%rules_hash)) {
+                 $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
+             }
+             $result =~ s/\&$//;
+             $result .= ':';
+             if (@rules_order > 0) {
+                 foreach my $item (@rules_order) {
+                     $result .= &escape($item).'&';
+                 }
+             }
+             $result =~ s/\&$//;
+             &Reply($client,\$result,$userinput);
+         } else {
+             &Reply($client,"error\n", $userinput);
+         }
+     } else {
+         &Failure($client,"unknown_cmd\n",$userinput);
+     }
+ }
+ &register_handler("instemailrules",\&get_institutional_selfcreate_rules,0,1,0);
+ sub institutional_username_check {
+     my ($cmd, $tail, $client)   = @_;
+     my $userinput               = "$cmd:$tail";
+     my %rulecheck;
+     my $outcome;
+     my ($udom,$uname,@rules) = split(/:/,$tail);
+     $udom = &unescape($udom);
+     $uname = &unescape($uname);
+     @rules = map {&unescape($_);} (@rules);
+     eval {
+         local($SIG{__DIE__})='DEFAULT';
+         $outcome = &localenroll::username_check($udom,$uname,\@rules,\%rulecheck);
+     };
+     if (!$@) {
+         if ($outcome eq 'ok') {
+             my $result='';
+             foreach my $key (keys(%rulecheck)) {
+                 $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
+             }
+             &Reply($client,\$result,$userinput);
+         } else {
+             &Reply($client,"error\n", $userinput);
+         }
+     } else {
+         &Failure($client,"unknown_cmd\n",$userinput);
+     }
+ }
+ &register_handler("instrulecheck",\&institutional_username_check,0,1,0);
+ sub institutional_id_check {
+     my ($cmd, $tail, $client)   = @_;
+     my $userinput               = "$cmd:$tail";
+     my %rulecheck;
+     my $outcome;
+     my ($udom,$id,@rules) = split(/:/,$tail);
+     $udom = &unescape($udom);
+     $id = &unescape($id);
+     @rules = map {&unescape($_);} (@rules);
+     eval {
+         local($SIG{__DIE__})='DEFAULT';
+         $outcome = &localenroll::id_check($udom,$id,\@rules,\%rulecheck);
+     };
+     if (!$@) {
+         if ($outcome eq 'ok') {
+             my $result='';
+             foreach my $key (keys(%rulecheck)) {
+                 $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
+             }
+             &Reply($client,\$result,$userinput);
+         } else {
+             &Reply($client,"error\n", $userinput);
+         }
+     } else {
+         &Failure($client,"unknown_cmd\n",$userinput);
+     }
+ }
+ &register_handler("instidrulecheck",\&institutional_id_check,0,1,0);
+ sub institutional_selfcreate_check {
+     my ($cmd, $tail, $client)   = @_;
+     my $userinput               = "$cmd:$tail";
+     my %rulecheck;
+     my $outcome;
+     my ($udom,$email,@rules) = split(/:/,$tail);
+     $udom = &unescape($udom);
+     $email = &unescape($email);
+     @rules = map {&unescape($_);} (@rules);
+     eval {
+         local($SIG{__DIE__})='DEFAULT';
+         $outcome = &localenroll::selfcreate_check($udom,$email,\@rules,\%rulecheck);
+     };
+     if (!$@) {
+         if ($outcome eq 'ok') {
+             my $result='';
+             foreach my $key (keys(%rulecheck)) {
+                 $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
+             }
+             &Reply($client,\$result,$userinput);
+         } else {
+             &Reply($client,"error\n", $userinput);
+         }
+     } else {
+         &Failure($client,"unknown_cmd\n",$userinput);
+     }
+ }
+ &register_handler("instselfcreatecheck",\&institutional_selfcreate_check,0,1,0);
  # Get domain specific conditions for import of student photographs to a course
  #
- Line 4635  sub inst_usertypes_handler {
+ Line 5562  sub inst_usertypes_handler {
          }
          $res=~s/\&$//;
      }
-     &Reply($client, "$res\n", $userinput);
+     &Reply($client, \$res, $userinput);
      return 1;
  }
  &register_handler("inst_usertypes", \&inst_usertypes_handler, 0, 1, 0);
- sub inst_dirsrch_handler {
-     my ($cmd, $tail, $client) = @_;
-     my ($domain,$srchby,$srchterm,$srchtype) = split(/:/, $tail);
-     $srchby = &unescape($srchby);
-     $srchterm = &unescape($srchterm);
-     my $userinput = $cmd.":".$tail; # For logging purposes.
-     my (%instusers,%instids,$result,$res);
-     eval {
-         local($SIG{__DIE__})='DEFAULT';
-         $result=&localenroll::get_userinfo($domain,undef,undef,\%instusers,\%instids,undef,$srchby,$srchterm,$srchtype);
-     };
-     if ($result eq 'ok') {
-         if (keys(%instusers) > 0) {
-             foreach my $key (keys(%instusers)) {
-                 my $usrstr = &Apache::lonnet::hash2str(%{$instusers{$key}});
-                 $res.=&escape($key).'='.&escape($usrstr).'&';
-             }
-         }
-         $res=~s/\&$//;
-     }
-     &Reply($client, "$res\n", $userinput);
- }
- &register_handler("instdirsrch", \&inst_dirsrch_handler, 0, 1, 0);
  # mkpath makes all directories for a file, expects an absolute path with a
  # file or a trailing / if just a dir is passed
  # returns 1 on success 0 on failure
- Line 5158  sub Debug {
+ Line 6061  sub Debug {
  #
  sub Reply {
      my ($fd, $reply, $request) = @_;
-     print $fd $reply;
+     if (ref($reply)) {
-     Debug("Request was $request  Reply was $reply");
+ 	print $fd $$reply;
+ 	print $fd "\n";
+ 	if ($DEBUG) { Debug("Request was $request  Reply was $$reply"); }
+     } else {
+ 	print $fd $reply;
+ 	if ($DEBUG) { Debug("Request was $request  Reply was $reply"); }
+     }
      $Transactions++;
  }
- Line 5395  sub make_new_child {
+ Line 6303  sub make_new_child {
  	if ($clientip eq '127.0.0.1') {
  	    $outsideip=&Apache::lonnet::get_host_ip($perlvar{'lonHostID'});
  	}
+ 	&ReadManagerTable();
  	my $clientrec=defined(&Apache::lonnet::get_hosts_from_ip($outsideip));
  	my $ismanager=($managers{$outsideip}    ne undef);
  	$clientname  = "[unknonwn]";
- Line 5713  sub get_auth_type
+ Line 6621  sub get_auth_type
  #     0        - The domain,user,password triplet is not a valid user.
  #
  sub validate_user {
-     my ($domain, $user, $password) = @_;
+     my ($domain, $user, $password, $checkdefauth) = @_;
      # Why negative ~pi you may well ask?  Well this function is about
      # authentication, and therefore very important to get right.
- Line 5737  sub validate_user {
+ Line 6644  sub validate_user {
      my $null = pack("C",0);	# Used by kerberos auth types.
+     if ($howpwd eq 'nouser') {
+         if ($checkdefauth) {
+             my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
+             if ($domdefaults{'auth_def'} eq 'localauth') {
+                 $howpwd = $domdefaults{'auth_def'};
+                 $contentpwd = $domdefaults{'auth_arg_def'};
+             } elsif ((($domdefaults{'auth_def'} eq 'krb4') ||
+                       ($domdefaults{'auth_def'} eq 'krb5')) &&
+                      ($domdefaults{'auth_arg_def'} ne '')) {
+                 $howpwd = $domdefaults{'auth_def'};
+                 $contentpwd = $domdefaults{'auth_arg_def'};
+             }
+         }
+     }
      if ($howpwd ne 'nouser') {
  	if($howpwd eq "internal") { # Encrypted is in local password file.
  	    $validated = (crypt($password, $contentpwd) eq $contentpwd);
  	}
- Line 5789  sub validate_user {
+ Line 6709  sub validate_user {
  		my $credentials= &Authen::Krb5::cc_default();
  		$credentials->initialize(&Authen::Krb5::parse_name($user.'@'
                                                                   .$contentpwd));
- 		my $krbreturn  = &Authen::Krb5::get_in_tkt_with_password($krbclient,
+                 my $krbreturn;
- 									 $krbserver,
+                 if (exists(&Authen::Krb5::get_init_creds_password)) {
- 									 $password,
+                     $krbreturn =
- 									 $credentials);
+                         &Authen::Krb5::get_init_creds_password($krbclient,$password,
- 		$validated = ($krbreturn == 1);
+                                                                $krbservice);
+                     $validated = (ref($krbreturn) eq 'Authen::Krb5::Creds');
+                 } else {
+ 		    $krbreturn  =
+                         &Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver,
+ 		 						$password,$credentials);
+ 		    $validated = ($krbreturn == 1);
+                 }
+ 		if (!$validated) {
+ 		    &logthis('krb5: '.$user.', '.$contentpwd.', '.
+ 			     &Authen::Krb5::error());
+ 		}
  	    } else {
  		$validated = 0;
  	    }
- Line 6082  sub change_unix_password {
+ Line 7013  sub change_unix_password {
  sub make_passwd_file {
      my ($uname, $umode,$npass,$passfilename)=@_;
-     my $result="ok\n";
+     my $result="ok";
      if ($umode eq 'krb4' or $umode eq 'krb5') {
  	{
  	    my $pf = IO::File->new(">$passfilename");
- Line 6150  sub make_passwd_file {
+ Line 7081  sub make_passwd_file {
  		if($useraddok > 0) {
  		    my $error_text = &lcuseraddstrerror($useraddok);
  		    &logthis("Failed lcuseradd: $error_text");
- 		    $result = "lcuseradd_failed:$error_text\n";
+ 		    $result = "lcuseradd_failed:$error_text";
  		}  else {
  		    my $pf = IO::File->new(">$passfilename");
  		    if($pf) {
- Line 6174  sub make_passwd_file {
+ Line 7105  sub make_passwd_file {
  	    }
  	}
      } else {
- 	$result="auth_mode_error\n";
+ 	$result="auth_mode_error";
      }
      return $result;
  }
- Line 6546  linux
+ Line 7477  linux
  Server/Process
  =cut
+ =pod
+ =head1 LOG MESSAGES
+ The messages below can be emitted in the lond log.  This log is located
+ in ~httpd/perl/logs/lond.log  Many log messages have HTML encapsulation
+ to provide coloring if examined from inside a web page. Some do not.
+ Where color is used, the colors are; Red for sometihhng to get excited
+ about and to follow up on. Yellow for something to keep an eye on to
+ be sure it does not get worse, Green,and Blue for informational items.
+ In the discussions below, sometimes reference is made to ~httpd
+ when describing file locations.  There isn't really an httpd
+ user, however there is an httpd directory that gets installed in the
+ place that user home directories go.  On linux, this is usually
+ (always?) /home/httpd.
+ Some messages are colorless.  These are usually (not always)
+ Green/Blue color level messages.
+ =over 2
+ =item (Red)  LocalConnection rejecting non local: <ip> ne 127.0.0.1
+ A local connection negotiation was attempted by
+ a host whose IP address was not 127.0.0.1.
+ The socket is closed and the child will exit.
+ lond has three ways to establish an encyrption
+ key with a client:
+ =over 2
+ =item local
+ The key is written and read from a file.
+ This is only valid for connections from localhost.
+ =item insecure
+ The key is generated by the server and
+ transmitted to the client.
+ =item  ssl (secure)
+ An ssl connection is negotiated with the client,
+ the key is generated by the server and sent to the
+ client across this ssl connection before the
+ ssl connectionis terminated and clear text
+ transmission resumes.
+ =back
+ =item (Red) LocalConnection: caller is insane! init = <init> and type = <type>
+ The client is local but has not sent an initialization
+ string that is the literal "init:local"  The connection
+ is closed and the child exits.
+ =item Red CRITICAL Can't get key file <error>
+ SSL key negotiation is being attempted but the call to
+ lonssl::KeyFile  failed.  This usually means that the
+ configuration file is not correctly defining or protecting
+ the directories/files lonCertificateDirectory or
+ lonnetPrivateKey
+ <error> is a string that describes the reason that
+ the key file could not be located.
+ =item (Red) CRITICAL  Can't get certificates <error>
+ SSL key negotiation failed because we were not able to retrives our certificate
+ or the CA's certificate in the call to lonssl::CertificateFile
+ <error> is the textual reason this failed.  Usual reasons:
+ =over 2
+ =item Apache config file for loncapa  incorrect:
+ one of the variables
+ lonCertificateDirectory, lonnetCertificateAuthority, or lonnetCertificate
+ undefined or incorrect
+ =item Permission error:
+ The directory pointed to by lonCertificateDirectory is not readable by lond
+ =item Permission error:
+ Files in the directory pointed to by lonCertificateDirectory are not readable by lond.
+ =item Installation error:
+ Either the certificate authority file or the certificate have not
+ been installed in lonCertificateDirectory.
+ =item (Red) CRITICAL SSL Socket promotion failed:  <err>
+ The promotion of the connection from plaintext to SSL failed
+ <err> is the reason for the failure.  There are two
+ system calls involved in the promotion (one of which failed),
+ a dup to produce
+ a second fd on the raw socket over which the encrypted data
+ will flow and IO::SOcket::SSL->new_from_fd which creates
+ the SSL connection on the duped fd.
+ =item (Blue)   WARNING client did not respond to challenge
+ This occurs on an insecure (non SSL) connection negotiation request.
+ lond generates some number from the time, the PID and sends it to
+ the client.  The client must respond by echoing this information back.
+ If the client does not do so, that's a violation of the challenge
+ protocols and the connection will be failed.
+ =item (Red) No manager table. Nobody can manage!!
+ lond has the concept of privileged hosts that
+ can perform remote management function such
+ as update the hosts.tab.   The manager hosts
+ are described in the
+ ~httpd/lonTabs/managers.tab file.
+ this message is logged if this file is missing.
+ =item (Green) Registering manager <dnsname> as <cluster_name> with <ipaddress>
+ Reports the successful parse and registration
+ of a specific manager.
+ =item Green existing host <clustername:dnsname>
+ The manager host is already defined in the hosts.tab
+ the information in that table, rather than the info in the
+ manager table will be used to determine the manager's ip.
+ =item (Red) Unable to craete <filename>
+ lond has been asked to create new versions of an administrative
+ file (by a manager).  When this is done, the new file is created
+ in a temp file and then renamed into place so that there are always
+ usable administrative files, even if the update fails.  This failure
+ message means that the temp file could not be created.
+ The update is abandoned, and the old file is available for use.
+ =item (Green) CopyFile from <oldname> to <newname> failed
+ In an update of administrative files, the copy of the existing file to a
+ backup file failed.  The installation of the new file may still succeed,
+ but there will not be a back up file to rever to (this should probably
+ be yellow).
+ =item (Green) Pushfile: backed up <oldname> to <newname>
+ See above, the backup of the old administrative file succeeded.
+ =item (Red)  Pushfile: Unable to install <filename> <reason>
+ The new administrative file could not be installed.  In this case,
+ the old administrative file is still in use.
+ =item (Green) Installed new < filename>.
+ The new administrative file was successfullly installed.
+ =item (Red) Reinitializing lond pid=<pid>
+ The lonc child process <pid> will be sent a USR2
+ signal.
+ =item (Red) Reinitializing self
+ We've been asked to re-read our administrative files,and
+ are doing so.
+ =item (Yellow) error:Invalid process identifier <ident>
+ A reinit command was received, but the target part of the
+ command was not valid.  It must be either
+ 'lond' or 'lonc' but was <ident>
+ =item (Green) isValideditCommand checking: Command = <command> Key = <key> newline = <newline>
+ Checking to see if lond has been handed a valid edit
+ command.  It is possible the edit command is not valid
+ in that case there are no log messages to indicate that.
+ =item Result of password change for  <username> pwchange_success
+ The password for <username> was
+ successfully changed.
+ =item Unable to open <user> passwd to change password
+ Could not rewrite the
+ internal password file for a user
+ =item Result of password change for <user> : <result>
+ A unix password change for <user> was attempted
+ and the pipe returned <result>
+ =item LWP GET: <message> for <fname> (<remoteurl>)
+ The lightweight process fetch for a resource failed
+ with <message> the local filename that should
+ have existed/been created was  <fname> the
+ corresponding URI: <remoteurl>  This is emitted in several
+ places.
+ =item Unable to move <transname> to <destname>
+ From fetch_user_file_handler - the user file was replicated but could not
+ be mv'd to its final location.
+ =item Looking for <domain> <username>
+ From user_has_session_handler - This should be a Debug call instead
+ it indicates lond is about to check whether the specified user has a
+ session active on the specified domain on the local host.
+ =item Client <ip> (<name>) hanging up: <input>
+ lond has been asked to exit by its client.  The <ip> and <name> identify the
+ client systemand <input> is the full exit command sent to the server.
+ =item Red CRITICAL: ABNORMAL EXIT. child <pid> for server <hostname> died through a crass with this error->[<message>].
+ A lond child terminated.  NOte that this termination can also occur when the
+ child receives the QUIT or DIE signals.  <pid> is the process id of the child,
+ <hostname> the host lond is working for, and <message> the reason the child died
+ to the best of our ability to get it (I would guess that any numeric value
+ represents and errno value).  This is immediately followed by
+ =item  Famous last words: Catching exception - <log>
+ Where log is some recent information about the state of the child.
+ =item Red CRITICAL: TIME OUT <pid>
+ Some timeout occured for server <pid>.  THis is normally a timeout on an LWP
+ doing an HTTP::GET.
+ =item child <pid> died
+ The reaper caught a SIGCHILD for the lond child process <pid>
+ This should be modified to also display the IP of the dying child
+ $children{$pid}
+ =item Unknown child 0 died
+ A child died but the wait for it returned a pid of zero which really should not
+ ever happen.
+ =item Child <which> - <pid> looks like we missed it's death
+ When a sigchild is received, the reaper process checks all children to see if they are
+ alive.  If children are dying quite quickly, the lack of signal queuing can mean
+ that a signal hearalds the death of more than one child.  If so this message indicates
+ which other one died. <which> is the ip of a dead child
+ =item Free socket: <shutdownretval>
+ The HUNTSMAN sub was called due to a SIGINT in a child process.  The socket is being shutdown.
+ for whatever reason, <shutdownretval> is printed but in fact shutdown() is not documented
+ to return anything. This is followed by:
+ =item Red CRITICAL: Shutting down
+ Just prior to exit.
+ =item Free socket: <shutdownretval>
+ The HUPSMAN sub was called due to a SIGHUP.  all children get killsed, and lond execs itself.
+ This is followed by:
+ =item (Red) CRITICAL: Restarting
+ lond is about to exec itself to restart.
+ =item (Blue) Updating connections
+ (In response to a USR2).  All the children (except the one for localhost)
+ are about to be killed, the hosts tab reread, and Apache reloaded via apachereload.
+ =item (Blue) UpdateHosts killing child <pid> for ip <ip>
+ Due to USR2 as above.
+ =item (Green) keeping child for ip <ip> (pid = <pid>)
+ In response to USR2 as above, the child indicated is not being restarted because
+ it's assumed that we'll always need a child for the localhost.
+ =item Going to check on the children
+ Parent is about to check on the health of the child processes.
+ Note that this is in response to a USR1 sent to the parent lond.
+ there may be one or more of the next two messages:
+ =item <pid> is dead
+ A child that we have in our child hash as alive has evidently died.
+ =item  Child <pid> did not respond
+ In the health check the child <pid> did not update/produce a pid_.txt
+ file when sent it's USR1 signal.  That process is killed with a 9 signal, as it's
+ assumed to be hung in some un-fixable way.
+ =item Finished checking children
+ Master processs's USR1 processing is cojmplete.
+ =item (Red) CRITICAL: ------- Starting ------
+ (There are more '-'s on either side).  Lond has forked itself off to
+ form a new session and is about to start actual initialization.
+ =item (Green) Attempting to start child (<client>)
+ Started a new child process for <client>.  Client is IO::Socket object
+ connected to the child.  This was as a result of a TCP/IP connection from a client.
+ =item Unable to determine who caller was, getpeername returned nothing
+ In child process initialization.  either getpeername returned undef or
+ a zero sized object was returned.  Processing continues, but in my opinion,
+ this should be cause for the child to exit.
+ =item Unable to determine clientip
+ In child process initialization.  The peer address from getpeername was not defined.
+ The client address is stored as "Unavailable" and processing continues.
+ =item (Yellow) INFO: Connection <ip> <name> connection type = <type>
+ In child initialization.  A good connectionw as received from <ip>.
+ =over 2
+ =item <name>
+ is the name of the client from hosts.tab.
+ =item <type>
+ Is the connection type which is either
+ =over 2
+ =item manager
+ The connection is from a manager node, not in hosts.tab
+ =item client
+ the connection is from a non-manager in the hosts.tab
+ =item both
+ The connection is from a manager in the hosts.tab.
+ =back
+ =back
+ =item (Blue) Certificates not installed -- trying insecure auth
+ One of the certificate file, key file or
+ certificate authority file could not be found for a client attempting
+ SSL connection intiation.  COnnection will be attemptied in in-secure mode.
+ (this would be a system with an up to date lond that has not gotten a
+ certificate from us).
+ =item (Green)  Successful local authentication
+ A local connection successfully negotiated the encryption key.
+ In this case the IDEA key is in a file (that is hopefully well protected).
+ =item (Green) Successful ssl authentication with <client>
+ The client (<client> is the peer's name in hosts.tab), has successfully
+ negotiated an SSL connection with this child process.
+ =item (Green) Successful insecure authentication with <client>
+ The client has successfully negotiated an  insecure connection withthe child process.
+ =item (Yellow) Attempted insecure connection disallowed
+ The client attempted and failed to successfully negotiate a successful insecure
+ connection.  This can happen either because the variable londAllowInsecure is false
+ or undefined, or becuse the child did not successfully echo back the challenge
+ string.
+ =back
+ =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.376
changed lines
	Added in v.1.422