version 1.91, 2001/01/09 22:27:07
|
version 1.96, 2001/01/11 11:08:37
|
Line 84
|
Line 84
|
# 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer |
# 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer |
# 05/01/01 Guy Albertelli |
# 05/01/01 Guy Albertelli |
# 05/01,06/01,09/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; |
package Apache::lonnet; |
|
|
Line 234 sub critical {
|
Line 236 sub critical {
|
|
|
sub appenv { |
sub appenv { |
my %newenv=@_; |
my %newenv=@_; |
my ($in,$out); |
|
map { |
map { |
if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) { |
if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) { |
&logthis("<font color=blue>WARNING: ". |
&logthis("<font color=blue>WARNING: ". |
Line 244 sub appenv {
|
Line 245 sub appenv {
|
$ENV{$_}=$newenv{$_}; |
$ENV{$_}=$newenv{$_}; |
} |
} |
} keys %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 @oldenv; |
{ |
{ |
my $fh; |
my $fh; |
unless ($fh=Apache::File->new("$ENV{'user.environment'}")) { |
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>; |
@oldenv=<$fh>; |
$in=$#oldenv+1; |
|
&logthis("<font color=green>appenv LOCK_SH to be closed"); |
|
$fh->close(); |
$fh->close(); |
} |
} |
&logthis("<font color=green>Number of elements read appenv: ".$in."from".join(" ",caller)); |
|
for (my $i=0; $i<=$#oldenv; $i++) { |
for (my $i=0; $i<=$#oldenv; $i++) { |
chomp($oldenv[$i]); |
chomp($oldenv[$i]); |
if ($oldenv[$i] ne '') { |
if ($oldenv[$i] ne '') { |
Line 278 sub appenv {
|
Line 281 sub appenv {
|
return 'error'; |
return 'error'; |
} |
} |
my $newname; |
my $newname; |
unless (flock($fh,LOCK_EX)) { |
foreach $newname (keys %newenv) { |
&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) { |
|
print $fh "$newname=$newenv{$newname}\n"; |
print $fh "$newname=$newenv{$newname}\n"; |
$out++; |
|
} |
} |
&logthis("<font color=green>appenv LOCK_EX to be closed"); |
|
$fh->close(); |
$fh->close(); |
} |
} |
&logthis("<font color=green>Number of elements read appenv: ".$in." number out:".$out."from".join(" ",caller)); |
|
|
$lockfh->close(); |
return 'ok'; |
return 'ok'; |
} |
} |
# ----------------------------------------------------- Delete from Environment |
# ----------------------------------------------------- Delete from Environment |
Line 699 sub coursedescription {
|
Line 693 sub coursedescription {
|
if ($chome ne 'no_host') { |
if ($chome ne 'no_host') { |
my $rep=reply("dump:$cdomain:$cnum:environment",$chome); |
my $rep=reply("dump:$cdomain:$cnum:environment",$chome); |
if ($rep ne 'con_lost') { |
if ($rep ne 'con_lost') { |
my $normalid=$courseid; |
my $normalid=$cdomain.'_'.$cnum; |
$normalid=~s/\//\_/g; |
|
my %envhash=(); |
my %envhash=(); |
my %returnhash=('home' => $chome, |
my %returnhash=('home' => $chome, |
'domain' => $cdomain, |
'domain' => $cdomain, |
Line 1049 sub allowed {
|
Line 1042 sub allowed {
|
if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) { |
if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) { |
my $courseid=$2; |
my $courseid=$2; |
my $roleid=$1.'.'.$2; |
my $roleid=$1.'.'.$2; |
|
$courseid=~s/^\///; |
my $expiretime=600; |
my $expiretime=600; |
if ($ENV{'request.role'} eq $roleid) { |
if ($ENV{'request.role'} eq $roleid) { |
$expiretime=120; |
$expiretime=120; |
Line 1622 sub EXT {
|
Line 1616 sub EXT {
|
my $courselevelm= |
my $courselevelm= |
$ENV{'request.course.id'}.'.'.$mapparm; |
$ENV{'request.course.id'}.'.'.$mapparm; |
|
|
|
|
# ----------------------------------------------------------- first, check user |
# ----------------------------------------------------------- first, check user |
my %resourcedata=get('resourcedata', |
my %resourcedata=get('resourcedata', |
($courselevelr,$courselevelm,$courselevel)); |
($courselevelr,$courselevelm,$courselevel)); |
if ($resourcedata{$courselevelr}!~/^error\:/) { |
if (($resourcedata{$courselevelr}!~/^error\:/) && |
|
($resourcedata{$courselevelr}!~/^con_lost/)) { |
|
|
if ($resourcedata{$courselevelr}) { |
if ($resourcedata{$courselevelr}) { |
return $resourcedata{$courselevelr}; } |
return $resourcedata{$courselevelr}; } |
Line 1634 sub EXT {
|
Line 1628 sub EXT {
|
return $resourcedata{$courselevelm}; } |
return $resourcedata{$courselevelm}; } |
if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; } |
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 |
# -------------------------------------------------------- second, check course |
my $section=''; |
|
if ($ENV{'request.course.sec'}) { |
|
$section='_'.$ENV{'request.course.sec'}; |
|
} |
|
my $reply=&reply('get:'. |
my $reply=&reply('get:'. |
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'. |
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. |
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}. |
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}. |
':resourcedata:'. |
':resourcedata:'. |
&escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'. |
&escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'. |
&escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel), |
&escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel), |
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'}); |
$ENV{'course.'.$ENV{'request.course.id'}.'.home'}); |
if ($reply!~/^error\:/) { |
if ($reply!~/^error\:/) { |
map { |
map { |
if ($_) { return &unescape($_); } |
if ($_) { return &unescape($_); } |
} split(/\&/,$reply); |
} 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 |
# ------------------------------------------------------ third, check map parms |
my %parmhash=(); |
my %parmhash=(); |
my $thisparm=''; |
my $thisparm=''; |