--- loncom/lonnet/perl/lonnet.pm 2000/09/06 14:25:17 1.30 +++ loncom/lonnet/perl/lonnet.pm 2000/09/25 20:28:54 1.31 @@ -37,7 +37,9 @@ # dirlist(url) : gets a directory listing # condval(index) : value of condition index based on state # 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 +# rndseed() : returns a random seed # # 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, @@ -49,7 +51,7 @@ # 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 Gerd Kortemeyer +# 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25 Gerd Kortemeyer package Apache::lonnet; @@ -60,6 +62,7 @@ use HTTP::Headers; use vars qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit); use IO::Socket; +use GDBM_File; use Apache::Constants qw(:common :http); # --------------------------------------------------------------------- Logging @@ -406,28 +409,45 @@ sub log { # ----------------------------------------------------------------------- Store sub store { - my %storehash=shift; + my %storehash=@_; + my $symb; + unless ($symb=escape(&symbread())) { return ''; } + my $namespace; + unless ($namespace=$ENV{'request.course.uri'}) { return ''; } + $namespace=~s/\//\_\_/g; + $namespace=~s/\./\_/g; + $namespace=escape($namespace); my $namevalue=''; map { $namevalue.=escape($_).'='.escape($storehash{$_}).'&'; } keys %storehash; $namevalue=~s/\&$//; - return reply("store:$ENV{'user.domain'}:$ENV{'user.name'}:" - ."$ENV{'user.class'}:$ENV{'request.filename'}:$namevalue", + return reply( + "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue", "$ENV{'user.home'}"); } # --------------------------------------------------------------------- Restore sub restore { - my $answer=reply("restore:$ENV{'user.domain'}:$ENV{'user.name'}:" - ."$ENV{'user.class'}:$ENV{'request.filename'}", - "$ENV{'user.home'}"); + my $symb; + unless ($symb=escape(&symbread())) { return ''; } + my $namespace; + unless ($namespace=$ENV{'request.course.uri'}) { return ''; } + $namespace=~s/\//\_\_/g; + $namespace=~s/\./\_/g; + $namespace=escape($namespace); + my $answer=reply( + "restore:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb", + "$ENV{'user.home'}"); my %returnhash=(); map { my ($name,$value)=split(/\=/,$_); $returnhash{&unescape($name)}=&unescape($value); } split(/\&/,$answer); + map { + $returnhash{$_}=$returnhash{$returnhash{'version'}.':'.$_}; + } split(/\:/,$returnhash{$returnhash{'version'}.':keys'}); return %returnhash; } @@ -776,8 +796,7 @@ sub filedecription { sub assignrole { my ($udom,$uname,$url,$role,$end,$start)=@_; my $mrole; - $url=~s/^\///; - $url=~s/^res\///; + $url=declutter($url); if ($role =~ /^cr\//) { unless ($url=~/\.course$/) { return 'invalid'; } unless (allowed('ccr',$url)) { return 'refused'; } @@ -930,6 +949,68 @@ sub varval { return $value; } +# ------------------------------------------------- Update symbolic store links + +sub symblist { + my ($mapname,%newhash)=@_; + $mapname=declutter($mapname); + my %hash; + if (($ENV{'request.course.fn'}) && (%newhash)) { + if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', + &GDBM_WRCREAT,0640)) { + map { + $hash{declutter($_)}=$mapname.'___'.$newhash{$_}; + } keys %newhash; + if (untie(%hash)) { + return 'ok'; + } + } + } + return 'error'; +} + +# ------------------------------------------------------ Return symb list entry + +sub symbread { + my %hash; + 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; + } + } + } + return ''; +} + +# ---------------------------------------------------------- Return random seed + +sub rndseed { + my $symb; + unless ($symb=&symbread()) { return ''; } +} + +# ------------------------------------------------------------- Declutters URLs + +sub declutter { + my $thisfn=shift; + $thisfn=~s/^$perlvar{'lonDocRoot'}//; + $thisfn=~s/^\///; + $thisfn=~s/^res\///; + return $thisfn; +} + # -------------------------------------------------------- Escape Special Chars sub escape {