version 1.455, 2010/08/30 13:24:20
|
version 1.467.2.1, 2011/01/25 09:39:42
|
Line 1121 sub establish_key_handler {
|
Line 1121 sub establish_key_handler {
|
sub load_handler { |
sub load_handler { |
my ($cmd, $tail, $replyfd) = @_; |
my ($cmd, $tail, $replyfd) = @_; |
|
|
|
|
|
|
# Get the load average from /proc/loadavg and calculate it as a percentage of |
# Get the load average from /proc/loadavg and calculate it as a percentage of |
# the allowed load limit as set by the perl global variable lonLoadLim |
# the allowed load limit as set by the perl global variable lonLoadLim |
|
|
Line 2422 sub user_has_session_handler {
|
Line 2424 sub user_has_session_handler {
|
|
|
my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail)); |
my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail)); |
|
|
&logthis("Looking for $udom $uname"); |
|
opendir(DIR,$perlvar{'lonIDsDir'}); |
opendir(DIR,$perlvar{'lonIDsDir'}); |
my $filename; |
my $filename; |
while ($filename=readdir(DIR)) { |
while ($filename=readdir(DIR)) { |
Line 3171 sub dump_with_regexp {
|
Line 3172 sub dump_with_regexp {
|
} |
} |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
my $clientcheckrole; |
my $skipcheck; |
if ($hashref) { |
if ($hashref) { |
my $qresult=''; |
my $qresult=''; |
my $count=0; |
my $count=0; |
if ($extra ne '') { |
if ($extra ne '') { |
$extra = &Apache::lonnet::thaw_unescape($extra); |
$extra = &Apache::lonnet::thaw_unescape($extra); |
$clientcheckrole = $extra->{'clientcheckrole'}; |
$skipcheck = $extra->{'skipcheck'}; |
} |
} |
my @ids = &Apache::lonnet::current_machine_ids(); |
my @ids = &Apache::lonnet::current_machine_ids(); |
my (%homecourses,$major,$minor,$now); |
my (%homecourses,$major,$minor,$now); |
if (($namespace eq 'roles') && (!$clientcheckrole)) { |
if (($namespace eq 'roles') && (!$skipcheck)) { |
my $loncaparev = $clientversion; |
my $loncaparev = $clientversion; |
if ($loncaparev eq '') { |
if ($loncaparev eq '') { |
$loncaparev = $Apache::lonnet::loncaparevs{$clientname}; |
$loncaparev = $Apache::lonnet::loncaparevs{$clientname}; |
Line 3197 sub dump_with_regexp {
|
Line 3198 sub dump_with_regexp {
|
if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) { |
if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) { |
my $cdom = $1; |
my $cdom = $1; |
my $cnum = $2; |
my $cnum = $2; |
unless ($clientcheckrole) { |
unless ($skipcheck) { |
next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,$minor, |
my ($role,$end,$start) = split(/\_/,$value); |
$now,\%homecourses,\@ids)); |
if (!$end || $end > $now) { |
|
next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major, |
|
$minor,\%homecourses,\@ids)); |
|
} |
} |
} |
} |
} |
} |
} |
Line 3219 sub dump_with_regexp {
|
Line 3223 sub dump_with_regexp {
|
} |
} |
} |
} |
if (&untie_user_hash($hashref)) { |
if (&untie_user_hash($hashref)) { |
if (($namespace eq 'roles') && (!$clientcheckrole)) { |
if (($namespace eq 'roles') && (!$skipcheck)) { |
if (keys(%homecourses) > 0) { |
if (keys(%homecourses) > 0) { |
$qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count, |
$qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count, |
$range,$start,$end,$major,$minor); |
$range,$start,$end,$major,$minor); |
Line 4275 sub put_domain_handler {
|
Line 4279 sub put_domain_handler {
|
sub get_domain_handler { |
sub get_domain_handler { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
|
|
|
|
my $userinput = "$client:$tail"; |
my $userinput = "$client:$tail"; |
|
|
my ($udom,$namespace,$what)=split(/:/,$tail,3); |
my ($udom,$namespace,$what)=split(/:/,$tail,3); |
Line 4419 sub get_id_handler {
|
Line 4424 sub get_id_handler {
|
sub put_dcmail_handler { |
sub put_dcmail_handler { |
my ($cmd,$tail,$client) = @_; |
my ($cmd,$tail,$client) = @_; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
|
|
my ($udom,$what)=split(/:/,$tail); |
my ($udom,$what)=split(/:/,$tail); |
chomp($what); |
chomp($what); |
my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT()); |
my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT()); |
Line 5001 sub get_sections_handler {
|
Line 5007 sub get_sections_handler {
|
sub validate_course_owner_handler { |
sub validate_course_owner_handler { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
my ($inst_course_id, $owner, $cdom) = split(/:/, $tail); |
my ($inst_course_id, $owner, $cdom, $coowners) = split(/:/, $tail); |
|
|
$owner = &unescape($owner); |
$owner = &unescape($owner); |
my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom); |
$coowners = &unescape($coowners); |
|
my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom,$coowners); |
&Reply($client, \$outcome, $userinput); |
&Reply($client, \$outcome, $userinput); |
|
|
|
|
Line 6230 sub logstatus {
|
Line 6237 sub logstatus {
|
sub initnewstatus { |
sub initnewstatus { |
my $docdir=$perlvar{'lonDocRoot'}; |
my $docdir=$perlvar{'lonDocRoot'}; |
my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt"); |
my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt"); |
my $now=time; |
my $now=time(); |
my $local=localtime($now); |
my $local=localtime($now); |
print $fh "LOND status $local - parent $$\n\n"; |
print $fh "LOND status $local - parent $$\n\n"; |
opendir(DIR,"$docdir/lon-status/londchld"); |
opendir(DIR,"$docdir/lon-status/londchld"); |
Line 6380 sub make_new_child {
|
Line 6387 sub make_new_child {
|
or die "Can't unblock SIGINT for fork: $!\n"; |
or die "Can't unblock SIGINT for fork: $!\n"; |
$children{$pid} = $clientip; |
$children{$pid} = $clientip; |
&status('Started child '.$pid); |
&status('Started child '.$pid); |
|
close($client); |
return; |
return; |
} else { |
} else { |
# Child can *not* return from this subroutine. |
# Child can *not* return from this subroutine. |
Line 7300 sub get_usersession_config {
|
Line 7308 sub get_usersession_config {
|
} |
} |
|
|
sub releasereqd_check { |
sub releasereqd_check { |
my ($cnum,$cdom,$key,$value,$major,$minor,$now,$homecourses,$ids) = @_; |
my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_; |
my $home = &Apache::lonnet::homeserver($cnum,$cdom); |
my $home = &Apache::lonnet::homeserver($cnum,$cdom); |
return if ($home eq 'no_host'); |
return if ($home eq 'no_host'); |
my ($reqdmajor,$reqdminor,$displayrole); |
my ($reqdmajor,$reqdminor,$displayrole); |
Line 7314 sub releasereqd_check {
|
Line 7322 sub releasereqd_check {
|
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); |
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); |
} |
} |
} |
} |
my ($role,$end,$start) = split(/_/,$value); |
my $hashid = $cdom.':'.$cnum; |
if (!$end || $end > $now) { |
my ($courseinfo,$cached) = |
my $hashid = $cdom.':'.$cnum; |
&Apache::lonnet::is_cached_new('courseinfo',$hashid); |
my ($courseinfo,$cached) = |
if (defined($cached)) { |
&Apache::lonnet::is_cached_new('courseinfo',$hashid); |
if (ref($courseinfo) eq 'HASH') { |
if (defined($cached)) { |
if (exists($courseinfo->{'releaserequired'})) { |
if (ref($courseinfo) eq 'HASH') { |
my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); |
if (exists($courseinfo->{'releaserequired'})) { |
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); |
my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); |
|
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); |
|
} |
|
} |
} |
} else { |
} |
if (ref($ids) eq 'ARRAY') { |
} else { |
if (grep(/^\Q$home\E$/,@{$ids})) { |
if (ref($ids) eq 'ARRAY') { |
if (ref($homecourses) eq 'HASH') { |
if (grep(/^\Q$home\E$/,@{$ids})) { |
if (ref($homecourses->{$hashid}) eq 'ARRAY') { |
if (ref($homecourses) eq 'HASH') { |
push(@{$homecourses->{$hashid}},{$key=>$value}); |
if (ref($homecourses->{$hashid}) eq 'ARRAY') { |
} else { |
push(@{$homecourses->{$hashid}},{$key=>$value}); |
$homecourses->{$hashid} = [{$key=>$value}]; |
} else { |
} |
$homecourses->{$hashid} = [{$key=>$value}]; |
} |
} |
return; |
|
} |
} |
|
return; |
} |
} |
my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home); |
} |
if (ref($courseinfo) eq 'HASH') { |
my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home); |
if (exists($courseinfo->{'releaserequired'})) { |
if (ref($courseinfo) eq 'HASH') { |
my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); |
if (exists($courseinfo->{'releaserequired'})) { |
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); |
my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); |
} |
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); |
} |
} |
|
} else { |
|
return; |
} |
} |
} |
} |
return 1; |
return 1; |
Line 7353 sub releasereqd_check {
|
Line 7360 sub releasereqd_check {
|
|
|
sub get_courseinfo_hash { |
sub get_courseinfo_hash { |
my ($cnum,$cdom,$home) = @_; |
my ($cnum,$cdom,$home) = @_; |
my $hashid = $cdom.':'.$cnum; |
my %info; |
my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.'); |
eval { |
if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') { |
local($SIG{ALRM}) = sub { die "timeout\n"; }; |
return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600); |
local($SIG{__DIE__})='DEFAULT'; |
|
alarm(3); |
|
%info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.'); |
|
alarm(0); |
|
}; |
|
if ($@) { |
|
if ($@ eq "timeout\n") { |
|
&logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>"); |
|
} else { |
|
&logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>"); |
|
} |
|
} else { |
|
if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') { |
|
my $hashid = $cdom.':'.$cnum; |
|
return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600); |
|
} |
} |
} |
return; |
return; |
} |
} |
Line 7364 sub get_courseinfo_hash {
|
Line 7386 sub get_courseinfo_hash {
|
sub check_homecourses { |
sub check_homecourses { |
my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_; |
my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_; |
my ($result,%addtocache); |
my ($result,%addtocache); |
|
my $yesterday = time - 24*3600; |
if (ref($homecourses) eq 'HASH') { |
if (ref($homecourses) eq 'HASH') { |
my %okcourses; |
my (%okcourses,%courseinfo,%recent); |
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,$value) = each(%$hashref)) { |
my $unesc_key = &unescape($key); |
my $unesc_key = &unescape($key); |
next if ($unesc_key =~ /^lasttime:/); |
if ($unesc_key =~ /^lasttime:(\w+)$/) { |
|
my $cid = $1; |
|
$cid =~ s/_/:/; |
|
if ($value > $yesterday ) { |
|
$recent{$cid} = 1; |
|
} |
|
next; |
|
} |
my $items = &Apache::lonnet::thaw_unescape($value); |
my $items = &Apache::lonnet::thaw_unescape($value); |
if (ref($items) eq 'HASH') { |
if (ref($items) eq 'HASH') { |
my $hashid = $unesc_key; |
my $hashid = $unesc_key; |
$hashid =~ s/_/:/; |
$hashid =~ s/_/:/; |
&Apache::lonnet::do_cache_new('courseinfo',$hashid,$items,600); |
$courseinfo{$hashid} = $items; |
if (ref($homecourses->{$hashid}) eq 'ARRAY') { |
if (ref($homecourses->{$hashid}) eq 'ARRAY') { |
my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'}); |
my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'}); |
if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) { |
if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) { |
Line 7391 sub check_homecourses {
|
Line 7421 sub check_homecourses {
|
&logthis('Failed to tie hash for nohist_courseids.db'); |
&logthis('Failed to tie hash for nohist_courseids.db'); |
return; |
return; |
} |
} |
|
foreach my $hashid (keys(%recent)) { |
|
my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid); |
|
unless ($cached) { |
|
&Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600); |
|
} |
|
} |
|
foreach my $hashid (keys(%{$homecourses})) { |
|
next if ($recent{$hashid}); |
|
&Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600); |
|
} |
foreach my $hashid (keys(%okcourses)) { |
foreach my $hashid (keys(%okcourses)) { |
if (ref($homecourses->{$hashid}) eq 'ARRAY') { |
if (ref($homecourses->{$hashid}) eq 'ARRAY') { |
foreach my $role (@{$homecourses->{$hashid}}) { |
foreach my $role (@{$homecourses->{$hashid}}) { |