version 1.280, 2005/03/03 23:21:51
|
version 1.292, 2005/08/26 19:40:38
|
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 472 sub CopyFile {
|
Line 473 sub CopyFile {
|
|
|
my ($oldfile, $newfile) = @_; |
my ($oldfile, $newfile) = @_; |
|
|
# The file must exist: |
if (! copy($oldfile,$newfile)) { |
|
return 0; |
if(-e $oldfile) { |
|
|
|
# Read the old file. |
|
|
|
my $oldfh = IO::File->new("< $oldfile"); |
|
if(!$oldfh) { |
|
return 0; |
|
} |
|
my @contents = <$oldfh>; # Suck in the entire file. |
|
|
|
# write the backup file: |
|
|
|
my $newfh = IO::File->new("> $newfile"); |
|
if(!(defined $newfh)){ |
|
return 0; |
|
} |
|
my $lines = scalar @contents; |
|
for (my $i =0; $i < $lines; $i++) { |
|
print $newfh ($contents[$i]); |
|
} |
|
|
|
$oldfh->close; |
|
$newfh->close; |
|
|
|
chmod(0660, $newfile); |
|
|
|
return 1; |
|
|
|
} else { |
|
return 0; |
|
} |
} |
|
chmod(0660, $newfile); |
|
return 1; |
} |
} |
# |
# |
# Host files are passed out with externally visible host IPs. |
# Host files are passed out with externally visible host IPs. |
Line 1391 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 |
find($code,$ududir); |
&Reply($client,"$duout\n","$cmd:$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 1441 sub ls_handler {
|
Line 1413 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 1508 sub ls2_handler {
|
Line 1481 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 1729 sub change_password_handler {
|
Line 1703 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 1840 sub add_user_handler {
|
Line 1804 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 1859 sub change_authentication_handler {
|
Line 1826 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 2388 sub put_user_profile_entry {
|
Line 2372 sub put_user_profile_entry {
|
} |
} |
®ister_handler("put", \&put_user_profile_entry, 0, 1, 0); |
®ister_handler("put", \&put_user_profile_entry, 0, 1, 0); |
|
|
|
# Put a piece of new data in hash, returns error if entry already exists |
|
# Parameters: |
|
# $cmd - The command that got us here. |
|
# $tail - Tail of the command (remaining parameters). |
|
# $client - File descriptor connected to client. |
|
# Returns |
|
# 0 - Requested to exit, caller should shut down. |
|
# 1 - Continue processing. |
|
# |
|
sub newput_user_profile_entry { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my $userinput = "$cmd:$tail"; |
|
|
|
my ($udom,$uname,$namespace,$what) =split(/:/,$tail,4); |
|
if ($namespace eq 'roles') { |
|
&Failure( $client, "refused\n", $userinput); |
|
return 1; |
|
} |
|
|
|
chomp($what); |
|
|
|
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
|
&GDBM_WRCREAT(),"N",$what); |
|
if(!$hashref) { |
|
&Failure( $client, "error: ".($!)." tie(GDBM) Failed ". |
|
"while attempting put\n", $userinput); |
|
return 1; |
|
} |
|
|
|
my @pairs=split(/\&/,$what); |
|
foreach my $pair (@pairs) { |
|
my ($key,$value)=split(/=/,$pair); |
|
if (exists($hashref->{$key})) { |
|
&Failure($client, "key_exists: ".$key."\n",$userinput); |
|
return 1; |
|
} |
|
} |
|
|
|
foreach my $pair (@pairs) { |
|
my ($key,$value)=split(/=/,$pair); |
|
$hashref->{$key}=$value; |
|
} |
|
|
|
if (untie(%$hashref)) { |
|
&Reply( $client, "ok\n", $userinput); |
|
} else { |
|
&Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
|
"while attempting put\n", |
|
$userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("newput", \&newput_user_profile_entry, 0, 1, 0); |
|
|
# |
# |
# Increment a profile entry in the user history file. |
# Increment a profile entry in the user history file. |
# The history contains keyword value pairs. In this case, |
# The history contains keyword value pairs. In this case, |
Line 2418 sub increment_user_value_handler {
|
Line 2457 sub increment_user_value_handler {
|
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
|
$value = &unescape($value); |
# We could check that we have a number... |
# We could check that we have a number... |
if (! defined($value) || $value eq '') { |
if (! defined($value) || $value eq '') { |
$value = 1; |
$value = 1; |
} |
} |
$hashref->{$key}+=$value; |
$hashref->{$key}+=$value; |
|
if ($namespace eq 'nohist_resourcetracker') { |
|
if ($hashref->{$key} < 0) { |
|
$hashref->{$key} = 0; |
|
} |
|
} |
} |
} |
if (untie(%$hashref)) { |
if (untie(%$hashref)) { |
&Reply( $client, "ok\n", $userinput); |
&Reply( $client, "ok\n", $userinput); |
Line 3280 sub dump_course_id_handler {
|
Line 3325 sub dump_course_id_handler {
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$since,$description,$instcodefilter,$ownerfilter) =split(/:/,$tail); |
my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter) =split(/:/,$tail); |
if (defined($description)) { |
if (defined($description)) { |
$description=&unescape($description); |
$description=&unescape($description); |
} else { |
} else { |
Line 3296 sub dump_course_id_handler {
|
Line 3341 sub dump_course_id_handler {
|
} else { |
} else { |
$ownerfilter='.'; |
$ownerfilter='.'; |
} |
} |
|
if (defined($coursefilter)) { |
|
$coursefilter=&unescape($coursefilter); |
|
} else { |
|
$coursefilter='.'; |
|
} |
|
|
unless (defined($since)) { $since=0; } |
unless (defined($since)) { $since=0; } |
my $qresult=''; |
my $qresult=''; |
Line 3326 sub dump_course_id_handler {
|
Line 3376 sub dump_course_id_handler {
|
$match = 0; |
$match = 0; |
} |
} |
} |
} |
|
unless ($coursefilter eq '.' || !defined($coursefilter)) { |
|
my $unescapeCourse = &unescape($key); |
|
unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) { |
|
$match = 0; |
|
} |
|
} |
if ($match == 1) { |
if ($match == 1) { |
$qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&'; |
$qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&'; |
} |
} |
Line 4497 sub Reply {
|
Line 4553 sub Reply {
|
Debug("Request was $request Reply was $reply"); |
Debug("Request was $request Reply was $reply"); |
|
|
$Transactions++; |
$Transactions++; |
|
|
|
|
} |
} |
|
|
|
|
Line 4726 $SIG{USR2} = \&UpdateHosts;
|
Line 4780 $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 4801 sub make_new_child {
|
Line 4857 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(); |
if ($dist ne 'fedora4') { |
|
&Authen::Krb5::init_ets(); |
|
} |
|
|
&status('Accepted connection'); |
&status('Accepted connection'); |
# ============================================================================= |
# ============================================================================= |
Line 5011 sub is_author {
|
Line 5069 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 5457 sub subscribe {
|
Line 5512 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)=@_; |
Line 5516 sub make_passwd_file {
|
Line 5600 sub make_passwd_file {
|
print $se "$npass\n"; |
print $se "$npass\n"; |
print $se "$lc_error_file\n"; # Status -> unique file. |
print $se "$lc_error_file\n"; # Status -> unique file. |
} |
} |
my $error = IO::File->new("< $lc_error_file"); |
if (-r $lc_error_file) { |
my $useraddok = <$error>; |
&Debug("Opening error file: $lc_error_file"); |
$error->close; |
my $error = IO::File->new("< $lc_error_file"); |
unlink($lc_error_file); |
my $useraddok = <$error>; |
|
$error->close; |
chomp $useraddok; |
unlink($lc_error_file); |
|
|
if($useraddok > 0) { |
chomp $useraddok; |
my $error_text = &lcuseraddstrerror($useraddok); |
|
&logthis("Failed lcuseradd: $error_text"); |
if($useraddok > 0) { |
$result = "lcuseradd_failed:$error_text\n"; |
my $error_text = &lcuseraddstrerror($useraddok); |
} else { |
&logthis("Failed lcuseradd: $error_text"); |
my $pf = IO::File->new(">$passfilename"); |
$result = "lcuseradd_failed:$error_text\n"; |
if($pf) { |
} else { |
print $pf "unix:\n"; |
my $pf = IO::File->new(">$passfilename"); |
} else { |
if($pf) { |
$result = "pass_file_failed_error"; |
print $pf "unix:\n"; |
|
} else { |
|
$result = "pass_file_failed_error"; |
|
} |
} |
} |
|
} else { |
|
&Debug("Could not locate lcuseradd error: $lc_error_file"); |
|
$result="bug_lcuseradd_no_output_file"; |
} |
} |
} |
} |
} elsif ($umode eq 'none') { |
} elsif ($umode eq 'none') { |