--- loncom/lonnet/perl/lonnet.pm 2000/05/29 14:06:46 1.13 +++ loncom/lonnet/perl/lonnet.pm 2000/06/30 17:09:51 1.16 @@ -11,19 +11,25 @@ # 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 # put(namesp,hash) : stores hash in namesp +# dump(namesp) : dumps the complete namespace into a hash +# ssi(url) : does a complete request cycle on url to localhost # # 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, # 11/8,11/16,11/18,11/22,11/23,12/22, # 01/06,01/13,02/24,02/28,02/29, # 03/01,03/02,03/06,03/07,03/13, -# 04/05,05/29 Gerd Kortemeyer +# 04/05,05/29,05/31,06/01, +# 06/05,06/26 Gerd Kortemeyer +# 06/26 Ben Tyszka +# 06/30 Gerd Kortemeyer package Apache::lonnet; use strict; use Apache::File; use LWP::UserAgent(); +use HTTP::Headers; use vars qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp $readit); use IO::Socket; @@ -319,12 +325,45 @@ sub repcopy { ." LWP get: $message: $filename"); return HTTP_SERVICE_UNAVAILABLE; } else { + if ($remoteurl!~/\.meta$/) { + my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta'); + my $mresponse=$ua->request($mrequest,$filename.'.meta'); + if ($mresponse->is_error()) { + unlink($filename.'.meta'); + &logthis( + "INFO: No metadata: $filename"); + } + } rename($transname,$filename); return OK; } } } +# --------------------------------------------------------- Server Side Include + +sub ssi { + + my $fn=shift; + + my $ua=new LWP::UserAgent; + my $request=new HTTP::Request('GET',"http://".$ENV{'HTTP_HOST'}.$fn); + $request->header(Cookie => $ENV{'HTTP_COOKIE'}); + my $response=$ua->request($request); + + return $response->content; +} + + + + +# ------------------------------------------------------------------------- Log + +sub log { + my ($dom,$nam,$hom,$what)=@_; + return reply("log:$dom:$nam:$what",$hom); +} + # ----------------------------------------------------------------------- Store sub store { @@ -457,6 +496,21 @@ sub get { return %returnhash; } +# -------------------------------------------------------------- dump interface + +sub dump { + my $namespace=shift; + my $rep=reply("dump:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace", + $ENV{'user.home'}); + my @pairs=split(/\&/,$rep); + my %returnhash=(); + map { + my ($key,$value)=split(/=/,$_); + $returnhash{unespace($key)}=unescape($value); + } @pairs; + return %returnhash; +} + # --------------------------------------------------------------- put interface sub put { @@ -496,6 +550,9 @@ sub allowed { my ($priv,$uri)=@_; $uri=~s/^\/res//; $uri=~s/^\///; + if ($uri=~/^adm\//) { + return 'F'; + } my $thisallowed=''; if ($ENV{'user.priv./'}=~/$priv\&([^\:]*)/) { $thisallowed.=$1;