version 1.218, 2002/05/13 09:26:29
|
version 1.228, 2002/05/18 19:59:07
|
Line 77 use Apache::File;
|
Line 77 use Apache::File;
|
use LWP::UserAgent(); |
use LWP::UserAgent(); |
use HTTP::Headers; |
use HTTP::Headers; |
use vars |
use vars |
qw(%perlvar %hostname %homecache %hostip %spareid %hostdom |
qw(%perlvar %hostname %homecache %badhomecache %hostip %spareid %hostdom |
%libserv %pr %prp %metacache %packagetab |
%libserv %pr %prp %metacache %packagetab |
%courselogs %accesshash $processmarker $dumpcount |
%courselogs %accesshash $processmarker $dumpcount |
%coursedombuf %coursehombuf %courseresdatacache); |
%coursedombuf %coursehombuf %courseresdatacache); |
Line 482 sub authenticate {
|
Line 482 sub authenticate {
|
|
|
sub homeserver { |
sub homeserver { |
my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
|
|
my $index="$uname:$udom"; |
my $index="$uname:$udom"; |
if ($homecache{$index}) { return "$homecache{$index}"; } |
if ($homecache{$index}) { |
|
return "$homecache{$index}"; |
|
} |
my $tryserver; |
my $tryserver; |
foreach $tryserver (keys %libserv) { |
foreach $tryserver (keys %libserv) { |
|
next if (exists($badhomecache{$index}->{$tryserver})); |
if ($hostdom{$tryserver} eq $udom) { |
if ($hostdom{$tryserver} eq $udom) { |
my $answer=reply("home:$udom:$uname",$tryserver); |
my $answer=reply("home:$udom:$uname",$tryserver); |
if ($answer eq 'found') { |
if ($answer eq 'found') { |
$homecache{$index}=$tryserver; |
$homecache{$index}=$tryserver; |
return $tryserver; |
return $tryserver; |
} |
} else { |
|
$badhomecache{$index}->{$tryserver}=1; |
|
} |
|
} else { |
|
$badhomecache{$index}->{$tryserver}=1; |
} |
} |
} |
} |
return 'no_host'; |
return 'no_host'; |
Line 2372 sub EXT {
|
Line 2377 sub EXT {
|
# ---------------------------------------------------- Any other user namespace |
# ---------------------------------------------------- Any other user namespace |
} elsif ($realm eq 'environment') { |
} elsif ($realm eq 'environment') { |
# ----------------------------------------------------------------- environment |
# ----------------------------------------------------------------- environment |
return $ENV{'environment.'.$spacequalifierrest}; |
if (($uname eq $ENV{'user.name'})&&($udom eq $ENV{'user.domain'})) { |
|
return $ENV{'environment.'.$spacequalifierrest}; |
|
} else { |
|
my %returnhash=&userenvironment($udom,$uname, |
|
$spacequalifierrest); |
|
return $returnhash{$spacequalifierrest}; |
|
} |
} elsif ($realm eq 'system') { |
} elsif ($realm eq 'system') { |
# ----------------------------------------------------------------- system.time |
# ----------------------------------------------------------------- system.time |
if ($space eq 'time') { |
if ($space eq 'time') { |
Line 2752 sub hreflocation {
|
Line 2763 sub hreflocation {
|
unless (($file=~/^http:\/\//i) || ($file=~/^\//)) { |
unless (($file=~/^http:\/\//i) || ($file=~/^\//)) { |
my $finalpath=filelocation($dir,$file); |
my $finalpath=filelocation($dir,$file); |
$finalpath=~s/^\/home\/httpd\/html//; |
$finalpath=~s/^\/home\/httpd\/html//; |
|
$finalpath=~s-/home/(\w+)/public_html/-/~$1/-; |
return $finalpath; |
return $finalpath; |
} else { |
} else { |
return $file; |
return $file; |
Line 2793 sub goodbye {
|
Line 2805 sub goodbye {
|
} |
} |
|
|
BEGIN { |
BEGIN { |
# ------------------------------------------- Read access.conf and loncapa.conf |
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf |
# (eventually access.conf will become deprecated) |
|
unless ($readit) { |
unless ($readit) { |
|
|
{ |
{ |
my $config=Apache::File->new("/etc/httpd/conf/access.conf"); |
my $config=Apache::File->new("/etc/httpd/conf/loncapa.conf"); |
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
if ($configline =~ /^[^\#]*PerlSetVar/) { |
if ($configline =~ /^[^\#]*PerlSetVar/) { |
Line 2809 BEGIN {
|
Line 2819 BEGIN {
|
} |
} |
} |
} |
{ |
{ |
my $config=Apache::File->new("/etc/httpd/conf/loncapa.conf"); |
my $config=Apache::File->new("/etc/httpd/conf/loncapa_apache.conf"); |
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
if ($configline =~ /^[^\#]*PerlSetVar/) { |
if ($configline =~ /^[^\#]*PerlSetVar/) { |
Line 3281 replicates and subscribes to the file
|
Line 3291 replicates and subscribes to the file
|
=item * |
=item * |
|
|
filelocation($dir,$file) : returns file system location of a file based on URI; |
filelocation($dir,$file) : returns file system location of a file based on URI; |
meant to be "fairly clean" absolute reference |
meant to be "fairly clean" absolute reference, $dir is a directory that relative $file lookups are to looked in ($dir of /a/dir and a file of ../bob will become /a/bob) |
|
|
=item * |
=item * |
|
|