--- loncom/lond	2006/05/31 14:47:56	1.332
+++ loncom/lond	2006/10/11 19:15:47	1.343
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.332 2006/05/31 14:47:56 albertel Exp $
+# $Id: lond,v 1.343 2006/10/11 19:15:47 albertel 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.332 $'; #' stupid emacs
+my $VERSION='$Revision: 1.343 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -835,16 +835,14 @@ sub AdjustOurHost {
     #   Use the config line to get my hostname.
     #   Use gethostbyname to translate that into an IP address.
     #
-    my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon) = split(/:/,$ConfigLine);
-    my $BinaryIp = gethostbyname($name);
-    my $ip       = inet_ntoa($ip);
+    my ($id,$domain,$role,$name,$maxcon,$idleto,$mincon) = split(/:/,$ConfigLine);
     #
     #  Reassemble the config line from the elements in the list.
     #  Note that if the loncnew items were not present before, they will
     #  be now even if they would be empty
     #
     my $newConfigLine = $id;
-    foreach my $item ($domain, $role, $name, $ip, $maxcon, $idleto, $mincon) {
+    foreach my $item ($domain, $role, $name, $maxcon, $idleto, $mincon) {
 	$newConfigLine .= ":".$item;
     }
     #  Replace the line:
@@ -890,11 +888,11 @@ sub EditFile {
 
     #  Split the command into it's pieces:  edit:filetype:script
 
-    my ($request, $filetype, $script) = split(/:/, $request,3);	# : in script
+    my ($cmd, $filetype, $script) = split(/:/, $request,3);	# : in script
 
     #  Check the pre-coditions for success:
 
-    if($request != "edit") {	# Something is amiss afoot alack.
+    if($cmd != "edit") {	# Something is amiss afoot alack.
 	return "error:edit request detected, but request != 'edit'\n";
     }
     if( ($filetype ne "hosts")  &&
@@ -1252,7 +1250,7 @@ sub push_file_handler {
 #
 sub du_handler {
     my ($cmd, $ududir, $client) = @_;
-    my ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.
+    ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.
     my $userinput = "$cmd:$ududir";
 
     if ($ududir=~/\.\./ || $ududir!~m|^/home/httpd/|) {
@@ -1847,6 +1845,7 @@ sub update_resource_handler {
 		my $reply=&reply("unsub:$fname","$clientname");
 		&devalidate_meta_cache($fname);
 		unlink("$fname");
+		unlink("$fname.meta");
 	    } else {
 		my $transname="$fname.in.transfer";
 		my $remoteurl=&reply("sub:$fname","$clientname");
@@ -2124,14 +2123,21 @@ sub token_auth_user_file_handler {
     
     chomp($session);
     my $reply="non_auth\n";
-    if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
-	     $session.'.id')) {
+    my $file = $perlvar{'lonIDsDir'}.'/'.$session.'.id';
+    if (open(ENVIN,"$file")) {
 	flock(ENVIN,LOCK_SH);
-	while (my $line=<ENVIN>) {
-	    my ($envname)=split(/=/,$line,2);
-	    $envname=&unescape($envname);
-	    if ($envname=~ m|^userfile\.\Q$fname\E|) { $reply="ok\n"; }
+	tie(my %disk_env,'GDBM_File',"$file",&GDBM_READER(),0640);
+	if (exists($disk_env{"userfile.$fname"})) {
+	    $reply="ok\n";
+	} else {
+	    foreach my $envname (keys(%disk_env)) {
+		if ($envname=~ m|^userfile\.\Q$fname\E|) {
+		    $reply="ok\n";
+		    last;
+		}
+	    }
 	}
+	untie(%disk_env);
 	close(ENVIN);
 	&Reply($client, $reply, "$cmd:$tail");
     } else {
@@ -2594,7 +2600,7 @@ sub get_profile_entry_encrypted {
 
     my $userinput = "$cmd:$tail";
    
-    my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);
+    my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);
     my $qresult = read_profile($udom, $uname, $namespace, $what);
     my ($first) = split(/:/, $qresult);
@@ -3040,7 +3046,7 @@ sub restore_handler {
 
     my $userinput = "$cmd:$tail";	# Only used for logging purposes.
 
-    my ($cmd,$udom,$uname,$namespace,$rid) = split(/:/,$userinput);
+    my ($udom,$uname,$namespace,$rid) = split(/:/,$tail);
     $namespace=~s/\//\_/g;
     $namespace=~s/\W//g;
     chomp($rid);
@@ -3215,7 +3221,7 @@ sub reply_query_handler {
 
     my $userinput = "$cmd:$tail";
 
-    my ($cmd,$id,$reply)=split(/:/,$userinput); 
+    my ($id,$reply)=split(/:/,$tail); 
     my $store;
     my $execdir=$perlvar{'lonDaemons'};
     if ($store=IO::File->new(">$execdir/tmp/$id")) {
@@ -3288,10 +3294,10 @@ sub put_course_id_handler {
             my @new_items = split(/:/,$courseinfo);
             my $numnew = scalar(@new_items);
             if ($numcurrent > 0) {
-                if ($numnew == 1) { # flushcourselogs() from 1.1 or earlier
-                    $courseinfo .= ':'.join(':',@current_items);
-                } elsif ($numnew == 2) { # flushcourselogs() from 1.2.X
-                    $courseinfo .= ':'.$current_items[$numcurrent-1];
+                if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2 
+                    for (my $j=$numcurrent-$numnew; $j>=0; $j--) {
+                        $courseinfo .= ':'.$current_items[$numcurrent-$j-1];
+                    }
                 }
             }
 	    $hashref->{$key}=$courseinfo.':'.$now;
@@ -3335,12 +3341,11 @@ sub put_course_id_handler {
 #                 institutional code - optional supplied code to filter 
 #                            the dump. Only courses with an institutional code 
 #                            that match the supplied code will be returned.
-#                 owner    - optional supplied username of owner to filter
-#                            the dump.  Only courses for which the course 
-#                            owner matches the supplied username will be
-#                            returned. Implicit assumption that owner
-#                            is a user in the domain in which the
-#                            course database is defined.
+#                 owner    - optional supplied username and domain of owner to
+#                            filter the dump.  Only courses for which the course
+#                            owner matches the supplied username and/or domain
+#                            will be returned. Pre-2.2.0 legacy entries from 
+#                            nohist_courseiddump will only contain usernames.
 #     $client  - The socket open on the client.
 # Returns:
 #    1     - Continue processing.
@@ -3351,7 +3356,8 @@ sub dump_course_id_handler {
 
     my $userinput = "$cmd:$tail";
 
-    my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter) =split(/:/,$tail);
+    my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
+        $typefilter) =split(/:/,$tail);
     if (defined($description)) {
 	$description=&unescape($description);
     } else {
@@ -3362,26 +3368,42 @@ sub dump_course_id_handler {
     } else {
         $instcodefilter='.';
     }
+    my ($ownerunamefilter,$ownerdomfilter);
     if (defined($ownerfilter)) {
         $ownerfilter=&unescape($ownerfilter);
+        if ($ownerfilter ne '.' && defined($ownerfilter)) {
+            if ($ownerfilter =~ /^([^:]*):([^:]*)$/) {
+                 $ownerunamefilter = $1;
+                 $ownerdomfilter = $2;
+            } else {
+                $ownerunamefilter = $ownerfilter;
+                $ownerdomfilter = '';
+            }
+        }
     } else {
         $ownerfilter='.';
     }
+
     if (defined($coursefilter)) {
         $coursefilter=&unescape($coursefilter);
     } else {
         $coursefilter='.';
     }
+    if (defined($typefilter)) {
+        $typefilter=&unescape($typefilter);
+    } else {
+        $typefilter='.';
+    }
 
     unless (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);
+	    my ($descr,$lasttime,$inst_code,$owner,$type);
             my @courseitems = split(/:/,$value);
             $lasttime = pop(@courseitems);
-	    ($descr,$inst_code,$owner)=@courseitems;
+	    ($descr,$inst_code,$owner,$type)=@courseitems;
 	    if ($lasttime<$since) { next; }
             my $match = 1;
 	    unless ($description eq '.') {
@@ -3398,8 +3420,37 @@ sub dump_course_id_handler {
 	    }
             unless ($ownerfilter eq '.' || !defined($ownerfilter)) {
                 my $unescapeOwner = &unescape($owner);
-                unless (eval('$unescapeOwner=~/\Q$ownerfilter\E/i')) {
-                    $match = 0;
+                if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {
+                    if ($unescapeOwner =~ /:/) {
+                        if (eval('$unescapeOwner !~ 
+                             /\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i')) {
+                            $match = 0;
+                        } 
+                    } else {
+                        if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {
+                            $match = 0;
+                        }
+                    }
+                } elsif ($ownerunamefilter ne '') {
+                    if ($unescapeOwner =~ /:/) {
+                        if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E:[^:]+$/i')) {
+                             $match = 0;
+                        }
+                    } else {
+                        if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {
+                            $match = 0;
+                        }
+                    }
+                } elsif ($ownerdomfilter ne '') {
+                    if ($unescapeOwner =~ /:/) {
+                        if (eval('$unescapeOwner!~/^[^:]+:\Q$ownerdomfilter\E/')) {
+                             $match = 0;
+                        }
+                    } else {
+                        if ($ownerdomfilter ne $udom) {
+                            $match = 0;
+                        }
+                    }
                 }
             }
             unless ($coursefilter eq '.' || !defined($coursefilter)) {
@@ -3408,6 +3459,18 @@ sub dump_course_id_handler {
                     $match = 0;
                 }
             }
+            unless ($typefilter eq '.' || !defined($typefilter)) {
+                my $unescapeType = &unescape($type);
+                if ($type eq '') {
+                    if ($typefilter ne 'Course') {
+                        $match = 0;
+                    }
+                } else { 
+                    unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) {
+                        $match = 0;
+                    }
+                }
+            }
             if ($match == 1) {
                 $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';
             }
@@ -4025,7 +4088,8 @@ sub enrollment_enabled_handler {
     my $userinput = $cmd.":".$tail; # For logging purposes.
 
     
-    my $cdom = split(/:/, $tail);   # Domain we're asking about.
+    my ($cdom) = split(/:/, $tail, 2);   # Domain we're asking about.
+
     my $outcome  = &localenroll::run($cdom);
     &Reply($client, "$outcome\n", $userinput);
 
@@ -4081,6 +4145,7 @@ sub validate_course_owner_handler {
     my $userinput = "$cmd:$tail";
     my ($inst_course_id, $owner, $cdom) = split(/:/, $tail);
 
+    $owner = &unescape($owner);
     my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);
     &Reply($client, "$outcome\n", $userinput);
 
@@ -4121,16 +4186,47 @@ sub validate_course_section_handler {
 &register_handler("autovalidatecourse", \&validate_course_section_handler, 0, 1, 0);
 
 #
-#   Create a password for a new auto-enrollment user.
-#   I think/guess, this password allows access to the institutions 
-#   AIS class list server/services.  Stuart can correct this comment
-#   when he finds out how wrong I am.
+#   Validate course owner's access to enrollment data for specific class section. 
+#   
 #
 # 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:
-#               $authparam - An authentication parameter (username??).
+#               $inst_class  - Institutional code for the specific class section   
+#               $courseowner - The escaped username:domain of the course owner 
+#               $cdom        - The domain of the course from the institution's
+#                              point of view.
+#    $client  - The socket open on the client.
+# Returns:
+#    1 - continue processing.
+#
+
+sub validate_class_access_handler {
+    my ($cmd, $tail, $client) = @_;
+    my $userinput = "$cmd:$tail";
+    my ($inst_class,$courseowner,$cdom) = split(/:/, $tail);
+    $courseowner = &unescape($courseowner);
+    my $outcome;
+    eval {
+	local($SIG{__DIE__})='DEFAULT';
+	$outcome=&localenroll::check_section($inst_class,$courseowner,$cdom);
+    };
+    &Reply($client,"$outcome\n", $userinput);
+
+    return 1;
+}
+&register_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0);
+
+#
+#   Create a password for a new LON-CAPA user added by auto-enrollment.
+#   Only used for case where authentication method for new user is localauth
+#
+# 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:
+#               $authparam - An authentication parameter (localauth parameter).
 #               $cdom      - The domain of the course from the institution's
 #                            point of view.
 #    $client  - The socket open on the client.
@@ -5261,7 +5357,7 @@ sub make_new_child {
 	    my $remotereq=<$client>;
 	    chomp($remotereq);
 	    Debug("Got init: $remotereq");
-	    my $inikeyword = split(/:/, $remotereq);
+
 	    if ($remotereq =~ /^init/) {
 		&sethost("sethost:$perlvar{'lonHostID'}");
 		#
@@ -5694,7 +5790,7 @@ sub get_chat {
     my @entries=();
     my $namespace = 'nohist_chatroom';
     my $namespace_inroom = 'nohist_inchatroom';
-    if (defined($group)) {
+    if ($group ne '') {
         $namespace .= '_'.$group;
         $namespace_inroom .= '_'.$group;
     }
@@ -5726,7 +5822,7 @@ sub chat_add {
     my $time=time;
     my $namespace = 'nohist_chatroom';
     my $logfile = 'chatroom.log';
-    if (defined($group)) {
+    if ($group ne '') {
         $namespace .= '_'.$group;
         $logfile = 'chatroom_'.$group.'.log';
     }
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>500 Internal Server Error</title>
</head><body>
<h1>Internal Server Error</h1>
<p>The server encountered an internal error or
misconfiguration and was unable to complete
your request.</p>
<p>Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.</p>
<p>More information about this error may be available
in the server error log.</p>
</body></html>