version 1.299, 2002/10/22 21:49:10
|
version 1.304, 2002/12/04 15:23:39
|
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 %badServerCache %hostip %spareid %hostdom |
qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom |
%libserv %pr %prp %metacache %packagetab |
%libserv %pr %prp %metacache %packagetab %titlecache |
%courselogs %accesshash $processmarker $dumpcount |
%courselogs %accesshash $processmarker $dumpcount |
%coursedombuf %coursehombuf %courseresdatacache %domaindescription); |
%coursedombuf %coursehombuf %courseresdatacache %domaindescription); |
use IO::Socket; |
use IO::Socket; |
Line 840 sub tokenwrapper {
|
Line 840 sub tokenwrapper {
|
if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) { |
if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) { |
&appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'}); |
&appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'}); |
return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri. |
return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri. |
(($uri=~/\?/)?'&':'?').'token='.$token; |
(($uri=~/\?/)?'&':'?').'token='.$token. |
|
'&tokenissued='.$perlvar{'lonHostID'}; |
} else { |
} else { |
return '/adm/notfound.html'; |
return '/adm/notfound.html'; |
} |
} |
Line 1542 sub coursedescription {
|
Line 1543 sub coursedescription {
|
$courseid=~s/\_/\//g; |
$courseid=~s/\_/\//g; |
my ($cdomain,$cnum)=split(/\//,$courseid); |
my ($cdomain,$cnum)=split(/\//,$courseid); |
my $chome=&homeserver($cnum,$cdomain); |
my $chome=&homeserver($cnum,$cdomain); |
|
my $normalid=$cdomain.'_'.$cnum; |
|
# need to always cache even if we get errors otherwise we keep |
|
# trying and trying and trying to get the course description. |
|
my %envhash=(); |
|
my %returnhash=(); |
|
$envhash{'course.'.$normalid.'.last_cache'}=time; |
if ($chome ne 'no_host') { |
if ($chome ne 'no_host') { |
my %returnhash=&dump('environment',$cdomain,$cnum); |
%returnhash=&dump('environment',$cdomain,$cnum); |
if (!exists($returnhash{'con_lost'})) { |
if (!exists($returnhash{'con_lost'})) { |
my $normalid=$cdomain.'_'.$cnum; |
|
my %envhash=(); |
|
$returnhash{'home'}= $chome; |
$returnhash{'home'}= $chome; |
$returnhash{'domain'} = $cdomain; |
$returnhash{'domain'} = $cdomain; |
$returnhash{'num'} = $cnum; |
$returnhash{'num'} = $cnum; |
Line 1556 sub coursedescription {
|
Line 1561 sub coursedescription {
|
$returnhash{'url'}=&clutter($returnhash{'url'}); |
$returnhash{'url'}=&clutter($returnhash{'url'}); |
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; |
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; |
$envhash{'course.'.$normalid.'.last_cache'}=time; |
|
$envhash{'course.'.$normalid.'.home'}=$chome; |
$envhash{'course.'.$normalid.'.home'}=$chome; |
$envhash{'course.'.$normalid.'.domain'}=$cdomain; |
$envhash{'course.'.$normalid.'.domain'}=$cdomain; |
$envhash{'course.'.$normalid.'.num'}=$cnum; |
$envhash{'course.'.$normalid.'.num'}=$cnum; |
&appenv(%envhash); |
|
return %returnhash; |
|
} |
} |
} |
} |
return (); |
&appenv(%envhash); |
|
return %returnhash; |
} |
} |
|
|
# -------------------------------------------------------- Get user privileges |
# -------------------------------------------------------- Get user privileges |
Line 1802 sub allowed {
|
Line 1805 sub allowed {
|
|
|
if ($priv eq 'bre') { |
if ($priv eq 'bre') { |
my $copyright=&metadata($uri,'copyright'); |
my $copyright=&metadata($uri,'copyright'); |
if ($copyright eq 'public') { return 'F'; } |
if (($copyright eq 'public') && (!$ENV{'request.course.id'})) { |
|
return 'F'; |
|
} |
if ($copyright eq 'priv') { |
if ($copyright eq 'priv') { |
$uri=~/([^\/]+)\/([^\/]+)\//; |
$uri=~/([^\/]+)\/([^\/]+)\//; |
unless (($ENV{'user.name'} eq $2) && ($ENV{'user.domain'} eq $1)) { |
unless (($ENV{'user.name'} eq $2) && ($ENV{'user.domain'} eq $1)) { |
Line 3096 sub metadata_generate_part0 {
|
Line 3101 sub metadata_generate_part0 {
|
} |
} |
} |
} |
|
|
|
# ------------------------------------------------- Get the title of a resource |
|
|
|
sub gettitle { |
|
my $urlsymb=shift; |
|
my $symb=&symbread($urlsymb); |
|
unless ($symb) { |
|
unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; } |
|
return &metadata($urlsymb,'title'); |
|
} |
|
if ($titlecache{$symb}) { return $titlecache{$symb}; } |
|
my ($map,$resid,$url)=split(/\_\_\_/,$symb); |
|
my $title=''; |
|
my %bighash; |
|
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
|
&GDBM_READER(),0640)) { |
|
my $mapid=$bighash{'map_pc_'.&clutter($map)}; |
|
$title=$bighash{'title_'.$mapid.'.'.$resid}; |
|
untie %bighash; |
|
} |
|
if ($title) { |
|
$titlecache{$symb}=$title; |
|
return $title; |
|
} else { |
|
return &metadata($urlsymb,'title'); |
|
} |
|
} |
|
|
# ------------------------------------------------- Update symbolic store links |
# ------------------------------------------------- Update symbolic store links |
|
|
sub symblist { |
sub symblist { |
Line 3442 BEGIN {
|
Line 3474 BEGIN {
|
my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab"); |
my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab"); |
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
|
next if ($configline =~ /^(\#|\s*$)/); |
chomp($configline); |
chomp($configline); |
my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline); |
my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline); |
if ($id && $domain && $role && $name && $ip) { |
if ($id && $domain && $role && $name && $ip) { |
$hostname{$id}=$name; |
$hostname{$id}=$name; |
$hostdom{$id}=$domain; |
$hostdom{$id}=$domain; |
$hostip{$id}=$ip; |
$hostip{$id}=$ip; |
|
$iphost{$ip}=$id; |
if ($domdescr) { $domaindescription{$domain}=$domdescr; } |
if ($domdescr) { $domaindescription{$domain}=$domdescr; } |
if ($role eq 'library') { $libserv{$id}=$name; } |
if ($role eq 'library') { $libserv{$id}=$name; } |
} else { |
} else { |