--- loncom/lond	2007/10/08 17:40:56	1.385
+++ loncom/lond	2008/09/06 00:47:13	1.408
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.385 2007/10/08 17:40:56 albertel Exp $
+# $Id: lond,v 1.408 2008/09/06 00:47:13 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -59,7 +59,7 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.385 $'; #' stupid emacs
+my $VERSION='$Revision: 1.408 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -74,8 +74,6 @@ my $keymode;
 
 my $cipher;			# Cipher key negotiated with client
 my $tmpsnum = 0;		# Id of tmpputs.
-my $max_children = 1;           # warn when exceeding this
-my $max_children_enforcing = 0;
 
 # 
 #   Connection type is:
@@ -998,7 +996,7 @@ 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;
 }
@@ -1068,7 +1066,7 @@ 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;
 
@@ -1105,7 +1103,7 @@ sub load_handler {
    
     my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
 
-    &Reply( $replyfd, "$loadpercent\n", "$cmd:$tail");
+    &Reply( $replyfd, \$loadpercent, "$cmd:$tail");
    
     return 1;
 }
@@ -1135,7 +1133,7 @@ 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;
 }
@@ -1178,7 +1176,7 @@ sub user_authorization_type {
 	} else {
             $type .= ':';
         }
-	&Reply( $replyfd, "$type\n", $userinput);
+	&Reply( $replyfd, \$type, $userinput);
     }
   
     return 1;
@@ -1214,7 +1212,7 @@ sub push_file_handler {
 	# process making the request.
       
 	my $reply = &PushFile($userinput);
-	&Reply($client, "$reply\n", $userinput);
+	&Reply($client, \$reply, $userinput);
 
     } else {
 	&Failure( $client, "refused\n", $userinput);
@@ -1223,8 +1221,10 @@ sub push_file_handler {
 }
 &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 
@@ -1266,7 +1266,7 @@ 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"); 
     }
@@ -1274,9 +1274,73 @@ 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.
 #
-# The ls_handler routine should be considered obosolete and is retained
-# for communication with legacy servers.  Please see the ls2_handler.
+#   du2  - list the disk usage of a directory recursively.
+#
+# Parameters:
+#    $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
@@ -1335,15 +1399,16 @@ 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);
 
-#
-# Please also see the ls_handler, which this routine obosolets.
+# The ls2_handler routine should be considered obsolete and is retained
+# 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.
 #
@@ -1404,10 +1469,123 @@ 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);
 
 #   Process a reinit request.  Reinit requests that either
 #   lonc or lond be reinitialized so that an updated 
@@ -1432,7 +1610,7 @@ 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);
     }
@@ -1516,13 +1694,15 @@ 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);
-    &Debug(" Authenticate domain = $udom, user = $uname, password = $upass");
+    my ($udom, $uname, $upass, $checkdefauth)=split(/:/,$tail);
+    &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);
 	#
@@ -1607,7 +1787,7 @@ 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
@@ -1668,9 +1848,9 @@ 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);
@@ -1737,9 +1917,9 @@ 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);
@@ -1758,7 +1938,7 @@ sub change_authentication_handler {
 			&manage_permissions("/$udom/_au", $udom, $uname, "$umode:");
 		    }
 		}
-		&Reply($client, $result, $userinput);
+		&Reply($client, \$result, $userinput);
 	    }
 	       
 
@@ -2143,24 +2323,24 @@ 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");
     }
@@ -2584,10 +2764,11 @@ 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);
     }
@@ -2727,7 +2908,7 @@ 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);
@@ -2797,7 +2978,7 @@ 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);
@@ -2880,7 +3061,7 @@ 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);
@@ -3088,7 +3269,7 @@ 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);
@@ -3169,7 +3350,7 @@ sub retrieve_chat_handler {
 	$reply.=&escape($_).':';
     }
     $reply=~s/\:$//;
-    &Reply($client, $reply."\n", $userinput);
+    &Reply($client, \$reply, $userinput);
 
 
     return 1;
