[BACK]Return to lchtmldir CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/Attic/lchtmldir between versions 1.5 and 1.15

version 1.5, 2004/05/13 20:44:38 version 1.15, 2005/01/26 12:13:58
Line 67 Line 67
 #   horses and other fine issues:  #   horses and other fine issues:
 #  #
 use strict;   use strict; 
   use Fcntl qw(:mode);
   use DirHandle;
   use POSIX;
   
 $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/sbin:/home/httpd/perl';  $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/sbin:/home/httpd/perl';
 delete @ENV{qw{IFS CDPATH ENV BASH_ENV}};  delete @ENV{qw{IFS CDPATH ENV BASH_ENV}};
   
 my $DEBUG = 0;                         # .nonzero -> Debug printing enabled.  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 the UID of the running process is not www exit with error.
Line 167  if(($dirtry1 ne $dir) or ($dirtry2 ne $d Line 171  if(($dirtry1 ne $dir) or ($dirtry2 ne $d
   
 # As root, create the directory.  # As root, create the directory.
   
 my $fulldir = $dirtry1."/public_html";  my $homedir = $dirtry1;
   my $fulldir = $homedir."/public_html";
   
 if($DEBUG) {  if($DEBUG) {
     print("Full directory path is: $fulldir \n");      print("Full directory path is: $fulldir \n");
 }  }
Line 207  it available to students and other instr Line 213  it available to students and other instr
 END  END
     close OUT;      close OUT;
     }      }
 &System("/bin/chmod  02775  $fulldir");  
 &System("/bin/chmod  0775  $fulldir"."/index.html");  &System("/bin/chmod  02770  $fulldir");
   &System("/bin/chmod  0770  $fulldir"."/index.html");
   
   
 # Based on the authentiation mode, set the ownership of the directory.  # Based on the authentiation mode, set the ownership of the directory.
   
 if($authentication eq "unix:") { # Unix mode authentication...  if($authentication eq "unix:") { # Unix mode authentication...
     &System("/bin/chown -R   $username".":".$username." ".$fulldir);      print "Unix auth\n";
     &JoinGroup($username);      &System("/bin/chown -R   $safeuser:$safeuser"." ".$fulldir);
       &JoinGroup($safeuser);
 } else {  } else {
     # Internal, Kerberos, and Local authentication are for users      # Internal, Kerberos, and Local authentication are for users
     # who do not have unix accounts on the system.  Therefore we      # who do not have unix accounts on the system.  Therefore we
     # will give ownership of their public_html directories to www:www      # will give ownership of their public_html directories to www:www
     &System("/bin/chown -R www:www  ".$fulldir);      # 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;  &DisableRoot;
   
Line 238  exit 0; Line 277  exit 0;
   
 sub EnableRoot {  sub EnableRoot {
     if ($wwwid==$>) {      if ($wwwid==$>) {
         print ("EnableRoot $< $>\n");  
  ($<,$>)=($>,$<);   ($<,$>)=($>,$<);
  ($(,$))=($),$();   ($(,$))=($),$();
     }      }
Line 263  sub DisableRoot { Line 301  sub DisableRoot {
  print("Disable root: id = ".$>."\n");   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 {  sub JoinGroup {
     my $usergroup = shift;      my $usergroup = shift;
   
     my $groups = `/usr/bin/groups www`;      my $groups = `/usr/bin/groups www`;
       # untaint
       my ($safegroups)=($groups=~/:\s+([\s\w]+)/);
       $groups=$safegroups;
     chomp $groups; $groups=~s/^\S+\s+\:\s+//;      chomp $groups; $groups=~s/^\S+\s+\:\s+//;
     my @grouplist=split(/\s+/,$groups);      my @grouplist=split(/\s+/,$groups);
     my @ugrouplist=grep {!/www|$usergroup/} @grouplist;      my @ugrouplist=grep {!/www|$usergroup/} @grouplist;
Line 279  sub JoinGroup { Line 323  sub JoinGroup {
  }   }
  exit 6;   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 {  sub System {
     my $command = shift;      my ($command,@args) = @_;
     if($DEBUG) {      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);
    }
       }
   
   }
   #
   #   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);
   
 }  }
   
   
Removed from v.1.5  
changed lines
  Added in v.1.15

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.