--- loncom/lond	2004/09/08 18:57:33	1.252
+++ loncom/lond	2004/10/18 10:13:46	1.261
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.252 2004/09/08 18:57:33 albertel Exp $
+# $Id: lond,v 1.261 2004/10/18 10:13:46 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -57,7 +57,7 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.252 $'; #' stupid emacs
+my $VERSION='$Revision: 1.261 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1065,6 +1065,50 @@ sub tie_user_hash {
     
 }
 
+#   read_profile
+#
+#   Returns a set of specific entries from a user's profile file.
+#   this is a utility function that is used by both get_profile_entry and
+#   get_profile_entry_encrypted.
+#
+# Parameters:
+#    udom       - Domain in which the user exists.
+#    uname      - User's account name (loncapa account)
+#    namespace  - The profile namespace to open.
+#    what       - A set of & separated queries.
+# Returns:
+#    If all ok: - The string that needs to be shipped back to the user.
+#    If failure - A string that starts with error: followed by the failure
+#                 reason.. note that this probabyl gets shipped back to the
+#                 user as well.
+#
+sub read_profile {
+    my ($udom, $uname, $namespace, $what) = @_;
+    
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				 &GDBM_READER());
+    if ($hashref) {
+        my @queries=split(/\&/,$what);
+        my $qresult='';
+	
+	for (my $i=0;$i<=$#queries;$i++) {
+	    $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.
+	}
+	$qresult=~s/\&$//;              # Remove trailing & from last lookup.
+	if (untie %$hashref) {
+	    return $qresult;
+	} else {
+	    return "error: ".($!+0)." untie (GDBM) Failed";
+	}
+    } else {
+	if ($!+0 == 2) {
+	    return "error:No such file or GDBM reported bad block error";
+	} else {
+	    return "error: ".($!+0)." tie (GDBM) Failed";
+	}
+    }
+
+}
 #--------------------- Request Handlers --------------------------------------------
 #
 #   By convention each request handler registers itself prior to the sub 
