#!/usr/bin/perl
# The Learning Online Network with CAPA
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# lchtmldir - LONC-CAPA setuid script to:
# o If necessary, add a public_html directory
# to the specified user home directory.
# o Set the permissions according to the authentication type.
#
# Motivations:
# Originally, account creation would create a public_html
# directory for unix authorized people only. It is possible to have
# Kerberos, internal and locally authorized 'users' which may be authors
# and hence need a properly owned an protected public_html directory
# to serve as their construction space.
#
# Author:
# Ron Fox
# NSCL
# Michigan State University8
# East Lansing, MI 48824-1321
# General flow of control:
# 1. Validate process state (must be run as www).
# 2. Validate parameters: Need two parameters:
# o Homedir - Home diretory of user
# o Username - Name of the user.
# o AuthMode - Authentication mode, can be:
# - unix
# - internal
# - krb4
# - localauth
# 3. Untaint the usename and home directory
#
# 4. As root if necessary, create $Homedir/public_html
# 5. Set ownership/permissions according to authentication mode (AuthMode)
# - unix - ~owner:www/2775
# - krb4 - ~owner:www/2775
# - internal - www:www/2775
# - local - www:www/2775
#
#
# Take a few precautions to be sure that we're not vulnerable to trojan
# horses and other fine issues:
#
use strict;
use Fcntl qw(:mode);
use DirHandle;
use POSIX;
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/sbin:/home/httpd/perl';
delete @ENV{qw{IFS CDPATH ENV BASH_ENV}};
my $DEBUG = 1; # .nonzero -> Debug printing enabled.
my $path_sep = "/"; # Unix like operating systems.
# If the UID of the running process is not www exit with error.
if ($DEBUG) {
print("Checking uid...\n");
}
my $wwwid = getpwnam('www');
&DisableRoot;
if($wwwid != $>) {
if ($DEBUG) {
print("User ID incorrect. This program must be run as user 'www'\n");
}
exit 1; # Exit with error status.
}
# There must be three 'command line' parameters. The first
# is the home directory of the user.
# The second is the name of the user. This is only referenced
# in code branches dealing with unix mode authentication.
# The last is the authentication mode which must be one of unix, internal
# krb4 or localauth.
# If there is an error in the argument count or countents, we exit with an
# error.
if ($DEBUG) {
print("Checking parameters: \n");
}
if(@ARGV != 3) {
if($DEBUG) {
print("Error: lchtmldir need 3 parameters \n");
}
exit 2;
}
my ($dir,$username,$authentication) = @ARGV;
if($DEBUG) {
print ("Directory = $dir \n");
print ("User = $username \n");
print ("Authmode = $authentication \n");
}
if( $authentication ne "unix:" &&
$authentication ne "internal:" &&
$authentication !~ /^krb(4|5):(.*)/ &&
$authentication ne "localauth:") {
if($DEBUG) {
print("Invalid authentication parameter: ".$authentication."\n");
print("Should be one of: unix, internal, krb4, localauth\n");
}
exit 3;
}
# Untaint the username.
my $match = $username =~ /^(\w+)$/;
my $patt = $1;
if($DEBUG) {
print("Username word match flag = ".$match."\n");
print("Match value = ".$patt."\n");
}
my $safeuser = $patt;
if($DEBUG) {
print("Save username = $safeuser \n");
}
if(($username ne $safeuser) or ($safeuser!~/^[A-za-z]/)) {
if($DEBUG) {
print("User name $username had illegal characters\n");
}
exit 4;
}
#untaint the base directory require that the dir contain only
# alphas, / numbers or underscores, and end in /$safeuser
$dir =~ /(^([\w\/]+))/;
my $dirtry1 = $1;
$dir =~ /$\/$safeuser/;
my $dirtry2 = $1;
if(($dirtry1 ne $dir) or ($dirtry2 ne $dir)) {
if ($DEBUG) {
print("Directory $dir is not a valid home for $safeuser\n");
}
exit 5;
}
# As root, create the directory.
my $homedir = $dirtry1;
my $fulldir = $homedir."/public_html";
if($DEBUG) {
print("Full directory path is: $fulldir \n");
}
if(!( -e $dirtry1)) {
if($DEBUG) {
print("User's home directory $dirtry1 does not exist\n");
}
if ($authentication eq "unix:") {
exit 6;
}
}
&EnableRoot;
&System("/bin/mkdir -p $fulldir") unless (-e $fulldir);
unless(-e $fulldir."/index.html") {
open OUT,">".$fulldir."/index.html";
print OUT<<END;
<html>
<head>
<title>$safeuser</title>
</head>
<body bgcolor="#ccffdd">
<h1>$safeuser Construction Space</h1>
<h2>
The Learning<i>Online</i> Network with Computer-Assisted Personalized Approach
</h2>
<p>
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>
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>
</body>
</html>
END
close OUT;
}
&System("/bin/chmod 02775 $fulldir");
&System("/bin/chmod 0775 $fulldir"."/index.html");
# Based on the authentiation mode, set the ownership of the directory.
if($authentication eq "unix:") { # Unix mode authentication...
&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:") {
# In case the user was a unix/filesystem authenticated user,
# we'll take a bit of time here to write a script in the
# user's home directory that can reset ownerships and permissions
# back the way the used to be.
# This can take long enough for lond to time out, so we'll do it
# in a separate process that we'll not wait for.
#
my $fpid = fork;
if($fpid) {
&DisableRoot;
exit 0;
} else {
print "Forked\n";
POSIX::setsid(); # Disassociate from parent.
print "Separate session\n";
&write_restore_script($homedir);
print "Restore script written\n";
&System("/bin/chown -R root:root ".$homedir);
&System("/bin/chown -R www:www ".$fulldir);
print "Exiting\n";
exit 0;
}
} else {
&System("/bin/chown -R www:www ".$fulldir);
}
}
&DisableRoot;
exit 0;
#----------------------------------------------------------------------
#
# Local utility procedures.
# These include:
# EnableRoot - Start running as root.
# DisableRoot- Stop running as root.
# JoinGroup - Join www to the specified group.
# Turn on as root:
sub EnableRoot {
if ($wwwid==$>) {
($<,$>)=($>,$<);
($(,$))=($),$();
}
else {
# root capability is already enabled
}
if($DEBUG) {
print("Enable Root - id = $> $<\n");
}
return $>;
}
sub DisableRoot {
if ($wwwid==$<) {
($<,$>)=($>,$<);
($(,$))=($),$();
}
else {
# root capability is already disabled
}
if($DEBUG) {
print("Disable root: id = ".$>."\n");
}
}
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;
my $gl=join(',',(@ugrouplist,$usergroup));
if (&System('/usr/sbin/usermod','-G',$gl,'www')) {
if($DEBUG) {
print "Error. Could not make www a member of the group ".
"\"$usergroup\".\n";
}
exit 6;
}
}
sub System {
my ($command,@args) = @_;
if($DEBUG) {
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";
}
# 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);
}
}
}
#
# Callback from process_tree to write the script lines
# requried to restore files to current ownership and permission.
# Parameters:
# dir - Name of the directory the file lives in.
# name - Name of the file itself.
# statinfo - Array from lstat called on the file.
#
#
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
}
#
# Write a script in the user's home directory that can restore
# the permissions and ownerhips of all the files in the directory
# tree to their current ownerships and permissions. This is done
# prior to making the user into an internally authenticated user
# in case they were previously file system authenticated and
# need to go back.
# The file we will create will be of the form
# restore_n.sh Where n is a number that we will keep
# incrementing as needed until there isn't a file by that name.
#
# Parameters:
# dir - Path to the user's home directory.
#
sub write_restore_script {
my ($dir) = @_;
# Create a unique file:
my $version_number = 0;
my $filename = 'restore_'.$version_number.'.sh';
my $full_name = $dir.$path_sep.$filename;
while(-e $full_name) {
$version_number++;
$filename = 'restore_'.$version_number.'.sh';
$full_name = $dir.$path_sep.$filename;
}
# $full_name is the full path of a file that does not yet exist
# of the form we want:
open(CHMODSCRIPT, "> $full_name");
&process_tree(\&write_script, $dir);
close(CHMODSCRIPT);
chmod(0750, $full_name);
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lchtmldir CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom