|
version 1.281, 2005/04/03 19:33:34
|
version 1.291, 2005/07/12 21:29:58
|
|
Line 112 my %Dispatcher;
|
Line 112 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 1367 sub du_handler {
|
Line 1367 sub du_handler {
|
| # assurance double sure, |
# assurance double sure, |
| # use execute_command to ensure that the command is not executed in |
# use execute_command to ensure that the command is not executed in |
| # a shell that can screw us up. |
# a shell that can screw us up. |
| |
my $file_list = execute_command("find $ududir -not -regex '.*\.[0-9]+\.[^\.]+' -not -name '*.meta' -print"); |
| my $duout = execute_command("du -ks $ududir"); |
my $duout = execute_command("du -ks $file_list"); |
| $duout=~s/[^\d]//g; #preserve only the numbers |
$duout=~s/[^\d]//g; #preserve only the numbers |
| &Reply($client,"$duout\n","$cmd:$ududir"); |
&Reply($client,"$duout\n","$cmd:$ududir"); |
| } else { |
} else { |
|
Line 1413 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 1480 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 1701 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 1812 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 1831 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 2360 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 2390 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 3252 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 3268 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 3298 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 4469 sub Reply {
|
Line 4553 sub Reply {
|
| Debug("Request was $request Reply was $reply"); |
Debug("Request was $request Reply was $reply"); |
| |
|
| $Transactions++; |
$Transactions++; |
| |
|
| |
|
| } |
} |
| |
|
| |
|
|
Line 4698 $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 4773 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 4983 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 5429 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 5488 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') { |
![[BACK]](/icons/back.gif){kind=icon}
Return to lond CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom