--- loncom/Attic/lchtmldir	2004/05/13 20:44:38	1.5
+++ loncom/Attic/lchtmldir	2004/10/19 11:11:34	1.10
@@ -67,11 +67,15 @@
 #   horses and other fine issues:
 #
 use strict; 
+use Fcntl qw(:mode);
+use DirHandle;
+
 
 $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/sbin:/home/httpd/perl';
 delete @ENV{qw{IFS CDPATH ENV BASH_ENV}};
 
 my $DEBUG = 0;                         # .nonzero -> Debug printing enabled.
+my $path_sep = "/";		# Unix like operating systems.
 
 
 # If the UID of the running process is not www exit with error.
@@ -167,7 +171,9 @@ if(($dirtry1 ne $dir) or ($dirtry2 ne $d
 
 # As root, create the directory.
 
-my $fulldir = $dirtry1."/public_html";
+my $homedir = $dirtry1;
+my $fulldir = $homedir."/public_html";
+
 if($DEBUG) {
     print("Full directory path is: $fulldir \n");
 }
@@ -207,6 +213,7 @@ it available to students and other instr
 END
     close OUT;
     }
+
 &System("/bin/chmod  02775  $fulldir");
 &System("/bin/chmod  0775  $fulldir"."/index.html");
 
@@ -214,12 +221,19 @@ END
 # Based on the authentiation mode, set the ownership of the directory.
 
 if($authentication eq "unix:") {	# Unix mode authentication...
-    &System("/bin/chown -R   $username".":".$username." ".$fulldir);
-    &JoinGroup($username);
+    &System("/bin/chown -R   $safeuser".":".$safeuser." ".$fulldir);
+    &JoinGroup($safeuser);
 } else {
     # Internal, Kerberos, and Local authentication are for users
     # who do not have unix accounts on the system.  Therefore we
     # will give ownership of their public_html directories to www:www
+    # If the user is an internal auth user, the rest of the directory tree
+    # gets owned by root.  This chown is needed in case what's really happening
+    # is that a file system user is being demoted to internal user...
+
+    if($authentication eq "internal:") {
+	&System("/bin/chown -R root:root ".$homedir);
+    }
     &System("/bin/chown -R www:www  ".$fulldir);
 }
 &DisableRoot;
@@ -238,7 +252,6 @@ exit 0;
 
 sub EnableRoot {
     if ($wwwid==$>) {
-        print ("EnableRoot $< $>\n");
 	($<,$>)=($>,$<);
 	($(,$))=($),$();
     }
@@ -268,6 +281,9 @@ sub JoinGroup {
     my $usergroup = shift;
 
     my $groups = `/usr/bin/groups www`;
+    # untaint
+    my ($safegroups)=($groups=~/:\s+([\s\w]+)/);
+    $groups=$safegroups;
     chomp $groups; $groups=~s/^\S+\s+\:\s+//;
     my @grouplist=split(/\s+/,$groups);
     my @ugrouplist=grep {!/www|$usergroup/} @grouplist;
@@ -285,11 +301,96 @@ sub JoinGroup {
 
 
 sub System {
-    my $command = shift;
+    my ($command,@args) = @_;
     if($DEBUG) {
-	print("system: $command \n");
+	print("system: $command with args ".join(' ',@args)."\n");
+    }
+    system($command,@args);
+}
+
+
+
+
+
+#
+#   This file contains code to recursively process
+#   a Directory.  This is a bit more powerful
+#   than File::Find in that we pass the full
+#   stat info to the processing function.
+#     For each file in the specified directory subtree, 
+#   The user's Code reference is invoked for all files, regular and otherwise
+#   except:
+#      ., ..
+#
+#  Parameters:
+#     code_ref    - Code reference, invoked for each file in the tree.
+#                   as follows:  CodeRef(directory, name, statinfo)
+#                   directory the path to the directory holding the file.
+#                   name      the name of the file within Directory.
+#                   statinfo  a reference to the stat of the file.
+#     start_dir   - The starting point of the directory walk.
+#
+# NOTE:
+#   Yes, we could have just used File::Find, but since we have to get the
+#   stat anyway, this is actually simpler, as File::Find would have gotten
+#   the stat to figure out the file type and then we would have gotten it
+#   again.
+#
+
+sub process_tree {
+    my ($code_ref, $start_dir)  = @_;
+
+    my $dir = new DirHandle $start_dir; 
+    if (!defined($dir)) {
+        print "Failed to  open dirhandle: $start_dir\n";
     }
-    system($command);
+
+    # Now iterate through this level of the tree:
+
+    while (defined (my $name = $dir->read)) {
+	next if $name =~/^\.\.?$/;       # Skip ., .. (see cookbook pg 319)
+	
+	my $full_name   = $start_dir.$path_sep.$name; # Full filename path.
+	my @stat_info  = lstat($full_name);
+	my $mode       = $stat_info[2];
+	my $type       = $mode & 0170000; #  File type.
+
+	# Unless the file type is a symlink, call the user code:
+
+	unless ($type == S_IFLNK) {
+	    &$code_ref($start_dir, $name, \@stat_info);
+	}
+
+	# If the entry is a directory, we need to recurse:
+
+
+	if (($type ==  S_IFDIR) != 0) {
+	    &process_tree($code_ref, $full_name);
+	}
+    }
+
+}
+#
+#  Simple test of process_tree:
+#
+sub write_script {
+    my ($dir, $name, $statinfo) = @_;
+
+    my $fullname = $dir.$path_sep.$name;
+
+    #  We're going to '' the name, but we need to deal with embedded
+    #  ' characters.  Using " is much worse as we'd then have to
+    #  escape all the shell escapes too.  This way all we need
+    #  to do is replace ' with '\''
+
+    $fullname =~ s/\'/\'\\\'\'/g;
+
+    my $perms    = $statinfo->[2] & 0777; # Just permissions.
+    printf CHMODSCRIPT "chmod 0%o '%s'\n", $perms, $fullname;
+    printf CHMODSCRIPT "chown %d:%d '%s'\n", $statinfo->[4], $statinfo->[5], 
+                                         $fullname
+
+
 }