--- loncom/lonnet/perl/lonnet.pm 2000/09/26 20:07:24 1.32 +++ loncom/lonnet/perl/lonnet.pm 2000/10/04 15:59:07 1.35 @@ -33,6 +33,7 @@ # dump(namesp) : dumps the complete namespace into a hash # ssi(url,hash) : does a complete request cycle on url to localhost, posts # hash +# coursedescription(id) : returns and caches course description for id # repcopy(filename) : replicate file # dirlist(url) : gets a directory listing # condval(index) : value of condition index based on state @@ -51,7 +52,8 @@ # 06/26 Ben Tyszka # 06/30,07/15,07/17,07/18,07/20,07/21,07/22,07/25 Gerd Kortemeyer # 08/14 Ben Tyszka -# 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25 Gerd Kortemeyer +# 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30, +# 10/04 Gerd Kortemeyer package Apache::lonnet; @@ -196,6 +198,15 @@ sub critical { sub appenv { my %newenv=@_; + map { + if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) { + &logthis("WARNING: ". + "Attempt to modify environment ".$_." to ".$newenv{$_}); + delete($newenv{$_}); + } else { + $ENV{$_}=$newenv{$_}; + } + } keys %newenv; my @oldenv; { my $fh; @@ -413,10 +424,7 @@ sub store { my $symb; unless ($symb=escape(&symbread())) { return ''; } my $namespace; - unless ($namespace=$ENV{'request.course.uri'}) { return ''; } - $namespace=~s/\//\_\_/g; - $namespace=~s/\./\_/g; - $namespace=escape($namespace); + unless ($namespace=$ENV{'request.course.id'}) { return ''; } my $namevalue=''; map { $namevalue.=escape($_).'='.escape($storehash{$_}).'&'; @@ -433,10 +441,7 @@ sub restore { my $symb; unless ($symb=escape(&symbread())) { return ''; } my $namespace; - unless ($namespace=$ENV{'request.course.uri'}) { return ''; } - $namespace=~s/\//\_\_/g; - $namespace=~s/\./\_/g; - $namespace=escape($namespace); + unless ($namespace=$ENV{'request.course.id'}) { return ''; } my $answer=reply( "restore:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb", "$ENV{'user.home'}"); @@ -451,6 +456,39 @@ sub restore { return %returnhash; } +# ---------------------------------------------------------- Course Description + +sub coursedescription { + my $courseid=shift; + $courseid=~s/^\///; + my ($cdomain,$cnum)=split(/\//,$courseid); + my $chome=homeserver($cnum,$cdomain); + if ($chome ne 'no_host') { + my $rep=reply("dump:$cdomain:$cnum:environment",$chome); + if ($rep ne 'con_lost') { + my %cachehash=(); + my %returnhash=('home' => $chome, + 'domain' => $cdomain, + 'num' => $cnum); + map { + my ($name,$value)=split(/\=/,$_); + $name=&unescape($name); + $value=&unescape($value); + $returnhash{$name}=$value; + if ($name eq 'description') { + $cachehash{$courseid}=$value; + } + } split(/\&/,$rep); + $returnhash{'url'}='/res/'.declutter($returnhash{'url'}); + $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. + $ENV{'user.name.'}.'_'.$cdomain.'_'.$cnum; + put ('coursedescriptions',%cachehash); + return %returnhash; + } + } + return (); +} + # -------------------------------------------------------- Get user priviledges sub rolesinit { @@ -664,13 +702,13 @@ sub allowed { } else { - unless(defined($ENV{'request.course.uri'})) { + unless(defined($ENV{'request.course.id'})) { return '1'; } # Get access priviledges for course - if ($ENV{'user.priv./'.$ENV{'request.course.uri'}}=~/$priv\&([^\:]*)/) { + if ($ENV{'user.priv./'.$ENV{'request.course.id'}}=~/$priv\&([^\:]*)/) { $thisallowed.=$1; } @@ -683,7 +721,7 @@ sub allowed { $#uriparts--; my $uripath=join('/',@uriparts); my $uricond=-1; - if ($ENV{'acc.res.'.$ENV{'request.course'}.'.'.$uripath}=~ + if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~ /\&$urifile\:(\d+)\&/) { $uricond=$1; } elsif (($fe{$uritype} eq 'emb') || ($fe{$uritype} eq 'img')) { @@ -694,7 +732,7 @@ sub allowed { $urifile=$uriparts[$#uriparts]; $#uriparts--; $uripath=join('/',@uriparts); - if ($ENV{'acc.res.'.$ENV{'request.course'}.'.'.$uripath}=~ + if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~ /\&$urifile\:(\d+)\&/) { $uricond=$1; } @@ -898,8 +936,8 @@ sub dirlist { sub condval { my $condidx=shift; my $result=0; - if ($ENV{'request.course'}) { - if (defined($ENV{'acc.cond.'.$ENV{'request.course'}.'.'.$condidx})) { + if ($ENV{'request.course.id'}) { + if (defined($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$condidx})) { my $operand='|'; my @stack; map { @@ -916,14 +954,14 @@ sub condval { $operand=$_; } else { my $new= - substr($ENV{'user.state.'.$ENV{'request.course'}},$_,1); + substr($ENV{'user.state.'.$ENV{'request.course.id'}},$_,1); if ($operand eq '&') { $result=$result>$new?$new:$result; } else { $result=$result>$new?$result:$new; } } - } ($ENV{'acc.cond.'.$ENV{'request.course'}.'.'.$condidx}=~ + } ($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$condidx}=~ /(\d+|\(|\)|\&|\|)/g); } } @@ -1018,7 +1056,7 @@ sub rndseed { return int( $symbseed .$nameseed .unpack("%32C*",$ENV{'user.domain'}) - .unpack("%32C*",$ENV{'request.course.uri'}) + .unpack("%32C*",$ENV{'request.course.id'}) .$namechck .$symbchck); }