@@ -3313,7 +3494,7 @@ sub put_course_id_handler {
                     my @new_items = split(/:/,$courseinfo,-1);
                     my %storehash; 
                     for (my $i=0; $i<@new_items; $i++) {
-                        $storehash{$items[$i]} = $new_items[$i];
+                        $storehash{$items[$i]} = &unescape($new_items[$i]);
                     }
                     $hashref->{$key} = 
                         &Apache::lonnet::freeze_escape(\%storehash);
@@ -3434,7 +3615,17 @@ sub put_course_id_hash_handler {
 #                            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".
+#
 #     $client  - The socket open on the client.
 # Returns:
 #    1     - Continue processing.
@@ -3445,7 +3636,9 @@ sub dump_course_id_handler {
     my $userinput = "$cmd:$tail";
 
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
-        $typefilter,$regexp_ok,$rtn_as_hash) =split(/:/,$tail);
+        $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
+        $caller) =split(/:/,$tail);
+    my $now = time;
     if (defined($description)) {
 	$description=&unescape($description);
     } else {
@@ -3485,6 +3678,9 @@ sub dump_course_id_handler {
     if (defined($regexp_ok)) {
         $regexp_ok=&unescape($regexp_ok);
     }
+    if (defined($catfilter)) {
+        $catfilter=&unescape($catfilter);
+    }
     my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && 
         $typefilter eq '.') {
@@ -3495,7 +3691,8 @@ sub dump_course_id_handler {
     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
     if ($hashref) {
 	while (my ($key,$value) = each(%$hashref)) {
-            my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,%unesc_val);
+            my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,
+                %unesc_val,$selfenroll_end,$selfenroll_types);
             $unesc_key = &unescape($key);
             if ($unesc_key =~ /^lasttime:/) {
                 next;
@@ -3515,11 +3712,42 @@ sub dump_course_id_handler {
                     $unesc_val{'owner'} = $items->{'owner'};
                     $unesc_val{'type'} = $items->{'type'};
                 }
+                $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); 
                 $is_hash =  0;
-                my @courseitems = split(/:/,&unescape($value));
+                my @courseitems = split(/:/,$value);
                 $lasttime = pop(@courseitems);
-                next if ($lasttime<$since);
+                if ($hashref->{$lasttime_key} eq '') {
+                    next if ($lasttime<$since);
+                }
 	        ($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;
             }
             my $match = 1;
@@ -3606,10 +3834,10 @@ sub dump_course_id_handler {
                     if ($is_hash) {
                         $qresult.=$key.'='.$value.'&';
                     } else {
-                        my %rtnhash = ( 'description' => &escape($val{'descr'}),
-                                        'inst_code' => &escape($val{'inst_code'}),
-                                        'owner'     => &escape($val{'owner'}),
-                                        'type'      => &escape($val{'type'}),
+                        my %rtnhash = ( 'description' => &unescape($val{'descr'}),
+                                        'inst_code' => &unescape($val{'inst_code'}),
+                                        'owner'     => &unescape($val{'owner'}),
+                                        'type'      => &unescape($val{'type'}),
                                       );
                         my $items = &Apache::lonnet::freeze_escape(\%rtnhash);
                         $qresult.=$key.'='.$items.'&';
@@ -3628,7 +3856,7 @@ sub dump_course_id_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 courseiddump\n", $userinput);
@@ -3719,7 +3947,7 @@ 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);
@@ -3817,7 +4045,7 @@ 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);
@@ -3941,7 +4169,7 @@ 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);
@@ -4059,7 +4287,7 @@ sub dump_domainroles_handler {
                 }
             }
             unless (@roles < 1) {
-                unless (grep/^$trole$/,@roles) {
+                unless (grep/^\Q$trole\E$/,@roles) {
                     $match = 0;
                 }
             }
@@ -4069,7 +4297,7 @@ 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);
@@ -4123,7 +4351,7 @@ 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);
@@ -4157,7 +4385,7 @@ 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 ".
@@ -4341,7 +4569,7 @@ 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;
 }
@@ -4368,7 +4596,7 @@ 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;
@@ -4397,7 +4625,7 @@ 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);
 
 
 
@@ -4428,7 +4656,7 @@ 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;
@@ -4456,13 +4684,13 @@ sub validate_class_access_handler {
     my ($cmd, $tail, $client) = @_;
     my $userinput = "$cmd:$tail";
     my ($inst_class,$ownerlist,$cdom) = split(/:/, $tail);
-    my @owners = split(/,/,&unescape($ownerlist));
+    my $owners = &unescape($ownerlist);
     my $outcome;
     eval {
 	local($SIG{__DIE__})='DEFAULT';
-	$outcome=&localenroll::check_section($inst_class,\@owners,$cdom);
+	$outcome=&localenroll::check_section($inst_class,$owners,$cdom);
     };
-    &Reply($client,"$outcome\n", $userinput);
+    &Reply($client,\$outcome, $userinput);
 
     return 1;
 }
@@ -4623,7 +4851,7 @@ 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);
         }
@@ -4658,7 +4886,7 @@ sub get_institutional_user_rules {
                 }
             }
             $result =~ s/\&$//;
-            &Reply($client,$result."\n",$userinput);
+            &Reply($client,\$result,$userinput);
         } else {
             &Reply($client,"error\n", $userinput);
         }
