--- loncom/lonnet/perl/lonnet.pm 2001/01/06 16:08:24 1.88
+++ loncom/lonnet/perl/lonnet.pm 2001/01/11 10:43:09 1.95
@@ -83,7 +83,9 @@
# 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,
# 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer
# 05/01/01 Guy Albertelli
-# 05/01,06/01 Gerd Kortemeyer
+# 05/01,06/01,09/01 Gerd Kortemeyer
+# 09/01 Guy Albertelli
+# 09/01,10/01,11/01 Gerd Kortemeyer
package Apache::lonnet;
@@ -180,6 +182,11 @@ sub reconlonc {
sub critical {
my ($cmd,$server)=@_;
+ unless ($hostname{$server}) {
+ &logthis("WARNING:".
+ " Critical message to unknown server ($server)");
+ return 'no_such_host';
+ }
my $answer=reply($cmd,$server);
if ($answer eq 'con_lost') {
my $pingreply=reply('ping',$server);
@@ -238,6 +245,18 @@ sub appenv {
$ENV{$_}=$newenv{$_};
}
} keys %newenv;
+
+ my $lockfh;
+ unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) {
+ return 'error';
+ }
+ unless (flock($lockfh,LOCK_EX)) {
+ &logthis("WARNING: ".
+ 'Could not obtain exclusive lock in appenv: '.$!);
+ $lockfh->close();
+ return 'error: '.$!;
+ }
+
my @oldenv;
{
my $fh;
@@ -245,6 +264,7 @@ sub appenv {
return 'error';
}
@oldenv=<$fh>;
+ $fh->close();
}
for (my $i=0; $i<=$#oldenv; $i++) {
chomp($oldenv[$i]);
@@ -261,12 +281,13 @@ sub appenv {
return 'error';
}
my $newname;
- flock($fh,LOCK_EX);
foreach $newname (keys %newenv) {
print $fh "$newname=$newenv{$newname}\n";
}
$fh->close();
}
+
+ $lockfh->close();
return 'ok';
}
# ----------------------------------------------------- Delete from Environment
@@ -285,14 +306,26 @@ sub delenv {
unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
return 'error';
}
+ unless (flock($fh,LOCK_SH)) {
+ &logthis("WARNING: ".
+ 'Could not obtain shared lock in delenv: '.$!);
+ $fh->close();
+ return 'error: '.$!;
+ }
@oldenv=<$fh>;
+ $fh->close();
}
{
my $fh;
unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
return 'error';
}
- flock($fh,LOCK_EX);
+ unless (flock($fh,LOCK_EX)) {
+ &logthis("WARNING: ".
+ 'Could not obtain exclusive lock in delenv: '.$!);
+ $fh->close();
+ return 'error: '.$!;
+ }
map {
unless ($_=~/^$delthis/) { print $fh $_; }
} @oldenv;
@@ -1010,6 +1043,7 @@ sub allowed {
if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
my $courseid=$2;
my $roleid=$1.'.'.$2;
+ $courseid=~s/^\///;
my $expiretime=600;
if ($ENV{'request.role'} eq $roleid) {
$expiretime=120;
@@ -1561,6 +1595,9 @@ sub EXT {
if ($ENV{'request.course.id'}) {
# ----------------------------------------------------- Cascading lookup scheme
my $symbp=&symbread();
+ unless ($symbp) {
+ &logthis('No symb for '.$ENV{'request.filename'});
+ }
my $mapp=(split(/\_\_\_/,$symbp))[0];
my $symbparm=$symbp.'.'.$spacequalifierrest;
@@ -1583,11 +1620,11 @@ sub EXT {
my $courselevelm=
$ENV{'request.course.id'}.'.'.$mapparm;
-
# ----------------------------------------------------------- first, check user
my %resourcedata=get('resourcedata',
($courselevelr,$courselevelm,$courselevel));
- if ($resourcedata{$courselevelr}!~/^error\:/) {
+ if (($resourcedata{$courselevelr}!~/^error\:/) &&
+ ($resourcedata{$courselevelr}!~/^con_lost/)) {
if ($resourcedata{$courselevelr}) {
return $resourcedata{$courselevelr}; }
@@ -1595,7 +1632,15 @@ sub EXT {
return $resourcedata{$courselevelm}; }
if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+ } else {
+ if ($resourcedata{$courselevelr}!~/No such file/) {
+ &logthis("WARNING:".
+ " Trying to get resource data for ".$ENV{'user.name'}." at "
+ .$ENV{'user.domain'}.": ".$resourcedata{$courselevelr}.
+ "");
+ }
}
+
# -------------------------------------------------------- second, check course
my $section='';
if ($ENV{'request.course.sec'}) {
@@ -1613,7 +1658,16 @@ sub EXT {
if ($_) { return &unescape($_); }
} split(/\&/,$reply);
}
-
+ if (($reply=~/^con_lost/) || ($reply=~/^error\:/)) {
+ &logthis("WARNING:".
+ " Getting ".$reply." asking for ".$varname." for ".
+ $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.
+ ' at '.
+ $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.
+ ' from '.
+ $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'}.
+ "");
+ }
# ------------------------------------------------------ third, check map parms
my %parmhash=();
my $thisparm='';