--- loncom/lonnet/perl/lonnet.pm 2000/06/05 20:28:17 1.14 +++ loncom/lonnet/perl/lonnet.pm 2000/07/18 13:46:49 1.19 @@ -11,19 +11,27 @@ # 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 +# repcopy(filename) : replicate file +# dirlist(url) : gets a directory listing # # 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,05/31,06/01,06/05 Gerd Kortemeyer +# 04/05,05/29,05/31,06/01, +# 06/05,06/26 Gerd Kortemeyer +# 06/26 Ben Tyszka +# 06/30,07/15,07/17,07/18 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; @@ -285,6 +293,7 @@ sub subscribe { sub repcopy { my $filename=shift; my $transname="$filename.in.transfer"; + if ((-e $filename) || (-e $transname)) { return OK; } my $remoteurl=subscribe($filename); if ($remoteurl eq 'con_lost') { &logthis("Subscribe returned con_lost: $filename"); @@ -319,12 +328,35 @@ 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 { @@ -464,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 { @@ -544,6 +591,56 @@ sub plaintext { sub assignrole { } +# ------------------------------------------------------------ Directory lister + +sub dirlist { + my $uri=shift; + $uri=~s/^\///; + $uri=~s/\/$//; + my ($res,$udom,$uname,@rest)=split(/\//,$uri); + if ($udom) { + if ($uname) { + my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/'.$uri, + homeserver($uname,$udom)); + return split(/:/,$listing); + } else { + my $tryserver; + my %allusers=(); + foreach $tryserver (keys %libserv) { + if ($hostdom{$tryserver} eq $udom) { + my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.$udom, + $tryserver); + if (($listing ne 'no_such_dir') && ($listing ne 'empty') + && ($listing ne 'con_lost')) { + map { + my ($entry,@stat)=split(/&/,$_); + $allusers{$entry}=1; + } split(/:/,$listing); + } + } + } + my $alluserstr=''; + map { + $alluserstr.=$_.'&user:'; + } sort keys %allusers; + $alluserstr=~s/:$//; + return split(/:/,$alluserstr); + } + } else { + my $tryserver; + my %alldom=(); + foreach $tryserver (keys %libserv) { + $alldom{$hostdom{$tryserver}}=1; + } + my $alldomstr=''; + map { + $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:'; + } sort keys %alldom; + $alldomstr=~s/:$//; + return split(/:/,$alldomstr); + } +} + # -------------------------------------------------------- Escape Special Chars sub escape {