--- loncom/lonnet/perl/lonnet.pm 2000/09/29 14:36:30 1.33
+++ loncom/lonnet/perl/lonnet.pm 2000/10/10 13:38:19 1.41
@@ -28,18 +28,26 @@
# 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
# hash
+# coursedescription(id) : returns and caches course description for id
# repcopy(filename) : replicate file
# 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
# 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,
@@ -51,7 +59,10 @@
# 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,09/28 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 Guy Albertelli
+# 10/06,10/09,10/10 Gerd Kortemeyer
package Apache::lonnet;
@@ -196,6 +207,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;
@@ -411,7 +431,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='';
@@ -428,7 +448,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(
@@ -445,6 +465,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 {
@@ -706,7 +759,7 @@ sub allowed {
# Restricted by state?
if ($thisallowed=~/X/) {
- if (&condval($uricond)>1) {
+ if (&condval($uricond)) {
return '2';
} else {
return '';
@@ -889,6 +942,15 @@ sub dirlist {
# -------------------------------------------------------- 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 {
my $condidx=shift;
my $result=0;
@@ -909,8 +971,7 @@ sub condval {
} elsif (($_ eq '&') || ($_ eq '|')) {
$operand=$_;
} else {
- my $new=
- substr($ENV{'user.state.'.$ENV{'request.course.id'}},$_,1);
+ my $new=directcondval($_);
if ($operand eq '&') {
$result=$result>$new?$new:$result;
} else {
@@ -966,24 +1027,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 '';
}
@@ -1004,7 +1099,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'});
@@ -1017,6 +1112,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 {