--- loncom/lonnet/perl/lonnet.pm 2000/09/30 17:25:04 1.34
+++ loncom/lonnet/perl/lonnet.pm 2000/10/07 10:09:53 1.39
@@ -28,7 +28,7 @@
# restore : returns hash for this url
# 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
-# 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
# dump(namesp) : dumps the complete namespace into a hash
# ssi(url,hash) : does a complete request cycle on url to localhost, posts
@@ -40,7 +40,12 @@
# varval(name) : value of a variable
# refreshstate() : refresh the state information string
# symblist(map,hash) : Updates symbolic storage links
+# symbread(filename) : returns the data handle
# rndseed() : returns a random seed
+# getfile(filename) : returns the contents of filename, or a -1 if it can't
+# be found, replicates and subscribes to the file
+# filelocation(dir,file) : returns a farily clean absolute reference to file
+# from the directory dir
#
# 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,
@@ -53,6 +58,9 @@
# 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,09/28,09/30 Gerd Kortemeyer
+# 10/04 Gerd Kortemeyer
+# 10/04 Guy Albertelli
+# 10/06 Gerd Kortemeyer
package Apache::lonnet;
@@ -197,6 +205,15 @@ sub critical {
sub appenv {
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 $fh;
@@ -412,7 +429,7 @@ sub log {
sub store {
my %storehash=@_;
my $symb;
- unless ($symb=escape(&symbread())) { return ''; }
+ unless ($symb=escape(&symbread($ENV{'request.filename'}))) { return ''; }
my $namespace;
unless ($namespace=$ENV{'request.course.id'}) { return ''; }
my $namevalue='';
@@ -429,7 +446,7 @@ sub store {
sub restore {
my $symb;
- unless ($symb=escape(&symbread())) { return ''; }
+ unless ($symb=escape(&symbread($ENV{'request.filename'}))) { return ''; }
my $namespace;
unless ($namespace=$ENV{'request.course.id'}) { return ''; }
my $answer=reply(
@@ -471,7 +488,7 @@ sub coursedescription {
} split(/\&/,$rep);
$returnhash{'url'}='/res/'.declutter($returnhash{'url'});
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
- $ENV{'user.name.'}.'_'.$cdomain.'_'.$cnum;
+ $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
put ('coursedescriptions',%cachehash);
return %returnhash;
}
@@ -1000,24 +1017,58 @@ sub symblist {
# ------------------------------------------------------ Return symb list entry
sub symbread {
+ my $thisfn=declutter(shift);
my %hash;
- my $syval;
+ my %bighash;
+ my $syval='';
if (($ENV{'request.course.fn'}) && ($ENV{'request.filename'})) {
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
&GDBM_READER,0640)) {
- my $thisfn=declutter($ENV{'request.filename'});
$syval=$hash{$thisfn};
- if (untie(%hash)) {
- unless ($syval=~/\_\d+$/) {
- unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) {
- return '';
- }
- $syval.=$1;
- }
- $syval.='___'.$thisfn;
- return $syval;
- }
+ untie(%hash);
}
+# ---------------------------------------------------------- There was an entry
+ if ($syval) {
+ unless ($syval=~/\_\d+$/) {
+ unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) {
+ return '';
+ }
+ $syval.=$1;
+ }
+ } else {
+# ------------------------------------------------------- Was not in symb table
+ if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
+ &GDBM_READER,0640)) {
+# ---------------------------------------------- Get ID(s) for current resource
+ my $ids=$bighash{'ids_/res/'.$thisfn};
+ if ($ids) {
+# ------------------------------------------------------------------- Has ID(s)
+ my @possibilities=split(/\,/,$ids);
+ if ($#possibilities==0) {
+# ----------------------------------------------- There is only one possibility
+ my ($mapid,$resid)=split(/\./,$ids);
+ $syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;
+ } else {
+# ------------------------------------------ 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)
+ }
+ }
+ if ($syval) { return $syval.'___'.$thisfn; }
}
return '';
}
@@ -1038,7 +1089,7 @@ sub numval {
sub rndseed {
my $symb;
- unless ($symb=&symbread()) { return ''; }
+ unless ($symb=&symbread($ENV{'request.filename'})) { return ''; }
my $symbchck=unpack("%32C*",$symb);
my $symbseed=numval($symb)%$symbchck;
my $namechck=unpack("%32C*",$ENV{'user.name'});
@@ -1051,6 +1102,35 @@ sub rndseed {
.$symbchck);
}
+# ------------------------------------------------------------ Serves up a file
+# returns either the contents of the file or a -1
+sub getfile {
+ my $file=shift;
+ &repcopy($file);
+ if (! -e $file ) { return -1; };
+ my $fh=Apache::File->new($file);
+ my $a='';
+ while (<$fh>) { $a .=$_; }
+ return $a
+}
+
+sub filelocation {
+ my ($dir,$file) = @_;
+ my $location;
+ $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces
+ $file=~s/^$perlvar{'lonDocRoot'}//;
+ $file=~s:^/*res::;
+ if ( !( $file =~ m:^/:) ) {
+ $location = $dir. '/'.$file;
+ } else {
+ $location = '/home/httpd/html/res'.$file;
+ }
+ $location=~s://+:/:g; # remove duplicate /
+ while ($location=~m:/../:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
+
+ return $location;
+}
+
# ------------------------------------------------------------- Declutters URLs
sub declutter {