--- loncom/Attic/lchtmldir 2002/05/03 03:21:25 1.2
+++ 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.
@@ -117,7 +121,7 @@ if($DEBUG) {
if( $authentication ne "unix:" &&
$authentication ne "internal:" &&
- $authentication ne "krb4:" &&
+ $authentication !~ /^krb(4|5):(.*)/ &&
$authentication ne "localauth:") {
if($DEBUG) {
print("Invalid authentication parameter: ".$authentication."\n");
@@ -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");
}
@@ -175,11 +181,13 @@ if(!( -e $dirtry1)) {
if($DEBUG) {
print("User's home directory $dirtry1 does not exist\n");
}
- exit 6;
+ if ($authentication eq "unix:") {
+ exit 6;
+ }
}
&EnableRoot;
-&System("/bin/mkdir $fulldir") unless (-e $fulldir);
+&System("/bin/mkdir -p $fulldir") unless (-e $fulldir);
unless(-e $fulldir."/index.html") {
open OUT,">".$fulldir."/index.html";
print OUT<<END;
@@ -187,24 +195,25 @@ if(!( -e $dirtry1)) {
<head>
<title>$safeuser</title>
</head>
- <body>
- <h1>$safeuser</h1>
+ <body bgcolor="#ccffdd">
+ <h1>$safeuser Construction Space</h1>
+ <h2>
+ The Learning<i>Online</i> Network with Computer-Assisted Personalized Approach
+ </h2>
<p>
- Learning Online Network
+This is your construction space within LON-CAPA, where you would construct resources which are meant to be
+used across courses and institutions.
</p>
<p>
- This area provides for:
+Material within this area can only be seen and edited by $safeuser and designated co-authors. To make
+it available to students and other instructors, the material needs to be published.
</p>
- <ul>
- <li>resource construction</li>
- <li>resource publication</li>
- <li>record-keeping</li>
- </ul>
</body>
</html>
END
close OUT;
}
+
&System("/bin/chmod 02775 $fulldir");
&System("/bin/chmod 0775 $fulldir"."/index.html");
@@ -212,31 +221,20 @@ 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...
-}
-elsif ($authentication eq "internal:") { # Internal authentication.
-
- &System("/bin/chown -R www:www $fulldir");
-}
-elsif ($authentication eq "krb4:") { # Kerberos version 4 authentication
- &System("/bin/chown -R $username".':'.$username." ".$fulldir);
- &JoinGroup($username);
-}
-elsif ($authentication eq "localauth:") { # Local authentiation
- &System("/bin/chown -R $username".':'.$username." $fulldir");
-}
-else {
- if($DEBUG) {
- print("Authentication not legal".$authentication);
+ if($authentication eq "internal:") {
+ &System("/bin/chown -R root:root ".$homedir);
}
- &DisableRoot;
- exit 5;
-
+ &System("/bin/chown -R www:www ".$fulldir);
}
&DisableRoot;
@@ -261,7 +259,7 @@ sub EnableRoot {
# root capability is already enabled
}
if($DEBUG) {
- print("Enable Root - id = $> \n");
+ print("Enable Root - id = $> $<\n");
}
return $>;
}
@@ -283,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;
@@ -300,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);
+ 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";
+ }
+
+ # 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
+
+
}