--- loncom/lonnet/perl/lonnet.pm 2001/01/09 22:27:07 1.91
+++ loncom/lonnet/perl/lonnet.pm 2001/01/19 21:19:28 1.99
@@ -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("<font color=blue>WARNING: ".
@@ -244,25 +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("<font color=blue>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';
+ return 'error: '.$!;
}
- unless (flock($fh,LOCK_SH)) {
- &logthis("<font color=blue>WARNING: ".
- 'Could not obtain shared lock in appenv: '.$!);
- $fh->close();
- return 'error: '.$!;
- }
- &logthis("<font color=green>appenv LOCK_SH gotten");
@oldenv=<$fh>;
- $in=$#oldenv+1;
- &logthis("<font color=green>appenv LOCK_SH to be closed");
$fh->close();
}
- &logthis("<font color=green>Number of elements read appenv: ".$in."from".join(" ",caller));
for (my $i=0; $i<=$#oldenv; $i++) {
chomp($oldenv[$i]);
if ($oldenv[$i] ne '') {
@@ -278,22 +281,13 @@ sub appenv {
return 'error';
}
my $newname;
- unless (flock($fh,LOCK_EX)) {
- &logthis("<font color=blue>WARNING: ".
- 'Could not obtain exclusive lock in appenv: '.$!);
- $fh->close();
- return 'error: '.$!;
- }
- &logthis("<font color=green>appenv LOCK_EX gotten");
- $out=0;
- foreach $newname (sort keys %newenv) {
+ foreach $newname (keys %newenv) {
print $fh "$newname=$newenv{$newname}\n";
- $out++;
}
- &logthis("<font color=green>appenv LOCK_EX to be closed");
$fh->close();
}
- &logthis("<font color=green>Number of elements read appenv: ".$in." number out:".$out."from".join(" ",caller));
+
+ $lockfh->close();
return 'ok';
}
# ----------------------------------------------------- Delete from Environment
@@ -699,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,
@@ -1049,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;
@@ -1622,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}; }
@@ -1634,25 +1628,39 @@ sub EXT {
return $resourcedata{$courselevelm}; }
if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+ } else {
+ if ($resourcedata{$courselevelr}!~/No such file/) {
+ &logthis("<font color=blue>WARNING:".
+ " Trying to get resource data for ".$ENV{'user.name'}." at "
+ .$ENV{'user.domain'}.": ".$resourcedata{$courselevelr}.
+ "</font>");
+ }
}
+
# -------------------------------------------------------- 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("<font color=blue>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'}.
+ "</font>");
+ }
# ------------------------------------------------------ third, check map parms
my %parmhash=();
my $thisparm='';
@@ -1835,16 +1843,20 @@ sub numval {
sub rndseed {
my $symb;
unless ($symb=&symbread()) { return time; }
- my $symbchck=unpack("%32C*",$symb);
- my $symbseed=numval($symb)%$symbchck;
- my $namechck=unpack("%32C*",$ENV{'user.name'});
- my $nameseed=numval($ENV{'user.name'})%$namechck;
- return int( $symbseed
- .$nameseed
- .unpack("%32C*",$ENV{'user.domain'})
- .unpack("%32C*",$ENV{'request.course.id'})
- .$namechck
- .$symbchck);
+ {
+ use integer;
+ my $symbchck=unpack("%32C*",$symb) << 27;
+ my $symbseed=numval($symb)%$symbchck << 22;
+ my $namechck=unpack("%32C*",$ENV{'user.name'}) << 17;
+ my $nameseed=numval($ENV{'user.name'})%$namechck << 12;
+ my $domainseed=unpack("%32C*",$ENV{'user.domain'}) << 7;
+ my $courseseed=unpack("%32C*",$ENV{'request.course.id'});
+ my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;
+ #uncommenting these lines can break things!
+ #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+ #&Apache::lonxml::debug("rndseed :$num:$symb");
+ return $num;
+ }
}
sub ireceipt {