version 1.40, 2000/10/09 20:26:17
|
version 1.47, 2000/10/20 10:57: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 array 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 |
Line 42
|
Line 44
|
# 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 |
# 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 62
|
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,10/09 Gerd Kortemeyer |
# 10/06,10/09,10/10,10/11,10/14,10/20 Gerd Kortemeyer |
|
|
package Apache::lonnet; |
package Apache::lonnet; |
|
|
Line 423 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 431 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 444 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 596 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 644 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 657 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 759 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 1027 sub symblist {
|
Line 1065 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 1041 sub symbread {
|
Line 1083 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 1080 sub symbread {
|
Line 1123 sub symbread {
|
} |
} |
if ($syval) { return $syval.'___'.$thisfn; } |
if ($syval) { return $syval.'___'.$thisfn; } |
} |
} |
|
&appenv('request.ambiguous' => $thisfn); |
return ''; |
return ''; |
} |
} |
|
|
Line 1099 sub numval {
|
Line 1143 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 1136 sub filelocation {
|
Line 1180 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 { |