--- loncom/lonnet/perl/lonnet.pm 2001/01/09 22:12:28 1.90 +++ loncom/lonnet/perl/lonnet.pm 2001/01/11 11:11:27 1.97 @@ -84,6 +84,8 @@ # 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer # 05/01/01 Guy Albertelli # 05/01,06/01,09/01 Gerd Kortemeyer +# 09/01 Guy Albertelli +# 09/01,10/01,11/01 Gerd Kortemeyer package Apache::lonnet; @@ -234,7 +236,6 @@ sub critical { sub appenv { my %newenv=@_; - my ($in,$out); map { if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) { &logthis("WARNING: ". @@ -244,23 +245,27 @@ 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; unless ($fh=Apache::File->new("$ENV{'user.environment'}")) { - return 'error'; - } - unless (flock($fh,LOCK_SH)) { - &logthis("WARNING: ". - 'Could not obtain shared lock in appenv: '.$!); - $fh->close(); - return 'error: '.$!; + return 'error: '.$!; } @oldenv=<$fh>; - $in=$#oldenv+1; $fh->close(); } - &logthis("Number of elements read appenv: ".$in."from".join(" ",caller)); for (my $i=0; $i<=$#oldenv; $i++) { chomp($oldenv[$i]); if ($oldenv[$i] ne '') { @@ -276,20 +281,13 @@ sub appenv { return 'error'; } my $newname; - unless (flock($fh,LOCK_EX)) { - &logthis("WARNING: ". - 'Could not obtain exclusive lock in appenv: '.$!); - $fh->close(); - return 'error: '.$!; - } - $out=0; - foreach $newname (sort keys %newenv) { + foreach $newname (keys %newenv) { print $fh "$newname=$newenv{$newname}\n"; - $out++; } $fh->close(); } - &logthis("Number of elements read appenv: ".$in." number out:".$out."from".join(" ",caller)); + + $lockfh->close(); return 'ok'; } # ----------------------------------------------------- Delete from Environment @@ -695,8 +693,7 @@ sub coursedescription { if ($chome ne 'no_host') { my $rep=reply("dump:$cdomain:$cnum:environment",$chome); if ($rep ne 'con_lost') { - my $normalid=$courseid; - $normalid=~s/\//\_/g; + my $normalid=$cdomain.'_'.$cnum; my %envhash=(); my %returnhash=('home' => $chome, 'domain' => $cdomain, @@ -1045,6 +1042,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; @@ -1618,11 +1616,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}; } @@ -1630,25 +1628,39 @@ 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'}) { - $section='_'.$ENV{'request.course.sec'}; - } + my $reply=&reply('get:'. - $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'. - $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}. + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}. ':resourcedata:'. &escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'. &escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel), - $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'}); + $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); if ($reply!~/^error\:/) { map { 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'}.'.num'}. + ' at '. + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}. + ' from '. + $ENV{'course.'.$ENV{'request.course.id'}.'.home'}. + ""); + } # ------------------------------------------------------ third, check map parms my %parmhash=(); my $thisparm='';