--- loncom/lond 2010/08/22 03:44:12 1.453
+++ loncom/lond 2011/04/05 15:49:27 1.467.2.2
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.453 2010/08/22 03:44:12 raeburn Exp $
+# $Id: lond,v 1.467.2.2 2011/04/05 15:49:27 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -58,7 +58,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.453 $'; #' stupid emacs
+my $VERSION='$Revision: 1.467.2.2 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -1121,6 +1121,8 @@ sub establish_key_handler {
sub load_handler {
my ($cmd, $tail, $replyfd) = @_;
+
+
# 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
@@ -2155,7 +2157,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 +2168,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;
@@ -2417,7 +2424,6 @@ sub user_has_session_handler {
my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));
- &logthis("Looking for $udom $uname");
opendir(DIR,$perlvar{'lonIDsDir'});
my $filename;
while ($filename=readdir(DIR)) {
@@ -3166,17 +3172,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 +3198,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 +3223,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 +4279,7 @@ sub put_domain_handler {
sub get_domain_handler {
my ($cmd, $tail, $client) = @_;
+
my $userinput = "$client:$tail";
my ($udom,$namespace,$what)=split(/:/,$tail,3);
@@ -4414,7 +4424,8 @@ sub get_id_handler {
sub put_dcmail_handler {
my ($cmd,$tail,$client) = @_;
my $userinput = "$cmd:$tail";
-
+
+
my ($udom,$what)=split(/:/,$tail);
chomp($what);
my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());
@@ -4678,7 +4689,7 @@ sub tmp_put_handler {
}
my ($id,$store);
$tmpsnum++;
- if ($context eq 'resetpw') {
+ if (($context eq 'resetpw') || ($context eq 'createaccount')) {
$id = &md5_hex(&md5_hex(time.{}.rand().$$));
} else {
$id = $$.'_'.$clientip.'_'.$tmpsnum;
@@ -4996,10 +5007,11 @@ sub get_sections_handler {
sub validate_course_owner_handler {
my ($cmd, $tail, $client) = @_;
my $userinput = "$cmd:$tail";
- my ($inst_course_id, $owner, $cdom) = split(/:/, $tail);
+ my ($inst_course_id, $owner, $cdom, $coowners) = split(/:/, $tail);
$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);
@@ -5987,7 +5999,7 @@ if (-e $pidfile) {
$server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},
Type => SOCK_STREAM,
Proto => 'tcp',
- Reuse => 1,
+ ReuseAddr => 1,
Listen => 10 )
or die "making socket: $@\n";
@@ -6225,7 +6237,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");
@@ -6375,6 +6387,7 @@ sub make_new_child {
or die "Can't unblock SIGINT for fork: $!\n";
$children{$pid} = $clientip;
&status('Started child '.$pid);
+ close($client);
return;
} else {
# Child can *not* return from this subroutine.
@@ -6383,6 +6396,14 @@ sub make_new_child {
#don't get intercepted
$SIG{USR1}= \&logstatus;
$SIG{ALRM}= \&timeout;
+
+ #
+ # Block sigpipe as it gets thrownon socket disconnect and we want to
+ # deal with that as a read faiure instead.
+ #
+ my $blockset = POSIX::SigSet->new(SIGPIPE);
+ sigprocmask(SIG_BLOCK, $blockset);
+
$lastlog='Forked ';
$status='Forked';
@@ -7295,7 +7316,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,38 +7330,37 @@ 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));
}
+ } else {
+ return;
}
}
return 1;
@@ -7348,10 +7368,25 @@ sub releasereqd_check {
sub get_courseinfo_hash {
my ($cnum,$cdom,$home) = @_;
- my $hashid = $cdom.':'.$cnum;
- my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
- if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
- return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
+ my %info;
+ eval {
+ local($SIG{ALRM}) = sub { die "timeout\n"; };
+ local($SIG{__DIE__})='DEFAULT';
+ alarm(3);
+ %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
+ alarm(0);
+ };
+ if ($@) {
+ if ($@ eq "timeout\n") {
+ &logthis("WARNING courseiddump for $cnum:$cdom from $home timedout");
+ } else {
+ &logthis("WARNING unexpected error during eval of call for courseiddump from $home");
+ }
+ } 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;
}
@@ -7359,18 +7394,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 +7429,16 @@ sub check_homecourses {
&logthis('Failed to tie hash for nohist_courseids.db');
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)) {
if (ref($homecourses->{$hashid}) eq 'ARRAY') {
foreach my $role (@{$homecourses->{$hashid}}) {