--- loncom/lond 2010/08/22 19:28:26 1.454 +++ loncom/lond 2010/10/26 09:46:23 1.461 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.454 2010/08/22 19:28:26 raeburn Exp $ +# $Id: lond,v 1.461 2010/10/26 09:46:23 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,12 +53,12 @@ use LONCAPA::lonssl; use Fcntl qw(:flock); use Apache::lonnet; -my $DEBUG = 0; # Non zero to enable debug log entries. +my $DEBUG = 1; # Non zero to enable debug log entries. my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.454 $'; #' stupid emacs +my $VERSION='$Revision: 1.461 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -2155,7 +2155,10 @@ sub update_resource_handler { my $transname="$fname.in.transfer"; my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname"); my $response; - alarm(120); +# FIXME: cannot replicate files that take more than two minutes to transfer? +# alarm(120); +# FIXME: this should use the LWP mechanism, not internal alarms. + alarm(1200); { my $ua=new LWP::UserAgent; my $request=new HTTP::Request('GET',"$remoteurl"); @@ -2163,11 +2166,13 @@ sub update_resource_handler { } alarm(0); if ($response->is_error()) { +# FIXME: we should probably clean up here instead of just whine unlink($transname); my $message=$response->status_line; &logthis("LWP GET: $message for $fname ($remoteurl)"); } else { if ($remoteurl!~/\.meta$/) { +# FIXME: isn't there an internal LWP mechanism for this? alarm(120); { my $ua=new LWP::UserAgent; @@ -3166,17 +3171,17 @@ sub dump_with_regexp { } my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()); - my $clientcheckrole; + my $skipcheck; if ($hashref) { my $qresult=''; my $count=0; if ($extra ne '') { $extra = &Apache::lonnet::thaw_unescape($extra); - $clientcheckrole = $extra->{'clientcheckrole'}; + $skipcheck = $extra->{'skipcheck'}; } my @ids = &Apache::lonnet::current_machine_ids(); my (%homecourses,$major,$minor,$now); - if (($namespace eq 'roles') && (!$clientcheckrole)) { + if (($namespace eq 'roles') && (!$skipcheck)) { my $loncaparev = $clientversion; if ($loncaparev eq '') { $loncaparev = $Apache::lonnet::loncaparevs{$clientname}; @@ -3192,9 +3197,12 @@ sub dump_with_regexp { if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) { my $cdom = $1; my $cnum = $2; - unless ($clientcheckrole) { - next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,$minor, - $now,\%homecourses,\@ids)); + unless ($skipcheck) { + my ($role,$end,$start) = split(/\_/,$value); + if (!$end || $end > $now) { + next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major, + $minor,\%homecourses,\@ids)); + } } } } @@ -3214,7 +3222,7 @@ sub dump_with_regexp { } } if (&untie_user_hash($hashref)) { - if (($namespace eq 'roles') && (!$clientcheckrole)) { + if (($namespace eq 'roles') && (!$skipcheck)) { if (keys(%homecourses) > 0) { $qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count, $range,$start,$end,$major,$minor); @@ -4270,6 +4278,7 @@ sub put_domain_handler { sub get_domain_handler { my ($cmd, $tail, $client) = @_; + my $userinput = "$client:$tail"; my ($udom,$namespace,$what)=split(/:/,$tail,3); @@ -6225,7 +6234,7 @@ sub logstatus { sub initnewstatus { my $docdir=$perlvar{'lonDocRoot'}; my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt"); - my $now=time; + my $now=time(); my $local=localtime($now); print $fh "LOND status $local - parent $$\n\n"; opendir(DIR,"$docdir/lon-status/londchld"); @@ -7295,7 +7304,7 @@ sub get_usersession_config { } 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); return if ($home eq 'no_host'); my ($reqdmajor,$reqdminor,$displayrole); @@ -7309,37 +7318,34 @@ sub releasereqd_check { return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); } } - my ($role,$end,$start) = split(/_/,$value); - if (!$end || $end > $now) { - my $hashid = $cdom.':'.$cnum; - my ($courseinfo,$cached) = - &Apache::lonnet::is_cached_new('courseinfo',$hashid); - if (defined($cached)) { - if (ref($courseinfo) eq 'HASH') { - if (exists($courseinfo->{'releaserequired'})) { - my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); - return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); - } + my $hashid = $cdom.':'.$cnum; + my ($courseinfo,$cached) = + &Apache::lonnet::is_cached_new('courseinfo',$hashid); + if (defined($cached)) { + if (ref($courseinfo) eq 'HASH') { + if (exists($courseinfo->{'releaserequired'})) { + my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); + return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); } - } else { - if (ref($ids) eq 'ARRAY') { - if (grep(/^\Q$home\E$/,@{$ids})) { - if (ref($homecourses) eq 'HASH') { - if (ref($homecourses->{$hashid}) eq 'ARRAY') { - push(@{$homecourses->{$hashid}},{$key=>$value}); - } else { - $homecourses->{$hashid} = [{$key=>$value}]; - } + } + } else { + if (ref($ids) eq 'ARRAY') { + if (grep(/^\Q$home\E$/,@{$ids})) { + if (ref($homecourses) eq 'HASH') { + if (ref($homecourses->{$hashid}) eq 'ARRAY') { + push(@{$homecourses->{$hashid}},{$key=>$value}); + } else { + $homecourses->{$hashid} = [{$key=>$value}]; } - return; } + return; } - my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home); - if (ref($courseinfo) eq 'HASH') { - if (exists($courseinfo->{'releaserequired'})) { - my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); - return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); - } + } + my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home); + if (ref($courseinfo) eq 'HASH') { + if (exists($courseinfo->{'releaserequired'})) { + my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); + return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); } } } @@ -7359,18 +7365,26 @@ sub get_courseinfo_hash { sub check_homecourses { my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_; my ($result,%addtocache); + my $yesterday = time - 24*3600; if (ref($homecourses) eq 'HASH') { - my %okcourses; + my (%okcourses,%courseinfo,%recent); my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); if ($hashref) { while (my ($key,$value) = each(%$hashref)) { 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); if (ref($items) eq 'HASH') { my $hashid = $unesc_key; $hashid =~ s/_/:/; - &Apache::lonnet::do_cache_new('courseinfo',$hashid,$items,600); + $courseinfo{$hashid} = $items; if (ref($homecourses->{$hashid}) eq 'ARRAY') { my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'}); if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) { @@ -7386,6 +7400,13 @@ sub check_homecourses { &logthis('Failed to tie hash for nohist_courseids.db'); return; } + foreach my $hashid (keys(%recent)) { + &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)) { if (ref($homecourses->{$hashid}) eq 'ARRAY') { foreach my $role (@{$homecourses->{$hashid}}) {