version 1.37, 2000/10/06 21:00:05
|
version 1.48, 2000/10/25 10:55:46
|
Line 25
|
Line 25
|
# revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role |
# revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role |
# appenv(hash) : adds hash to session environment |
# appenv(hash) : adds hash to session environment |
# store(hash) : stores hash permanently for this url |
# store(hash) : stores hash permanently for this url |
|
# cstore(hash) : critical store |
# restore : returns hash for this url |
# restore : returns hash for this url |
# eget(namesp,array) : returns hash with keys from array filled in from namesp |
# eget(namesp,array) : returns hash with keys from array filled in from namesp |
# get(namesp,array) : returns hash with keys from array filled in from namesp |
# get(namesp,array) : returns hash with keys from array filled in from namesp |
# del(namesp,array) : deletes keys out of arry from namesp |
# del(namesp,array) : deletes keys out of array from namesp |
# put(namesp,hash) : stores hash in namesp |
# put(namesp,hash) : stores hash in namesp |
|
# cput(namesp,hash) : critical put |
# 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 |
# 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 |
|
# directcondval(index) : reading condition value of single condition from |
|
# state string |
# condval(index) : value of condition index based on state |
# condval(index) : value of condition index based on state |
# varval(name) : value of a variable |
# varval(name) : value of a variable |
# refreshstate() : refresh the state information string |
# refreshstate() : refresh the state information string |
# symblist(map,hash) : Updates symbolic storage links |
# symblist(map,hash) : Updates symbolic storage links |
|
# symbread([filename]) : returns the data handle (filename optional) |
# rndseed() : returns a random seed |
# rndseed() : returns a random seed |
# getfile(filename) : returns the contents of filename, or a -1 if it can't |
# getfile(filename) : returns the contents of filename, or a -1 if it can't |
# be found, replicates and subscribes to the file |
# be found, replicates and subscribes to the file |
# filelocation(dir,file) : returns a farily clean absolute reference to file |
# filelocation(dir,file) : returns a farily clean absolute reference to file |
# from the directory dir |
# from the directory dir |
|
# hreflocation(dir,file) : same as filelocation, but for hrefs |
|
# log(domain,user,home,msg) : write to permanent log for user |
# |
# |
# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30, |
# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30, |
# 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19, |
# 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19, |
Line 59
|
Line 66
|
# 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer |
# 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer |
# 10/04 Gerd Kortemeyer |
# 10/04 Gerd Kortemeyer |
# 10/04 Guy Albertelli |
# 10/04 Guy Albertelli |
# 10/06 Gerd Kortemeyer |
# 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25 Gerd Kortemeyer |
|
|
package Apache::lonnet; |
package Apache::lonnet; |
|
|
Line 420 sub ssi {
|
Line 427 sub ssi {
|
|
|
sub log { |
sub log { |
my ($dom,$nam,$hom,$what)=@_; |
my ($dom,$nam,$hom,$what)=@_; |
return reply("log:$dom:$nam:$what",$hom); |
return critical("log:$dom:$nam:$what",$hom); |
} |
} |
|
|
# ----------------------------------------------------------------------- Store |
# ----------------------------------------------------------------------- Store |
Line 428 sub log {
|
Line 435 sub log {
|
sub store { |
sub store { |
my %storehash=@_; |
my %storehash=@_; |
my $symb; |
my $symb; |
unless ($symb=escape(&symbread($ENV{'request.filename'}))) { return ''; } |
unless ($symb=escape(&symbread())) { return ''; } |
my $namespace; |
my $namespace; |
unless ($namespace=$ENV{'request.course.id'}) { return ''; } |
unless ($namespace=$ENV{'request.course.id'}) { return ''; } |
my $namevalue=''; |
my $namevalue=''; |
Line 441 sub store {
|
Line 448 sub store {
|
"$ENV{'user.home'}"); |
"$ENV{'user.home'}"); |
} |
} |
|
|
|
# -------------------------------------------------------------- Critical Store |
|
|
|
sub cstore { |
|
my %storehash=@_; |
|
my $symb; |
|
unless ($symb=escape(&symbread())) { return ''; } |
|
my $namespace; |
|
unless ($namespace=$ENV{'request.course.id'}) { return ''; } |
|
my $namevalue=''; |
|
map { |
|
$namevalue.=escape($_).'='.escape($storehash{$_}).'&'; |
|
} keys %storehash; |
|
$namevalue=~s/\&$//; |
|
return critical( |
|
"store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue", |
|
"$ENV{'user.home'}"); |
|
} |
|
|
# --------------------------------------------------------------------- Restore |
# --------------------------------------------------------------------- Restore |
|
|
sub restore { |
sub restore { |
my $symb; |
my $symb; |
unless ($symb=escape(&symbread($ENV{'request.filename'}))) { return ''; } |
unless ($symb=escape(&symbread())) { return ''; } |
my $namespace; |
my $namespace; |
unless ($namespace=$ENV{'request.course.id'}) { return ''; } |
unless ($namespace=$ENV{'request.course.id'}) { return ''; } |
my $answer=reply( |
my $answer=reply( |
Line 487 sub coursedescription {
|
Line 512 sub coursedescription {
|
} split(/\&/,$rep); |
} split(/\&/,$rep); |
$returnhash{'url'}='/res/'.declutter($returnhash{'url'}); |
$returnhash{'url'}='/res/'.declutter($returnhash{'url'}); |
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
$ENV{'user.name.'}.'_'.$cdomain.'_'.$cnum; |
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; |
put ('coursedescriptions',%cachehash); |
put ('coursedescriptions',%cachehash); |
return %returnhash; |
return %returnhash; |
} |
} |
Line 593 sub get {
|
Line 618 sub get {
|
$ENV{'user.home'}); |
$ENV{'user.home'}); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
my %returnhash=(); |
my %returnhash=(); |
|
my $i=0; |
map { |
map { |
my ($key,$value)=split(/=/,$_); |
$returnhash{$_}=unescape($pairs[$i]); |
$returnhash{unescape($key)}=unescape($value); |
$i++; |
} @pairs; |
} @storearr; |
return %returnhash; |
return %returnhash; |
} |
} |
|
|
Line 641 sub put {
|
Line 667 sub put {
|
$ENV{'user.home'}); |
$ENV{'user.home'}); |
} |
} |
|
|
|
# ------------------------------------------------------ critical put interface |
|
|
|
sub cput { |
|
my ($namespace,%storehash)=@_; |
|
my $items=''; |
|
map { |
|
$items.=escape($_).'='.escape($storehash{$_}).'&'; |
|
} keys %storehash; |
|
$items=~s/\&$//; |
|
return critical |
|
("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items", |
|
$ENV{'user.home'}); |
|
} |
|
|
# -------------------------------------------------------------- eget interface |
# -------------------------------------------------------------- eget interface |
|
|
sub eget { |
sub eget { |
Line 654 sub eget {
|
Line 694 sub eget {
|
$ENV{'user.home'}); |
$ENV{'user.home'}); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
my %returnhash=(); |
my %returnhash=(); |
|
my $i=0; |
map { |
map { |
my ($key,$value)=split(/=/,$_); |
$returnhash{$_}=unescape($pairs[$i]); |
$returnhash{unescape($key)}=unescape($value); |
$i++; |
} @pairs; |
} @storearr; |
return %returnhash; |
return %returnhash; |
} |
} |
|
|
Line 756 sub allowed {
|
Line 797 sub allowed {
|
# Restricted by state? |
# Restricted by state? |
|
|
if ($thisallowed=~/X/) { |
if ($thisallowed=~/X/) { |
if (&condval($uricond)>1) { |
if (&condval($uricond)) { |
return '2'; |
return '2'; |
} else { |
} else { |
return ''; |
return ''; |
Line 939 sub dirlist {
|
Line 980 sub dirlist {
|
|
|
# -------------------------------------------------------- Value of a Condition |
# -------------------------------------------------------- Value of a Condition |
|
|
|
sub directcondval { |
|
my $number=shift; |
|
if ($ENV{'user.state.'.$ENV{'request.course.id'}}) { |
|
return substr($ENV{'user.state.'.$ENV{'request.course.id'}},$number,1); |
|
} else { |
|
return 2; |
|
} |
|
} |
|
|
sub condval { |
sub condval { |
my $condidx=shift; |
my $condidx=shift; |
my $result=0; |
my $result=0; |
Line 959 sub condval {
|
Line 1009 sub condval {
|
} elsif (($_ eq '&') || ($_ eq '|')) { |
} elsif (($_ eq '&') || ($_ eq '|')) { |
$operand=$_; |
$operand=$_; |
} else { |
} else { |
my $new= |
my $new=directcondval($_); |
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 { |
Line 977 sub condval {
|
Line 1026 sub condval {
|
# --------------------------------------------------------- Value of a Variable |
# --------------------------------------------------------- Value of a Variable |
|
|
sub varval { |
sub varval { |
my ($realm,$space,@components)=split(/\./,shift); |
my $varname=shift; |
my $value=''; |
my ($realm,$space,$qualifier,@therest)=split(/\./,$varname); |
|
my $rest; |
|
if ($therest[0]) { |
|
$rest=join('.',@therest); |
|
} else { |
|
$rest=''; |
|
} |
if ($realm eq 'user') { |
if ($realm eq 'user') { |
if ($space=~/^resource/) { |
# --------------------------------------------------------------- user.resource |
$space=~s/^resource\[//; |
if ($space eq 'resource') { |
$space=~s/\]$//; |
# ----------------------------------------------------------------- user.access |
|
} elsif ($space eq 'access') { |
|
return &allowed($qualifier,$rest); |
|
# ------------------------------------------ user.preferences, user.environment |
|
} elsif (($space eq 'preferences') || ($space eq 'environment')) { |
|
return $ENV{join('.',('environment',$qualifier,$rest))}; |
|
# ----------------------------------------------------------------- user.course |
|
} elsif ($space eq 'course') { |
|
return $ENV{join('.',('request.course',$qualifier))}; |
|
# ------------------------------------------------------------------- user.role |
|
} elsif ($space eq 'role') { |
|
my ($role,$where)=split(/\./,$ENV{'request.role'}); |
|
if ($qualifier eq 'value') { |
|
return $role; |
|
} elsif ($qualifier eq 'extent') { |
|
return $where; |
|
} |
|
# ----------------------------------------------------------------- user.domain |
|
} elsif ($space eq 'domain') { |
|
return $ENV{'user.domain'}; |
|
# ------------------------------------------------------------------- user.name |
|
} elsif ($space eq 'name') { |
|
return $ENV{'user.name'}; |
|
# ---------------------------------------------------- Any other user namespace |
} else { |
} else { |
|
my $item=($rest)?$qualifier.'.'.$rest:$qualifier; |
|
my %reply=&get($space,$item); |
|
return $reply{$item}; |
|
} |
|
} elsif ($realm eq 'request') { |
|
# ------------------------------------------------------------- request.browser |
|
if ($space eq 'browser') { |
|
return $ENV{'browser.'.$qualifier}; |
|
} elsif ($space eq 'filename') { |
|
return $ENV{'request.filename'}; |
} |
} |
} elsif ($realm eq 'course') { |
} elsif ($realm eq 'course') { |
} elsif ($realm eq 'session') { |
# ---------------------------------------------------------- course.description |
|
if ($space eq 'description') { |
|
return &coursedescription($ENV{'request.course.id'}); |
|
# ------------------------------------------------------------------- course.id |
|
} elsif ($space eq 'id') { |
|
return $ENV{'request.course.id'}; |
|
# -------------------------------------------------- Any other course namespace |
|
} else { |
|
my ($cdom,$cnam)=split(/\_/,$ENV{'request.course.id'}); |
|
my $chome=&homeserver($cnam,$cdom); |
|
my $item=join('.',($qualifier,$rest)); |
|
return &unescape |
|
(&reply('get:'.$cdom.':'.$cnam.':'.&escape($space).':'. |
|
&escape($item),$chome)); |
|
} |
|
} elsif ($realm eq 'userdata') { |
|
my $uhome=&homeserver($qualifier,$space); |
|
# ----------------------------------------------- userdata.domain.name.resource |
|
# ---------------------------------------------------- Any other user namespace |
|
} elsif ($realm eq 'environment') { |
|
# ----------------------------------------------------------------- environment |
|
return $ENV{join('.',($space,$qualifier,$rest))}; |
} elsif ($realm eq 'system') { |
} elsif ($realm eq 'system') { |
|
# ----------------------------------------------------------------- system.time |
|
if ($space eq 'time') { |
|
return time; |
|
} |
} |
} |
return $value; |
return ''; |
} |
} |
|
|
# ------------------------------------------------- Update symbolic store links |
# ------------------------------------------------- Update symbolic store links |
Line 1016 sub symblist {
|
Line 1128 sub symblist {
|
# ------------------------------------------------------ Return symb list entry |
# ------------------------------------------------------ Return symb list entry |
|
|
sub symbread { |
sub symbread { |
my $thisfn=declutter(shift); |
my $thisfn=shift; |
|
unless ($thisfn) { |
|
$thisfn=$ENV{'request.filename'}; |
|
} |
|
$thisfn=declutter($thisfn); |
my %hash; |
my %hash; |
my %bighash; |
my %bighash; |
my $syval=''; |
my $syval=''; |
if (($ENV{'request.course.fn'}) && ($ENV{'request.filename'})) { |
if (($ENV{'request.course.fn'}) && ($thisfn)) { |
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', |
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', |
&GDBM_READER,0640)) { |
&GDBM_READER,0640)) { |
$syval=$hash{$thisfn}; |
$syval=$hash{$thisfn}; |
Line 1030 sub symbread {
|
Line 1146 sub symbread {
|
if ($syval) { |
if ($syval) { |
unless ($syval=~/\_\d+$/) { |
unless ($syval=~/\_\d+$/) { |
unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) { |
unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) { |
|
&appenv('request.ambiguous' => $thisfn); |
return ''; |
return ''; |
} |
} |
$syval.=$1; |
$syval.=$1; |
Line 1043 sub symbread {
|
Line 1160 sub symbread {
|
if ($ids) { |
if ($ids) { |
# ------------------------------------------------------------------- Has ID(s) |
# ------------------------------------------------------------------- Has ID(s) |
my @possibilities=split(/\,/,$ids); |
my @possibilities=split(/\,/,$ids); |
if ($#possibilities==1) { |
if ($#possibilities==0) { |
|
# ----------------------------------------------- There is only one possibility |
my ($mapid,$resid)=split(/\./,$ids); |
my ($mapid,$resid)=split(/\./,$ids); |
$syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid; |
$syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid; |
} else { |
} else { |
$syval=''; |
# ------------------------------------------ There is more than one possibility |
|
my $realpossible=0; |
|
map { |
|
my $file=$bighash{'src_'.$_}; |
|
if (&allowed('bre',$file)) { |
|
my ($mapid,$resid)=split(/\./,$_); |
|
if ($bighash{'map_type_'.$mapid} ne 'page') { |
|
$realpossible++; |
|
$syval=declutter($bighash{'map_id_'.$mapid}). |
|
'___'.$resid; |
|
} |
|
} |
|
} @possibilities; |
|
if ($realpossible!=1) { $syval=''; } |
} |
} |
} |
} |
untie(%bighash) |
untie(%bighash) |
} |
} |
} |
} |
return $syval.'___'.$thisfn; |
if ($syval) { return $syval.'___'.$thisfn; } |
} |
} |
|
&appenv('request.ambiguous' => $thisfn); |
return ''; |
return ''; |
} |
} |
|
|
Line 1074 sub numval {
|
Line 1206 sub numval {
|
|
|
sub rndseed { |
sub rndseed { |
my $symb; |
my $symb; |
unless ($symb=&symbread($ENV{'request.filename'})) { return ''; } |
unless ($symb=&symbread()) { return time; } |
my $symbchck=unpack("%32C*",$symb); |
my $symbchck=unpack("%32C*",$symb); |
my $symbseed=numval($symb)%$symbchck; |
my $symbseed=numval($symb)%$symbchck; |
my $namechck=unpack("%32C*",$ENV{'user.name'}); |
my $namechck=unpack("%32C*",$ENV{'user.name'}); |
Line 1111 sub filelocation {
|
Line 1243 sub filelocation {
|
$location = '/home/httpd/html/res'.$file; |
$location = '/home/httpd/html/res'.$file; |
} |
} |
$location=~s://+:/:g; # remove duplicate / |
$location=~s://+:/:g; # remove duplicate / |
while ($location=~m:/../:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/.. |
while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/.. |
|
|
return $location; |
return $location; |
} |
} |
|
|
|
sub hreflocation { |
|
my ($dir,$file)=@_; |
|
unless (($_=~/^http:\/\//i) || ($_=~/^\//)) { |
|
my $finalpath=filelocation($dir,$file); |
|
$finalpath=~s/^\/home\/httpd\/html//; |
|
return $finalpath; |
|
} else { |
|
return $file; |
|
} |
|
} |
|
|
# ------------------------------------------------------------- Declutters URLs |
# ------------------------------------------------------------- Declutters URLs |
|
|
sub declutter { |
sub declutter { |