version 1.13, 2000/05/29 14:06:46
|
version 1.15, 2000/06/26 20:10:49
|
Line 11
|
Line 11
|
# eget(namesp,array) : returns hash with keys from array filled in from namesp |
# 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 |
# get(namesp,array) : returns hash with keys from array filled in from namesp |
# put(namesp,hash) : stores hash in 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, |
# 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, |
# 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, |
# 11/8,11/16,11/18,11/22,11/23,12/22, |
# 01/06,01/13,02/24,02/28,02/29, |
# 01/06,01/13,02/24,02/28,02/29, |
# 03/01,03/02,03/06,03/07,03/13, |
# 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 |
|
|
package Apache::lonnet; |
package Apache::lonnet; |
|
|
use strict; |
use strict; |
use Apache::File; |
use Apache::File; |
use LWP::UserAgent(); |
use LWP::UserAgent(); |
|
use HTTP::Headers; |
use vars |
use vars |
qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp $readit); |
qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp $readit); |
use IO::Socket; |
use IO::Socket; |
Line 325 sub repcopy {
|
Line 330 sub repcopy {
|
} |
} |
} |
} |
|
|
|
# --------------------------------------------------------- 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 |
# ----------------------------------------------------------------------- Store |
|
|
sub store { |
sub store { |
Line 457 sub get {
|
Line 486 sub get {
|
return %returnhash; |
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 |
# --------------------------------------------------------------- put interface |
|
|
sub put { |
sub put { |
Line 496 sub allowed {
|
Line 540 sub allowed {
|
my ($priv,$uri)=@_; |
my ($priv,$uri)=@_; |
$uri=~s/^\/res//; |
$uri=~s/^\/res//; |
$uri=~s/^\///; |
$uri=~s/^\///; |
|
if ($uri=~/^adm\//) { |
|
return 'F'; |
|
} |
my $thisallowed=''; |
my $thisallowed=''; |
if ($ENV{'user.priv./'}=~/$priv\&([^\:]*)/) { |
if ($ENV{'user.priv./'}=~/$priv\&([^\:]*)/) { |
$thisallowed.=$1; |
$thisallowed.=$1; |