@@ -4668,6 +4896,74 @@ sub get_institutional_user_rules {
 }
 &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)   = @_;
@@ -4688,7 +4984,7 @@ sub institutional_username_check {
             foreach my $key (keys(%rulecheck)) {
                 $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
             }
-            &Reply($client,$result."\n",$userinput);
+            &Reply($client,\$result,$userinput);
         } else {
             &Reply($client,"error\n", $userinput);
         }
@@ -4698,6 +4994,63 @@ sub institutional_username_check {
 }
 &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
 #
@@ -4850,7 +5203,7 @@ 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);
@@ -5181,12 +5534,6 @@ $server = IO::Socket::INET->new(LocalPor
 
 my %children               = ();       # keys are current child process IDs
 
-sub flip_max_children_enforcing {
-    $max_children_enforcing = !$max_children_enforcing;
-    &logthis("Flipped child maximum enforcement to (".
-	     $max_children_enforcing.")");
-}
-
 sub REAPER {                        # takes care of dead children
     $SIG{CHLD} = \&REAPER;
     &status("Handling child death");
@@ -5355,9 +5702,14 @@ sub Debug {
 #
 sub Reply {
     my ($fd, $reply, $request) = @_;
-    print $fd $reply;
-    Debug("Request was $request  Reply was $reply");
-
+    if (ref($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++;
 }
 
@@ -5496,7 +5848,6 @@ $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
 $SIG{HUP}  = \&HUPSMAN;
 $SIG{USR1} = \&checkchildren;
 $SIG{USR2} = \&UpdateHosts;
-$SIG{SEGV} = \&flip_max_children_enforcing;
 
 #  Read the host hashes:
 &Apache::lonnet::load_hosts_tab();
@@ -5512,17 +5863,7 @@ while (1) {
     &status('Starting accept');
     $client = $server->accept() or next;
     &status('Accepted '.$client.' off to spawn');
-    my $child_count = scalar(keys(%children));
-    if ($child_count > $max_children) {
-	&logthis("Warning too many children (".$child_count.")");
-    }
-#    if ($child_count > $max_children && $max_children_enforcing) {
-#	&logthis(" Not creating new child ");
-#	$client->close();
-#    } else {
-	&make_new_child($client);
-#    }
-    &logthis("Concurrent children at ($child_count)");
+    make_new_child($client);
     &status('Finished spawning');
 }
 
@@ -5725,18 +6066,10 @@ sub make_new_child {
 # ------------------------------------------------------------ Process requests
 	    my $keep_going = 1;
 	    my $user_input;
-	    my $max_size = (split("\n",`ps -o vsz $$`))[-1];
 	    while(($user_input = get_request) && $keep_going) {
 		alarm(120);
 		Debug("Main: Got $user_input\n");
 		$keep_going = &process_request($user_input);
-		if (!$max_children_enforcing) {
-		    my $new_size = (split("\n",`ps -o vsz $$`))[-1];
-		    if ($new_size > $max_size) {
-			&logthis("size increase of ".($new_size-$max_size)." ($new_size) while processing (".length($user_input).")\n".substr($user_input,0,80));
-			$max_size = $new_size;
-		    }
-		}
 		alarm(0);
 		&status('Listening to '.$clientname." ($keymode)");	   
 	    }
@@ -5929,8 +6262,7 @@ 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.
@@ -5953,8 +6285,21 @@ 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);
 	}
@@ -6005,11 +6350,18 @@ 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,
-									 $krbserver,
-									 $password,
-									 $credentials);
-		$validated = ($krbreturn == 1);
+                my $krbreturn;
+                if (exists(&Authen::Krb5::get_init_creds_password)) {
+                    $krbreturn = 
+                        &Authen::Krb5::get_init_creds_password($krbclient,$password,
+                                                               $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());
@@ -6302,7 +6654,7 @@ 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");
@@ -6370,7 +6722,7 @@ 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) {
@@ -6394,7 +6746,7 @@ sub make_passwd_file {
 	    }
 	}
     } else {
-	$result="auth_mode_error\n";
+	$result="auth_mode_error";
     }
     return $result;
 }
@@ -6417,7 +6769,7 @@ sub sethost {
 	eq &Apache::lonnet::get_host_ip($hostid)) {
 	$currenthostid  =$hostid;
 	$currentdomainid=&Apache::lonnet::host_domain($hostid);
-	#&logthis("Setting hostid to $hostid, and domain to $currentdomainid");
+	&logthis("Setting hostid to $hostid, and domain to $currentdomainid");
     } else {
 	&logthis("Requested host id $hostid not an alias of ".
 		 $perlvar{'lonHostID'}." refusing connection");