version 1.376, 2007/07/25 22:52:07
|
version 1.383, 2007/10/03 19:57:23
|
Line 53 use File::Find;
|
Line 53 use File::Find;
|
use LONCAPA::lonlocal; |
use LONCAPA::lonlocal; |
use LONCAPA::lonssl; |
use LONCAPA::lonssl; |
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
|
use Apache::lonnet; |
|
|
my $DEBUG = 0; # Non zero to enable debug log entries. |
my $DEBUG = 0; # Non zero to enable debug log entries. |
|
|
Line 135 my @adderrors = ("ok",
|
Line 136 my @adderrors = ("ok",
|
"lcuseradd Unable to make www member of users's group", |
"lcuseradd Unable to make www member of users's group", |
"lcuseradd Unable to su to root", |
"lcuseradd Unable to su to root", |
"lcuseradd Unable to set password", |
"lcuseradd Unable to set password", |
"lcuseradd Usrname has invalid characters", |
"lcuseradd Username has invalid characters", |
"lcuseradd Password has an invalid character", |
"lcuseradd Password has an invalid character", |
"lcuseradd User already exists", |
"lcuseradd User already exists", |
"lcuseradd Could not add user.", |
"lcuseradd Could not add user.", |
Line 2095 sub rename_user_file_handler {
|
Line 2096 sub rename_user_file_handler {
|
®ister_handler("renameuserfile", \&rename_user_file_handler, 0,1,0); |
®ister_handler("renameuserfile", \&rename_user_file_handler, 0,1,0); |
|
|
# |
# |
|
# Checks if the specified user has an active session on the server |
|
# return ok if so, not_found if not |
|
# |
|
# Parameters: |
|
# cmd - The request keyword that dispatched to tus. |
|
# tail - The tail of the request (colon separated parameters). |
|
# client - Filehandle open on the client. |
|
# Return: |
|
# 1. |
|
sub user_has_session_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail)); |
|
|
|
&logthis("Looking for $udom $uname"); |
|
opendir(DIR,$perlvar{'lonIDsDir'}); |
|
my $filename; |
|
while ($filename=readdir(DIR)) { |
|
last if ($filename=~/^\Q$uname\E_\d+_\Q$udom\E_/); |
|
} |
|
if ($filename) { |
|
&Reply($client, "ok\n", "$cmd:$tail"); |
|
} else { |
|
&Failure($client, "not_found\n", "$cmd:$tail"); |
|
} |
|
return 1; |
|
|
|
} |
|
®ister_handler("userhassession", \&user_has_session_handler, 0,1,0); |
|
|
|
# |
# Authenticate access to a user file by checking that the token the user's |
# Authenticate access to a user file by checking that the token the user's |
# passed also exists in their session file |
# passed also exists in their session file |
# |
# |
Line 2187 sub subscribe_handler {
|
Line 2219 sub subscribe_handler {
|
®ister_handler("sub", \&subscribe_handler, 0, 1, 0); |
®ister_handler("sub", \&subscribe_handler, 0, 1, 0); |
|
|
# |
# |
# Determine the version of a resource (?) Or is it return |
# Determine the latest version of a resource (it looks for the highest |
# the top version of the resource? Not yet clear from the |
# past version and then returns that +1) |
# code in currentversion. |
|
# |
# |
# Parameters: |
# Parameters: |
# $cmd - The command that got us here. |
# $cmd - The command that got us here. |
# $tail - Tail of the command (remaining parameters). |
# $tail - Tail of the command (remaining parameters). |
|
# (Should consist of an absolute path to a file) |
# $client - File descriptor connected to client. |
# $client - File descriptor connected to client. |
# Returns |
# Returns |
# 0 - Requested to exit, caller should shut down. |
# 0 - Requested to exit, caller should shut down. |
Line 3273 sub put_course_id_handler {
|
Line 3305 sub put_course_id_handler {
|
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$courseinfo) = split(/=/,$pair,2); |
my ($key,$courseinfo) = split(/=/,$pair,2); |
$courseinfo =~ s/=/:/g; |
$courseinfo =~ s/=/:/g; |
my @current_items = split(/:/,$hashref->{$key},-1); |
if (ref($hashref) eq 'HASH') { |
shift(@current_items); # remove description |
my @items = ('description','inst_code','owner','type'); |
pop(@current_items); # remove last access |
my @new_items = split(/:/,$courseinfo,-1); |
my $numcurrent = scalar(@current_items); |
for (my $i=0; $i<@new_items; $i++) { |
if ($numcurrent > 3) { |
$hashref->{$key}{$items[$i]} = $new_items[$i]; |
$numcurrent = 3; |
} |
} |
$hashref->{$key}{'lasttime'} = $now; |
my @new_items = split(/:/,$courseinfo,-1); |
} else { |
my $numnew = scalar(@new_items); |
my @current_items = split(/:/,$hashref->{$key},-1); |
if ($numcurrent > 0) { |
shift(@current_items); # remove description |
if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2 |
pop(@current_items); # remove last access |
for (my $j=$numcurrent-$numnew; $j>=0; $j--) { |
my $numcurrent = scalar(@current_items); |
$courseinfo .= ':'.$current_items[$numcurrent-$j-1]; |
if ($numcurrent > 3) { |
|
$numcurrent = 3; |
|
} |
|
my @new_items = split(/:/,$courseinfo,-1); |
|
my $numnew = scalar(@new_items); |
|
if ($numcurrent > 0) { |
|
if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2 |
|
for (my $j=$numcurrent-$numnew; $j>=0; $j--) { |
|
$courseinfo .= ':'.$current_items[$numcurrent-$j-1]; |
|
} |
} |
} |
} |
} |
|
$hashref->{$key}=$courseinfo.':'.$now; |
} |
} |
$hashref->{$key}=$courseinfo.':'.$now; |
|
} |
} |
if (&untie_domain_hash($hashref)) { |
if (&untie_domain_hash($hashref)) { |
&Reply( $client, "ok\n", $userinput); |
&Reply( $client, "ok\n", $userinput); |
Line 3303 sub put_course_id_handler {
|
Line 3344 sub put_course_id_handler {
|
." tie(GDBM) Failed ". |
." tie(GDBM) Failed ". |
"while attempting courseidput\n", $userinput); |
"while attempting courseidput\n", $userinput); |
} |
} |
|
|
|
|
return 1; |
return 1; |
} |
} |
®ister_handler("courseidput", \&put_course_id_handler, 0, 1, 0); |
®ister_handler("courseidput", \&put_course_id_handler, 0, 1, 0); |
|
|
|
sub put_course_id_hash_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my ($udom, $what) = split(/:/, $tail,2); |
|
chomp($what); |
|
my $now=time; |
|
my @pairs=split(/\&/,$what); |
|
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT(), |
|
"P", $what); |
|
if ($hashref) { |
|
foreach my $pair (@pairs) { |
|
my ($key,$value)=split(/=/,$pair); |
|
$hashref->{$key} = $value; |
|
} |
|
if (&untie_domain_hash($hashref)) { |
|
&Reply($client, "ok\n", $userinput); |
|
} else { |
|
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
|
"while attempting courseidputhash\n", $userinput); |
|
} |
|
} else { |
|
&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". |
|
"while attempting courseidputhash\n", $userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("courseidputhash", \&put_course_id_hash_handler, 0, 1, 0); |
|
|
# Retrieves the value of a course id resource keyword pattern |
# Retrieves the value of a course id resource keyword pattern |
# defined since a starting date. Both the starting date and the |
# defined since a starting date. Both the starting date and the |
# keyword pattern are optional. If the starting date is not supplied it |
# keyword pattern are optional. If the starting date is not supplied it |
Line 3346 sub dump_course_id_handler {
|
Line 3414 sub dump_course_id_handler {
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, |
my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, |
$typefilter,$regexp_ok) =split(/:/,$tail); |
$typefilter,$regexp_ok,$as_hash) =split(/:/,$tail); |
if (defined($description)) { |
if (defined($description)) { |
$description=&unescape($description); |
$description=&unescape($description); |
} else { |
} else { |
Line 3391 sub dump_course_id_handler {
|
Line 3459 sub dump_course_id_handler {
|
my $qresult=''; |
my $qresult=''; |
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
if ($hashref) { |
if ($hashref) { |
while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$rawvalue) = each(%$hashref)) { |
my ($descr,$lasttime,$inst_code,$owner,$type); |
my ($descr,$lasttime,$inst_code,$owner,$type); |
my @courseitems = split(/:/,$value); |
my $value = &Apache::lonnet::thaw_unescape($rawvalue); |
$lasttime = pop(@courseitems); |
if (ref($value) eq 'HASH') { |
($descr,$inst_code,$owner,$type)=@courseitems; |
$descr = $value->{'description'}; |
|
$inst_code = $value->{'inst_code'}; |
|
$owner = $value->{'owner'}; |
|
$type = $value->{'type'}; |
|
$lasttime = $value->{'lasttime'}; |
|
} else { |
|
my @courseitems = split(/:/,$rawvalue); |
|
$lasttime = pop(@courseitems); |
|
($descr,$inst_code,$owner,$type)=@courseitems; |
|
} |
if ($lasttime<$since) { next; } |
if ($lasttime<$since) { next; } |
my $match = 1; |
my $match = 1; |
unless ($description eq '.') { |
unless ($description eq '.') { |
Line 3451 sub dump_course_id_handler {
|
Line 3528 sub dump_course_id_handler {
|
} |
} |
} |
} |
} |
} |
|
my $unescapeCourse = &unescape($key); |
unless ($coursefilter eq '.' || !defined($coursefilter)) { |
unless ($coursefilter eq '.' || !defined($coursefilter)) { |
my $unescapeCourse = &unescape($key); |
my $unescapeCourse = &unescape($key); |
unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) { |
unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) { |
Line 3463 sub dump_course_id_handler {
|
Line 3541 sub dump_course_id_handler {
|
if ($typefilter ne 'Course') { |
if ($typefilter ne 'Course') { |
$match = 0; |
$match = 0; |
} |
} |
} else { |
} else { |
unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) { |
unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) { |
$match = 0; |
$match = 0; |
} |
} |
} |
} |
} |
} |
if ($match == 1) { |
if ($match == 1) { |
$qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&'; |
if ($as_hash) { |
|
$qresult.=$key.'='.$rawvalue.'&'; |
|
} else { |
|
$qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&'; |
|
} |
} |
} |
} |
} |
if (&untie_domain_hash($hashref)) { |
if (&untie_domain_hash($hashref)) { |
Line 3484 sub dump_course_id_handler {
|
Line 3566 sub dump_course_id_handler {
|
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
"while attempting courseiddump\n", $userinput); |
"while attempting courseiddump\n", $userinput); |
} |
} |
|
|
|
|
return 1; |
return 1; |
} |
} |
®ister_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0); |
®ister_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0); |
Line 4304 sub validate_course_section_handler {
|
Line 4384 sub validate_course_section_handler {
|
sub validate_class_access_handler { |
sub validate_class_access_handler { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
my ($inst_class,$courseowner,$cdom) = split(/:/, $tail); |
my ($inst_class,$ownerlist,$cdom) = split(/:/, $tail); |
$courseowner = &unescape($courseowner); |
$ownerlist = &unescape($ownerlist); |
|
my @owners = split(/,/,&unescape($ownerlist)); |
my $outcome; |
my $outcome; |
eval { |
eval { |
local($SIG{__DIE__})='DEFAULT'; |
local($SIG{__DIE__})='DEFAULT'; |
$outcome=&localenroll::check_section($inst_class,$courseowner,$cdom); |
$outcome=&localenroll::check_section($inst_class,\@owners,$cdom); |
}; |
}; |
&Reply($client,"$outcome\n", $userinput); |
&Reply($client,"$outcome\n", $userinput); |
|
|
Line 4483 sub get_institutional_defaults_handler {
|
Line 4564 sub get_institutional_defaults_handler {
|
®ister_handler("autoinstcodedefaults", |
®ister_handler("autoinstcodedefaults", |
\&get_institutional_defaults_handler,0,1,0); |
\&get_institutional_defaults_handler,0,1,0); |
|
|
|
sub get_institutional_user_rules { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my $dom = &unescape($tail); |
|
my (%rules_hash,@rules_order); |
|
my $outcome; |
|
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
$outcome = &localenroll::username_rules($dom,\%rules_hash,\@rules_order); |
|
}; |
|
if (!$@) { |
|
if ($outcome eq 'ok') { |
|
my $result; |
|
foreach my $key (keys(%rules_hash)) { |
|
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&'; |
|
} |
|
$result =~ s/\&$//; |
|
$result .= ':'; |
|
if (@rules_order > 0) { |
|
foreach my $item (@rules_order) { |
|
$result .= &escape($item).'&'; |
|
} |
|
} |
|
$result =~ s/\&$//; |
|
&Reply($client,$result."\n",$userinput); |
|
} else { |
|
&Reply($client,"error\n", $userinput); |
|
} |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
} |
|
®ister_handler("instuserrules",\&get_institutional_user_rules,0,1,0); |
|
|
|
|
|
sub institutional_username_check { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my %rulecheck; |
|
my $outcome; |
|
my ($udom,$uname,@rules) = split(/:/,$tail); |
|
$udom = &unescape($udom); |
|
$uname = &unescape($uname); |
|
@rules = map {&unescape($_);} (@rules); |
|
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
$outcome = &localenroll::username_check($udom,$uname,\@rules,\%rulecheck); |
|
}; |
|
if (!$@) { |
|
if ($outcome eq 'ok') { |
|
my $result=''; |
|
foreach my $key (keys(%rulecheck)) { |
|
$result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&'; |
|
} |
|
&Reply($client,$result."\n",$userinput); |
|
} else { |
|
&Reply($client,"error\n", $userinput); |
|
} |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
} |
|
®ister_handler("instrulecheck",\&institutional_username_check,0,1,0); |
|
|
|
|
# Get domain specific conditions for import of student photographs to a course |
# Get domain specific conditions for import of student photographs to a course |
# |
# |
Line 4640 sub inst_usertypes_handler {
|
Line 4785 sub inst_usertypes_handler {
|
} |
} |
®ister_handler("inst_usertypes", \&inst_usertypes_handler, 0, 1, 0); |
®ister_handler("inst_usertypes", \&inst_usertypes_handler, 0, 1, 0); |
|
|
sub inst_dirsrch_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my ($domain,$srchby,$srchterm,$srchtype) = split(/:/, $tail); |
|
$srchby = &unescape($srchby); |
|
$srchterm = &unescape($srchterm); |
|
my $userinput = $cmd.":".$tail; # For logging purposes. |
|
my (%instusers,%instids,$result,$res); |
|
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
$result=&localenroll::get_userinfo($domain,undef,undef,\%instusers,\%instids,undef,$srchby,$srchterm,$srchtype); |
|
}; |
|
if ($result eq 'ok') { |
|
if (keys(%instusers) > 0) { |
|
foreach my $key (keys(%instusers)) { |
|
my $usrstr = &Apache::lonnet::hash2str(%{$instusers{$key}}); |
|
$res.=&escape($key).'='.&escape($usrstr).'&'; |
|
} |
|
} |
|
$res=~s/\&$//; |
|
} |
|
&Reply($client, "$res\n", $userinput); |
|
} |
|
®ister_handler("instdirsrch", \&inst_dirsrch_handler, 0, 1, 0); |
|
|
|
# mkpath makes all directories for a file, expects an absolute path with a |
# mkpath makes all directories for a file, expects an absolute path with a |
# file or a trailing / if just a dir is passed |
# file or a trailing / if just a dir is passed |
# returns 1 on success 0 on failure |
# returns 1 on success 0 on failure |
Line 5794 sub validate_user {
|
Line 5915 sub validate_user {
|
$password, |
$password, |
$credentials); |
$credentials); |
$validated = ($krbreturn == 1); |
$validated = ($krbreturn == 1); |
|
if (!$validated) { |
|
&logthis('krb5: '.$user.', '.$contentpwd.', '. |
|
&Authen::Krb5::error()); |
|
} |
} else { |
} else { |
$validated = 0; |
$validated = 0; |
} |
} |