@@ -1762,9 +1806,25 @@ sub change_authentication_handler {
 	chomp($npass);
 	
 	$npass=&unescape($npass);
+	my $oldauth = &get_auth_type($udom, $uname); # Get old auth info.
 	my $passfilename = &password_path($udom, $uname);
 	if ($passfilename) {	# Not allowed to create a new user!!
 	    my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
+	    #
+	    #  If the current auth mode is internal, and the old auth mode was
+	    #  unix, or krb*,  and the user is an author for this domain,
+	    #  re-run manage_permissions for that role in order to be able
+	    #  to take ownership of the construction space back to www:www
+	    #
+
+	    if( ($oldauth =~ /^unix/) && ($umode eq "internal")) { # unix -> internal
+		if(&is_author($udom, $uname)) {
+		    &Debug(" Need to manage author permissions...");
+		    &manage_permissions("/$udom/_au", $udom, $uname, "internal:");
+		}
+	    }
+	       
+
 	    &Reply($client, $result, $userinput);
 	} else {	       
 	    &Failure($client, "non_authorized\n", $userinput); # Fail the user now.
@@ -1994,12 +2054,19 @@ sub remove_user_file_handler {
 	if (-e $udir) {
 	    my $file=$udir.'/userfiles/'.$ufile;
 	    if (-e $file) {
+		#
+		#   If the file is a regular file unlink is fine...
+		#   However it's possible the client wants a dir.
+		#   removed, in which case rmdir is more approprate:
+		#
 	        if (-f $file){
 		    unlink($file);
 		} elsif(-d $file) {
 		    rmdir($file);
 		}
 		if (-e $file) {
+		    #  File is still there after we deleted it ?!?
+
 		    &Failure($client, "failed\n", "$cmd:$tail");
 		} else {
 		    &Reply($client, "ok\n", "$cmd:$tail");
@@ -2040,7 +2107,14 @@ sub mkdir_user_file_handler {
 	if (-e $udir) {
 	    my $newdir=$udir.'/userfiles/'.$ufile;
 	    if (!-e $newdir) {
-		mkdir($newdir);
+		my @parts=split('/',$newdir);
+		my $path;
+		foreach my $part (@parts) {
+		    $path .= '/'.$part;
+		    if (!-e $path) {
+			mkdir($path,0770);
+		    }
+		}
 		if (!-e $newdir) {
 		    &Failure($client, "failed\n", "$cmd:$tail");
 		} else {
@@ -2387,11 +2461,14 @@ sub roles_put_handler {
     #  is done on close this improves the chances the log will be an un-
     #  corrupted ordered thing.
     if ($hashref) {
+	my $pass_entry = &get_auth_type($udom, $uname);
+	my ($auth_type,$pwd)  = split(/:/, $pass_entry);
+	$auth_type = $auth_type.":";
 	my @pairs=split(/\&/,$what);
 	foreach my $pair (@pairs) {
 	    my ($key,$value)=split(/=/,$pair);
 	    &manage_permissions($key, $udom, $uname,
-			       &get_auth_type( $udom, $uname));
+			       $auth_type);
 	    $hashref->{$key}=$value;
 	}
 	if (untie($hashref)) {
@@ -2486,32 +2563,17 @@ sub get_profile_entry {
    
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);
-    my $hashref = &tie_user_hash($udom, $uname, $namespace,
-				 &GDBM_READER());
-    if ($hashref) {
-        my @queries=split(/\&/,$what);
-        my $qresult='';
-	
-	for (my $i=0;$i<=$#queries;$i++) {
-	    $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.
-	}
-	$qresult=~s/\&$//;              # Remove trailing & from last lookup.
-	if (untie(%$hashref)) {
-	    &Reply($client, "$qresult\n", $userinput);
-	} else {
-	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
-		    "while attempting get\n", $userinput);
-	}
+
+    my $replystring = read_profile($udom, $uname, $namespace, $what);
+    my ($first) = split(/:/,$replystring);
+    if($first ne "error") {
+	&Reply($client, "$replystring\n", $userinput);
     } else {
-	if ($!+0 == 2) {               # +0 coerces errno -> number 2 is ENOENT
-	    &Failure($client, "error:No such file or ".
-		    "GDBM reported bad block error\n", $userinput);
-	} else {                        # Some other undifferentiated err.
-	    &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
-		    "while attempting get\n", $userinput);
-	}
+	&Failure($client, $replystring." while attempting get\n", $userinput);
     }
     return 1;
+
+
 }
 &register_handler("get", \&get_profile_entry, 0,1,0);
 
@@ -2541,42 +2603,32 @@ sub get_profile_entry_encrypted {
    
     my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);
     chomp($what);
-    my $hashref = &tie_user_hash($udom, $uname, $namespace,
-				 &GDBM_READER());
-    if ($hashref) {
-        my @queries=split(/\&/,$what);
-        my $qresult='';
-	for (my $i=0;$i<=$#queries;$i++) {
-	    $qresult.="$hashref->{$queries[$i]}&";
-	}
-	if (untie(%$hashref)) {
-	    $qresult=~s/\&$//;
-	    if ($cipher) {
-		my $cmdlength=length($qresult);
-		$qresult.="         ";
-		my $encqresult='';
-		for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
-		    $encqresult.= unpack("H16", 
-					 $cipher->encrypt(substr($qresult,
-								 $encidx,
-								 8)));
-		}
-		&Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);
-	    } else {
-		&Failure( $client, "error:no_key\n", $userinput);
+    my $qresult = read_profile($udom, $uname, $namespace, $what);
+    my ($first) = split(/:/, $qresult);
+    if($first ne "error") {
+	
+	if ($cipher) {
+	    my $cmdlength=length($qresult);
+	    $qresult.="         ";
+	    my $encqresult='';
+	    for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
+		$encqresult.= unpack("H16", 
+				     $cipher->encrypt(substr($qresult,
+							     $encidx,
+							     8)));
 	    }
+	    &Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);
 	} else {
-	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
-		    "while attempting eget\n", $userinput);
-	}
+		&Failure( $client, "error:no_key\n", $userinput);
+	    }
     } else {
-	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
-		"while attempting eget\n", $userinput);
+	&Failure($client, "$qresult while attempting eget\n", $userinput);
+
     }
     
     return 1;
 }
-&register_handler("eget", \&GetProfileEntryEncrypted, 0, 1, 0);
+&register_handler("eget", \&get_profile_entry_encrypted, 0, 1, 0);
 #
 #   Deletes a key in a user profile database.
 #   
@@ -3124,21 +3176,22 @@ sub put_course_id_handler {
     my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
     if ($hashref) {
 	foreach my $pair (@pairs) {
-	    my ($key,$value)=split(/=/,$pair);
-	    $hashref->{$key}=$value.':'.$now;
+	    my ($key,$descr,$inst_code)=split(/=/,$pair);
+	    $hashref->{$key}=$descr.':'.$inst_code.':'.$now;
 	}
 	if (untie(%$hashref)) {
-	    &Reply($client, "ok\n", $userinput);
+	    &Reply( $client, "ok\n", $userinput);
 	} else {
-	    &Failure( $client, "error: ".($!+0)
+	    &Failure($client, "error: ".($!+0)
 		     ." untie(GDBM) Failed ".
 		     "while attempting courseidput\n", $userinput);
 	}
     } else {
-	&Failure( $client, "error: ".($!+0)
+	&Failure($client, "error: ".($!+0)
 		 ." tie(GDBM) Failed ".
 		 "while attempting courseidput\n", $userinput);
     }
+    
 
     return 1;
 }
@@ -4888,8 +4941,35 @@ sub make_new_child {
     exit;
     
 }
+#
+#   Determine if a user is an author for the indicated domain.
+#
+# Parameters:
+#    domain          - domain to check in .
+#    user            - Name of user to check.
+#
+# Return:
+#     1             - User is an author for domain.
+#     0             - User is not an author for domain.
+sub is_author {
+    my ($domain, $user) = @_;
+
+    &Debug("is_author: $user @ $domain");
 
+    my $hashref = &tie_user_hash($domain, $user, "roles",
+				 &GDBM_READER());
 
+    #  Author role should show up as a key /domain/_au
+
+    my $key   = "/$domain/_au";
+    my $value = $hashref->{$key};
+
+    if(defined($value)) {
+	&Debug("$user @ $domain is an author");
+    }
+
+    return defined($value);
+}
 #
 #   Checks to see if the input roleput request was to set
 # an author role.  If so, invokes the lchtmldir script to set
@@ -4904,13 +4984,17 @@ sub make_new_child {
 sub manage_permissions
 {
 
+
     my ($request, $domain, $user, $authtype) = @_;
 
+    &Debug("manage_permissions: $request $domain $user $authtype");
+
     # See if the request is of the form /$domain/_au
     if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...
 	my $execdir = $perlvar{'lonDaemons'};
 	my $userhome= "/home/$user" ;
 	&logthis("system $execdir/lchtmldir $userhome $user $authtype");
+	&Debug("Setting homedir permissions for $userhome");
 	system("$execdir/lchtmldir $userhome $user $authtype");
     }
 }
@@ -5006,12 +5090,7 @@ sub get_auth_type
 	Debug("Password info = $realpassword\n");
 	my ($authtype, $contentpwd) = split(/:/, $realpassword);
 	Debug("Authtype = $authtype, content = $contentpwd\n");
-	my $availinfo = '';
-	if($authtype eq 'krb4' or $authtype eq 'krb5') {
-	    $availinfo = $contentpwd;
-	}
-
-	return "$authtype:$availinfo";
+	return "$authtype:$contentpwd";     
     } else {
 	Debug("Returning nouser");
 	return "nouser";
@@ -5360,7 +5439,11 @@ sub make_passwd_file {
     if ($umode eq 'krb4' or $umode eq 'krb5') {
 	{
 	    my $pf = IO::File->new(">$passfilename");
-	    print $pf "$umode:$npass\n";
+	    if ($pf) {
+		print $pf "$umode:$npass\n";
+	    } else {
+		$result = "pass_file_failed_error";
+	    }
 	}
     } elsif ($umode eq 'internal') {
 	my $salt=time;
@@ -5369,12 +5452,20 @@ sub make_passwd_file {
 	{
 	    &Debug("Creating internal auth");
 	    my $pf = IO::File->new(">$passfilename");
-	    print $pf "internal:$ncpass\n"; 
+	    if($pf) {
+		print $pf "internal:$ncpass\n"; 
+	    } else {
+		$result = "pass_file_failed_error";
+	    }
 	}
     } elsif ($umode eq 'localauth') {
 	{
 	    my $pf = IO::File->new(">$passfilename");
-	    print $pf "localauth:$npass\n";
+	    if($pf) {
+		print $pf "localauth:$npass\n";
+	    } else {
+		$result = "pass_file_failed_error";
+	    }
 	}
     } elsif ($umode eq 'unix') {
 	{
@@ -5413,13 +5504,21 @@ sub make_passwd_file {
 		$result = "lcuseradd_failed:$error_text\n";
 	    }  else {
 		my $pf = IO::File->new(">$passfilename");
-		print $pf "unix:\n";
+		if($pf) {
+		    print $pf "unix:\n";
+		} else {
+		    $result = "pass_file_failed_error";
+		}
 	    }
 	}
     } elsif ($umode eq 'none') {
 	{
 	    my $pf = IO::File->new("> $passfilename");
-	    print $pf "none:\n";
+	    if($pf) {
+		print $pf "none:\n";
+	    } else {
+		$result = "pass_file_failed_error";
+	    }
 	}
     } else {
 	$result="auth_mode_error\n";