Return to lchtmldir CVS log

Up to [LON-CAPA] / loncom

Allow users with usernames including . and - to have public_html directories, when given an author role.

#!/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;
use lib '/home/httpd/lib/perl/';
use LONCAPA qw(:match);

$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 =~ /^($match_username)$/;
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) {
    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;
    }
}
if ($authentication eq "unix:") {
    # check whether group $safeuser exists.
    my $usergroups = `id -nG $safeuser`;
    if (! grep /^$safeuser$/, split(/\s+/,$usergroups)) { 
        if($DEBUG) {
            print("Group \"$safeuser\" does not exist or $safeuser is not a member of that group.\n");
        }
        exit 7;
    }
}



&EnableRoot;

#  If authentication is internal and the top level directory exists
#  give it the right permissions (in case this is a modification.

if ($authentication eq "internal:") {
    chmod(0711, $homedir);	# so www can enter ~/public_html.
}

&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  02770  $fulldir");
&System("/bin/chmod  0770  $fulldir"."/index.html");


# Based on the authentiation mode, set the ownership of the directory.

if($authentication eq "unix:") {	# Unix mode authentication...
    print "Unix auth\n";
    &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");
    }
}
#
#  Join the www user to the user's group.
#  we must be running with euid as root at this time.
#
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;
    }
    if (-e '/var/run/httpd.pid') {
	open(PID,'/var/run/httpd.pid');
	my $pid=<PID>;
	close(PID);
	my ($safepid) = $pid=~ /(\d+)/;
	$pid = $safepid;
	if ($pid) {
	    my $status = system("kill -USR1 $safepid");
	}
    }
}



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);

}