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