version 1.285, 2005/06/21 11:01:35
|
version 1.297, 2005/09/08 17:14:41
|
Line 48 use localauth;
|
Line 48 use localauth;
|
use localenroll; |
use localenroll; |
use localstudentphoto; |
use localstudentphoto; |
use File::Copy; |
use File::Copy; |
|
use File::Find; |
use LONCAPA::ConfigFileEdit; |
use LONCAPA::ConfigFileEdit; |
use LONCAPA::lonlocal; |
use LONCAPA::lonlocal; |
use LONCAPA::lonssl; |
use LONCAPA::lonssl; |
Line 112 my %Dispatcher;
|
Line 113 my %Dispatcher;
|
# |
# |
my $lastpwderror = 13; # Largest error number from lcpasswd. |
my $lastpwderror = 13; # Largest error number from lcpasswd. |
my @passwderrors = ("ok", |
my @passwderrors = ("ok", |
"lcpasswd must be run as user 'www'", |
"pwchange_failure - lcpasswd must be run as user 'www'", |
"lcpasswd got incorrect number of arguments", |
"pwchange_failure - lcpasswd got incorrect number of arguments", |
"lcpasswd did not get the right nubmer of input text lines", |
"pwchange_failure - lcpasswd did not get the right nubmer of input text lines", |
"lcpasswd too many simultaneous pwd changes in progress", |
"pwchange_failure - lcpasswd too many simultaneous pwd changes in progress", |
"lcpasswd User does not exist.", |
"pwchange_failure - lcpasswd User does not exist.", |
"lcpasswd Incorrect current passwd", |
"pwchange_failure - lcpasswd Incorrect current passwd", |
"lcpasswd Unable to su to root.", |
"pwchange_failure - lcpasswd Unable to su to root.", |
"lcpasswd Cannot set new passwd.", |
"pwchange_failure - lcpasswd Cannot set new passwd.", |
"lcpasswd Username has invalid characters", |
"pwchange_failure - lcpasswd Username has invalid characters", |
"lcpasswd Invalid characters in password", |
"pwchange_failure - lcpasswd Invalid characters in password", |
"lcpasswd User already exists", |
"pwchange_failure - lcpasswd User already exists", |
"lcpasswd Something went wrong with user addition.", |
"pwchange_failure - lcpasswd Something went wrong with user addition.", |
"lcpasswd Password mismatch", |
"pwchange_failure - lcpasswd Password mismatch", |
"lcpasswd Error filename is invalid"); |
"pwchange_failure - lcpasswd Error filename is invalid"); |
|
|
|
|
# The array below are lcuseradd error strings.: |
# The array below are lcuseradd error strings.: |
Line 1363 sub du_handler {
|
Line 1364 sub du_handler {
|
# etc. |
# etc. |
# |
# |
if (-d $ududir) { |
if (-d $ududir) { |
# And as Shakespeare would say to make |
my $total_size=0; |
# assurance double sure, |
my $code=sub { |
# use execute_command to ensure that the command is not executed in |
if ($_=~/\.\d+\./) { return;} |
# a shell that can screw us up. |
if ($_=~/\.meta$/) { return;} |
|
$total_size+=(stat($_))[7]; |
my $duout = execute_command("du -ks $ududir"); |
}; |
$duout=~s/[^\d]//g; #preserve only the numbers |
chdir($ududir); |
&Reply($client,"$duout\n","$cmd:$ududir"); |
find($code,$ududir); |
|
$total_size=int($total_size/1024); |
|
&Reply($client,"$total_size\n","$cmd:$ududir"); |
} else { |
} else { |
|
|
&Failure($client, "bad_directory:$ududir\n","$cmd:$ududir"); |
&Failure($client, "bad_directory:$ududir\n","$cmd:$ududir"); |
|
|
} |
} |
return 1; |
return 1; |
} |
} |
Line 1413 sub ls_handler {
|
Line 1414 sub ls_handler {
|
if(-d $ulsdir) { |
if(-d $ulsdir) { |
if (opendir(LSDIR,$ulsdir)) { |
if (opendir(LSDIR,$ulsdir)) { |
while ($ulsfn=readdir(LSDIR)) { |
while ($ulsfn=readdir(LSDIR)) { |
undef $obs, $rights; |
undef($obs); |
|
undef($rights); |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
#We do some obsolete checking here |
#We do some obsolete checking here |
if(-e $ulsdir.'/'.$ulsfn.".meta") { |
if(-e $ulsdir.'/'.$ulsfn.".meta") { |
Line 1480 sub ls2_handler {
|
Line 1482 sub ls2_handler {
|
if(-d $ulsdir) { |
if(-d $ulsdir) { |
if (opendir(LSDIR,$ulsdir)) { |
if (opendir(LSDIR,$ulsdir)) { |
while ($ulsfn=readdir(LSDIR)) { |
while ($ulsfn=readdir(LSDIR)) { |
undef $obs, $rights; |
undef($obs); |
|
undef($rights); |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
#We do some obsolete checking here |
#We do some obsolete checking here |
if(-e $ulsdir.'/'.$ulsfn.".meta") { |
if(-e $ulsdir.'/'.$ulsfn.".meta") { |
Line 1701 sub change_password_handler {
|
Line 1704 sub change_password_handler {
|
&Failure( $client, "non_authorized\n",$userinput); |
&Failure( $client, "non_authorized\n",$userinput); |
} |
} |
} elsif ($howpwd eq 'unix') { |
} elsif ($howpwd eq 'unix') { |
# Unix means we have to access /etc/password |
my $result = &change_unix_password($uname, $npass); |
&Debug("auth is unix"); |
|
my $execdir=$perlvar{'lonDaemons'}; |
|
&Debug("Opening lcpasswd pipeline"); |
|
my $pf = IO::File->new("|$execdir/lcpasswd > " |
|
."$perlvar{'lonDaemons'}" |
|
."/logs/lcpasswd.log"); |
|
print $pf "$uname\n$npass\n$npass\n"; |
|
close $pf; |
|
my $err = $?; |
|
my $result = ($err>0 ? 'pwchange_failure' : 'ok'); |
|
&logthis("Result of password change for $uname: ". |
&logthis("Result of password change for $uname: ". |
&lcpasswdstrerror($?)); |
$result); |
&Reply($client, "$result\n", $userinput); |
&Reply($client, "$result\n", $userinput); |
} else { |
} else { |
# this just means that the current password mode is not |
# this just means that the current password mode is not |
Line 1812 sub add_user_handler {
|
Line 1805 sub add_user_handler {
|
# Implicit inputs: |
# Implicit inputs: |
# The authentication systems describe above have their own forms of implicit |
# The authentication systems describe above have their own forms of implicit |
# input into the authentication process that are described above. |
# input into the authentication process that are described above. |
|
# NOTE: |
|
# This is also used to change the authentication credential values (e.g. passwd). |
|
# |
# |
# |
sub change_authentication_handler { |
sub change_authentication_handler { |
|
|
Line 1831 sub change_authentication_handler {
|
Line 1827 sub change_authentication_handler {
|
my $oldauth = &get_auth_type($udom, $uname); # Get old auth info. |
my $oldauth = &get_auth_type($udom, $uname); # Get old auth info. |
my $passfilename = &password_path($udom, $uname); |
my $passfilename = &password_path($udom, $uname); |
if ($passfilename) { # Not allowed to create a new user!! |
if ($passfilename) { # Not allowed to create a new user!! |
my $result=&make_passwd_file($uname, $umode,$npass,$passfilename); |
# If just changing the unix passwd. need to arrange to run |
# |
# passwd since otherwise make_passwd_file will run |
# If the current auth mode is internal, and the old auth mode was |
# lcuseradd which fails if an account already exists |
# unix, or krb*, and the user is an author for this domain, |
# (to prevent an unscrupulous LONCAPA admin from stealing |
# re-run manage_permissions for that role in order to be able |
# an existing account by overwriting it as a LonCAPA account). |
# to take ownership of the construction space back to www:www |
|
# |
if(($oldauth =~/^unix/) && ($umode eq "unix")) { |
|
my $result = &change_unix_password($uname, $npass); |
if( (($oldauth =~ /^unix/) && ($umode eq "internal")) || |
&logthis("Result of password change for $uname: ".$result); |
(($oldauth =~ /^internal/) && ($umode eq "unix")) ) { |
if ($result eq "ok") { |
if(&is_author($udom, $uname)) { |
&Reply($client, "$result\n") |
&Debug(" Need to manage author permissions..."); |
} else { |
&manage_permissions("/$udom/_au", $udom, $uname, "$umode:"); |
&Failure($client, "$result\n"); |
|
} |
|
} else { |
|
my $result=&make_passwd_file($uname, $umode,$npass,$passfilename); |
|
# |
|
# If the current auth mode is internal, and the old auth mode was |
|
# unix, or krb*, and the user is an author for this domain, |
|
# re-run manage_permissions for that role in order to be able |
|
# to take ownership of the construction space back to www:www |
|
# |
|
|
|
|
|
if( (($oldauth =~ /^unix/) && ($umode eq "internal")) || |
|
(($oldauth =~ /^internal/) && ($umode eq "unix")) ) { |
|
if(&is_author($udom, $uname)) { |
|
&Debug(" Need to manage author permissions..."); |
|
&manage_permissions("/$udom/_au", $udom, $uname, "$umode:"); |
|
} |
} |
} |
|
&Reply($client, $result, $userinput); |
} |
} |
|
|
|
|
&Reply($client, $result, $userinput); |
|
} else { |
} else { |
&Failure($client, "non_authorized\n", $userinput); # Fail the user now. |
&Failure($client, "non_authorized\n", $userinput); # Fail the user now. |
} |
} |
Line 4392 sub ReadHostTable {
|
Line 4405 sub ReadHostTable {
|
open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; |
open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; |
my $myloncapaname = $perlvar{'lonHostID'}; |
my $myloncapaname = $perlvar{'lonHostID'}; |
Debug("My loncapa name is : $myloncapaname"); |
Debug("My loncapa name is : $myloncapaname"); |
|
my %name_to_ip; |
while (my $configline=<CONFIG>) { |
while (my $configline=<CONFIG>) { |
if ($configline !~ /^\s*\#/ && $configline !~ /^\s*$/ ) { |
if ($configline !~ /^\s*\#/ && $configline !~ /^\s*$/ ) { |
my ($id,$domain,$role,$name)=split(/:/,$configline); |
my ($id,$domain,$role,$name)=split(/:/,$configline); |
$name=~s/\s//g; |
$name=~s/\s//g; |
my $ip = gethostbyname($name); |
my $ip; |
if (length($ip) ne 4) { |
if (!exists($name_to_ip{$name})) { |
&logthis("Skipping host $id name $name no IP $ip found\n"); |
$ip = gethostbyname($name); |
next; |
if (!$ip || length($ip) ne 4) { |
|
&logthis("Skipping host $id name $name no IP found\n"); |
|
next; |
|
} |
|
$ip=inet_ntoa($ip); |
|
$name_to_ip{$name} = $ip; |
|
} else { |
|
$ip = $name_to_ip{$name}; |
} |
} |
$ip=inet_ntoa($ip); |
|
$hostid{$ip}=$id; # LonCAPA name of host by IP. |
$hostid{$ip}=$id; # LonCAPA name of host by IP. |
$hostdom{$id}=$domain; # LonCAPA domain name of host. |
$hostdom{$id}=$domain; # LonCAPA domain name of host. |
$hostip{$id}=$ip; # IP address of host. |
$hostip{$id}=$ip; # IP address of host. |
Line 4768 $SIG{USR2} = \&UpdateHosts;
|
Line 4788 $SIG{USR2} = \&UpdateHosts;
|
|
|
ReadHostTable; |
ReadHostTable; |
|
|
|
my $dist=`$perlvar{'lonDaemons'}/distprobe`; |
|
|
# -------------------------------------------------------------- |
# -------------------------------------------------------------- |
# Accept connections. When a connection comes in, it is validated |
# Accept connections. When a connection comes in, it is validated |
# and if good, a child process is created to process transactions |
# and if good, a child process is created to process transactions |
Line 4843 sub make_new_child {
|
Line 4865 sub make_new_child {
|
# my $tmpsnum=0; # Now global |
# my $tmpsnum=0; # Now global |
#---------------------------------------------------- kerberos 5 initialization |
#---------------------------------------------------- kerberos 5 initialization |
&Authen::Krb5::init_context(); |
&Authen::Krb5::init_context(); |
&Authen::Krb5::init_ets(); |
unless (($dist eq 'fedora4') || ($dist eq 'suse9.3')) { |
|
&Authen::Krb5::init_ets(); |
|
} |
|
|
&status('Accepted connection'); |
&status('Accepted connection'); |
# ============================================================================= |
# ============================================================================= |
Line 5053 sub is_author {
|
Line 5077 sub is_author {
|
# user - Name of the user for which the role is being put. |
# user - Name of the user for which the role is being put. |
# authtype - The authentication type associated with the user. |
# authtype - The authentication type associated with the user. |
# |
# |
sub manage_permissions |
sub manage_permissions { |
{ |
|
|
|
|
|
my ($request, $domain, $user, $authtype) = @_; |
my ($request, $domain, $user, $authtype) = @_; |
|
|
&Debug("manage_permissions: $request $domain $user $authtype"); |
&Debug("manage_permissions: $request $domain $user $authtype"); |
|
|
# See if the request is of the form /$domain/_au |
# See if the request is of the form /$domain/_au |
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... |
if($request =~ /^(\/\Q$domain\E\/_au)$/) { # It's an author rolesput... |
my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
my $userhome= "/home/$user" ; |
my $userhome= "/home/$user" ; |
&logthis("system $execdir/lchtmldir $userhome $user $authtype"); |
&logthis("system $execdir/lchtmldir $userhome $user $authtype"); |
Line 5455 sub thisversion {
|
Line 5476 sub thisversion {
|
sub subscribe { |
sub subscribe { |
my ($userinput,$clientip)=@_; |
my ($userinput,$clientip)=@_; |
my $result; |
my $result; |
my ($cmd,$fname)=split(/:/,$userinput); |
my ($cmd,$fname)=split(/:/,$userinput,2); |
my $ownership=&ishome($fname); |
my $ownership=&ishome($fname); |
if ($ownership eq 'owner') { |
if ($ownership eq 'owner') { |
# explitly asking for the current version? |
# explitly asking for the current version? |
Line 5499 sub subscribe {
|
Line 5520 sub subscribe {
|
} |
} |
return $result; |
return $result; |
} |
} |
|
# Change the passwd of a unix user. The caller must have |
|
# first verified that the user is a loncapa user. |
|
# |
|
# Parameters: |
|
# user - Unix user name to change. |
|
# pass - New password for the user. |
|
# Returns: |
|
# ok - if success |
|
# other - Some meaningfule error message string. |
|
# NOTE: |
|
# invokes a setuid script to change the passwd. |
|
sub change_unix_password { |
|
my ($user, $pass) = @_; |
|
|
|
&Debug("change_unix_password"); |
|
my $execdir=$perlvar{'lonDaemons'}; |
|
&Debug("Opening lcpasswd pipeline"); |
|
my $pf = IO::File->new("|$execdir/lcpasswd > " |
|
."$perlvar{'lonDaemons'}" |
|
."/logs/lcpasswd.log"); |
|
print $pf "$user\n$pass\n$pass\n"; |
|
close $pf; |
|
my $err = $?; |
|
return ($err < @passwderrors) ? $passwderrors[$err] : |
|
"pwchange_falure - unknown error"; |
|
|
|
|
|
} |
|
|
|
|
sub make_passwd_file { |
sub make_passwd_file { |
my ($uname, $umode,$npass,$passfilename)=@_; |
my ($uname, $umode,$npass,$passfilename)=@_; |