version 1.324, 2003/02/10 20:03:13
|
version 1.332, 2003/03/01 15:13:58
|
Line 76 qw(%perlvar %hostname %homecache %badSer
|
Line 76 qw(%perlvar %hostname %homecache %badSer
|
%libserv %pr %prp %metacache %packagetab %titlecache |
%libserv %pr %prp %metacache %packagetab %titlecache |
%courselogs %accesshash $processmarker $dumpcount |
%courselogs %accesshash $processmarker $dumpcount |
%coursedombuf %coursehombuf %courseresdatacache |
%coursedombuf %coursehombuf %courseresdatacache |
%domaindescription); |
%domaindescription %domain_auth_def %domain_auth_arg_def $tmpdir); |
use IO::Socket; |
use IO::Socket; |
use GDBM_File; |
use GDBM_File; |
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
Line 804 sub repcopy {
|
Line 804 sub repcopy {
|
} |
} |
} |
} |
|
|
|
# ------------------------------------------------ Get server side include body |
|
sub ssi_body { |
|
my $filelink=shift; |
|
my $output=($filelink=~/^http\:/?&externalssi($filelink): |
|
&ssi($filelink)); |
|
$output=~s/^.*\<body[^\>]*\>//si; |
|
$output=~s/\<\/body\s*\>.*$//si; |
|
$output=~ |
|
s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs; |
|
return $output; |
|
} |
|
|
# --------------------------------------------------------- Server Side Include |
# --------------------------------------------------------- Server Side Include |
|
|
sub ssi { |
sub ssi { |
Line 1112 sub expirespread {
|
Line 1124 sub expirespread {
|
# ----------------------------------------------------- Devalidate Spreadsheets |
# ----------------------------------------------------- Devalidate Spreadsheets |
|
|
sub devalidate { |
sub devalidate { |
my $symb=shift; |
my ($symb,$uname,$udom)=@_; |
my $cid=$ENV{'request.course.id'}; |
my $cid=$ENV{'request.course.id'}; |
if ($cid) { |
if ($cid) { |
my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':'; |
# delete the stored spreadsheets for |
|
# - the student level sheet of this user in course's homespace |
|
# - the assessment level sheet for this resource |
|
# for this user in user's homespace |
|
my $key=$uname.':'.$udom.':'; |
my $status= |
my $status= |
&del('nohist_calculatedsheets', |
&del('nohist_calculatedsheets', |
[$key.'studentcalc'], |
[$key.'studentcalc'], |
Line 1126 sub devalidate {
|
Line 1142 sub devalidate {
|
[$key.'assesscalc:'.$symb]); |
[$key.'assesscalc:'.$symb]); |
unless ($status eq 'ok ok') { |
unless ($status eq 'ok ok') { |
&logthis('Could not devalidate spreadsheet '. |
&logthis('Could not devalidate spreadsheet '. |
$ENV{'user.name'}.' at '.$ENV{'user.domain'}.' for '. |
$uname.' at '.$udom.' for '. |
$symb.': '.$status); |
$symb.': '.$status); |
} |
} |
} |
} |
Line 1458 sub store {
|
Line 1474 sub store {
|
$symb=&symbclean($symb); |
$symb=&symbclean($symb); |
if (!$symb) { unless ($symb=&symbread()) { return ''; } } |
if (!$symb) { unless ($symb=&symbread()) { return ''; } } |
|
|
&devalidate($symb); |
if (!$domain) { $domain=$ENV{'user.domain'}; } |
|
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
|
|
|
&devalidate($symb,$stuname,$domain); |
|
|
$symb=escape($symb); |
$symb=escape($symb); |
if (!$namespace) { |
if (!$namespace) { |
Line 1466 sub store {
|
Line 1485 sub store {
|
return ''; |
return ''; |
} |
} |
} |
} |
if (!$domain) { $domain=$ENV{'user.domain'}; } |
|
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
|
if (!$home) { $home=$ENV{'user.home'}; } |
if (!$home) { $home=$ENV{'user.home'}; } |
my $namevalue=''; |
my $namevalue=''; |
foreach (keys %$storehash) { |
foreach (keys %$storehash) { |
Line 1489 sub cstore {
|
Line 1506 sub cstore {
|
$symb=&symbclean($symb); |
$symb=&symbclean($symb); |
if (!$symb) { unless ($symb=&symbread()) { return ''; } } |
if (!$symb) { unless ($symb=&symbread()) { return ''; } } |
|
|
&devalidate($symb); |
if (!$domain) { $domain=$ENV{'user.domain'}; } |
|
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
|
|
|
&devalidate($symb,$stuname,$domain); |
|
|
$symb=escape($symb); |
$symb=escape($symb); |
if (!$namespace) { |
if (!$namespace) { |
Line 1497 sub cstore {
|
Line 1517 sub cstore {
|
return ''; |
return ''; |
} |
} |
} |
} |
if (!$domain) { $domain=$ENV{'user.domain'}; } |
|
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
|
if (!$home) { $home=$ENV{'user.home'}; } |
if (!$home) { $home=$ENV{'user.home'}; } |
|
|
my $namevalue=''; |
my $namevalue=''; |
Line 1749 sub dump {
|
Line 1767 sub dump {
|
|
|
# --------------------------------------------------------------- currentdump |
# --------------------------------------------------------------- currentdump |
sub currentdump { |
sub currentdump { |
my ($namespace,$udomain,$uname)=@_; |
my ($courseid,$sdom,$sname)=@_; |
if (!$udomain) { $udomain = $ENV{'user.domain'}; } |
$courseid = $ENV{'request.course.id'} if (! defined($courseid)); |
if (!$uname) { $uname = $ENV{'user.name'}; } |
$sdom = $ENV{'user.domain'} if (! defined($sdom)); |
my $uhome = &homeserver($uname,$udomain); |
$sname = $ENV{'user.name'} if (! defined($sname)); |
my $rep=reply("currentdump:$udomain:$uname:$namespace",$uhome); |
my $uhome = &homeserver($sname,$sdom); |
|
my $rep=reply('currentdump:'.$sdom.':'.$sname.':'.$courseid,$uhome); |
return if ($rep =~ /^(error:|no_such_host)/); |
return if ($rep =~ /^(error:|no_such_host)/); |
# |
# |
my %returnhash=(); |
my %returnhash=(); |
Line 1761 sub currentdump {
|
Line 1780 sub currentdump {
|
if ($rep eq "unknown_cmd") { |
if ($rep eq "unknown_cmd") { |
# an old lond will not know currentdump |
# an old lond will not know currentdump |
# Do a dump and make it look like a currentdump |
# Do a dump and make it look like a currentdump |
my @tmp = &dump($namespace,$udomain,$uname,'.'); |
my @tmp = &dump($courseid,$sdom,$sname,'.'); |
return if ($tmp[0] =~ /^(error:|no_such_host)/); |
return if ($tmp[0] =~ /^(error:|no_such_host)/); |
my %hash = @tmp; |
my %hash = @tmp; |
@tmp=(); |
@tmp=(); |
Line 2150 sub is_on_map {
|
Line 2169 sub is_on_map {
|
my $filename=$uriparts[$#uriparts]; |
my $filename=$uriparts[$#uriparts]; |
my $pathname=$uri; |
my $pathname=$uri; |
$pathname=~s|/\Q$filename\E$||; |
$pathname=~s|/\Q$filename\E$||; |
|
$pathname=~s/^adm\/wrapper\///; |
#Trying to find the conditional for the file |
#Trying to find the conditional for the file |
my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ |
my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ |
/\&\Q$filename\E\:([\d\|]+)\&/); |
/\&\Q$filename\E\:([\d\|]+)\&/); |
Line 3566 BEGIN {
|
Line 3586 BEGIN {
|
} |
} |
} |
} |
|
|
|
# ------------------------------------------------------------ Read domain file |
|
{ |
|
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. |
|
'/domain.tab'); |
|
%domaindescription = (); |
|
%domain_auth_def = (); |
|
%domain_auth_arg_def = (); |
|
if ($fh) { |
|
while (<$fh>) { |
|
next if /^\#/; |
|
chomp; |
|
my ($domain, $domain_description, $def_auth, $def_auth_arg) |
|
= split(/:/,$_,4); |
|
$domain_auth_def{$domain}=$def_auth; |
|
$domain_auth_arg_def{$domain}=$def_auth_arg; |
|
$domaindescription{$domain}=$domain_description; |
|
# &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}"); |
|
# &logthis("Domain.tab: $domain ".$domaindescription{$domain} ); |
|
} |
|
} |
|
} |
|
|
|
|
# ------------------------------------------------------------- Read hosts file |
# ------------------------------------------------------------- Read hosts file |
{ |
{ |
my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab"); |
my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab"); |
Line 3579 BEGIN {
|
Line 3622 BEGIN {
|
$hostdom{$id}=$domain; |
$hostdom{$id}=$domain; |
$hostip{$id}=$ip; |
$hostip{$id}=$ip; |
$iphost{$ip}=$id; |
$iphost{$ip}=$id; |
if ($domdescr) { $domaindescription{$domain}=$domdescr; } |
|
if ($role eq 'library') { $libserv{$id}=$name; } |
if ($role eq 'library') { $libserv{$id}=$name; } |
} else { |
} else { |
if ($configline) { |
if ($configline) { |
Line 3641 BEGIN {
|
Line 3683 BEGIN {
|
} |
} |
} |
} |
|
|
|
# ------------- set up temporary directory |
|
{ |
|
$tmpdir = $perlvar{'lonDaemons'}.'/tmp/'; |
|
|
|
} |
|
|
%metacache=(); |
%metacache=(); |
|
|
$processmarker='_'.time.'_'.$perlvar{'lonHostID'}; |
$processmarker='_'.time.'_'.$perlvar{'lonHostID'}; |