loncom/lonnet/perl/lonnet.pm - diff

Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.440 and 1.448

version 1.440, 2003/11/01 18:34:49	version 1.448, 2003/11/12 19:51:43
Line 30	Line 30
package Apache::lonnet;	package Apache::lonnet;

use strict;	use strict;
use Apache::File;
use LWP::UserAgent();	use LWP::UserAgent();
use HTTP::Headers;	use HTTP::Headers;
use vars	use vars
Line 56 my $readit;	Line 55 my $readit;

sub logtouch {	sub logtouch {
my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
unless (-e "$execdir/logs/lonnet.log") {	unless (-e "$execdir/logs/lonnet.log") {
my $fh=Apache::File->new(">>$execdir/logs/lonnet.log");	open(my $fh,">>$execdir/logs/lonnet.log");
close $fh;	close $fh;
}	}
my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3];	my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3];
Line 69 sub logthis {	Line 68 sub logthis {
my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
my $now=time;	my $now=time;
my $local=localtime($now);	my $local=localtime($now);
my $fh=Apache::File->new(">>$execdir/logs/lonnet.log");	if (open(my $fh,">>$execdir/logs/lonnet.log")) {
print $fh "$local ($$): $message\n";	print $fh "$local ($$): $message\n";
	close($fh);
	}
return 1;	return 1;
}	}

Line 79 sub logperm {	Line 80 sub logperm {
my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
my $now=time;	my $now=time;
my $local=localtime($now);	my $local=localtime($now);
my $fh=Apache::File->new(">>$execdir/logs/lonnet.perm.log");	if (open(my $fh,">>$execdir/logs/lonnet.perm.log")) {
print $fh "$now:$message:$local\n";	print $fh "$now:$message:$local\n";
	close($fh);
	}
return 1;	return 1;
}	}

Line 132 sub reconlonc {	Line 135 sub reconlonc {
my $peerfile=shift;	my $peerfile=shift;
&logthis("Trying to reconnect for $peerfile");	&logthis("Trying to reconnect for $peerfile");
my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";	my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
if (my $fh=Apache::File->new("$loncfile")) {	if (open(my $fh,"<$loncfile")) {
my $loncpid=<$fh>;	my $loncpid=<$fh>;
chomp($loncpid);	chomp($loncpid);
if (kill 0 => $loncpid) {	if (kill 0 => $loncpid) {
Line 180 sub critical {	Line 183 sub critical {
"$perlvar{'lonSockDir'}/delayed/$now.$dumpcount.$$.$middlename.$server";	"$perlvar{'lonSockDir'}/delayed/$now.$dumpcount.$$.$middlename.$server";
$dumpcount++;	$dumpcount++;
{	{
my $dfh;	my $dfh;
if ($dfh=Apache::File->new(">$dfilename")) {	if (open($dfh,">$dfilename")) {
print $dfh "$cmd\n";	print $dfh "$cmd\n";
}	close($dfh);
	}
}	}
sleep 2;	sleep 2;
my $wcmd='';	my $wcmd='';
{	{
my $dfh;	my $dfh;
if ($dfh=Apache::File->new("$dfilename")) {	if (open($dfh,"<$dfilename")) {
$wcmd=<$dfh>;	$wcmd=<$dfh>;
}	close($dfh);
	}
}	}
chomp($wcmd);	chomp($wcmd);
if ($wcmd eq $cmd) {	if ($wcmd eq $cmd) {
Line 230 sub transfer_profile_to_env {	Line 235 sub transfer_profile_to_env {
my ($lonidsdir,$handle)=@_;	my ($lonidsdir,$handle)=@_;
my @profile;	my @profile;
{	{
my $idf=Apache::File->new("$lonidsdir/$handle.id");	open(my $idf,"$lonidsdir/$handle.id");
flock($idf,LOCK_SH);	flock($idf,LOCK_SH);
@profile=<$idf>;	@profile=<$idf>;
$idf->close();	close($idf);
}	}
my $envi;	my $envi;
my %Remove;	my %Remove;
Line 247 sub transfer_profile_to_env {	Line 252 sub transfer_profile_to_env {
}	}
}	}
}	}
	$ENV{'user.environment'} = "$lonidsdir/$handle.id";
foreach my $expired_key (keys(%Remove)) {	foreach my $expired_key (keys(%Remove)) {
&delenv($expired_key);	&delenv($expired_key);
}	}
$ENV{'user.environment'} = "$lonidsdir/$handle.id";
}	}

# ---------------------------------------------------------- Append Environment	# ---------------------------------------------------------- Append Environment
Line 269 sub appenv {	Line 274 sub appenv {
}	}

my $lockfh;	my $lockfh;
unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) {	unless (open($lockfh,"$ENV{'user.environment'}")) {
return 'error: '.$!;	return 'error: '.$!;
}	}
unless (flock($lockfh,LOCK_EX)) {	unless (flock($lockfh,LOCK_EX)) {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=blue>WARNING: ".
'Could not obtain exclusive lock in appenv: '.$!);	'Could not obtain exclusive lock in appenv: '.$!);
$lockfh->close();	close($lockfh);
return 'error: '.$!;	return 'error: '.$!;
}	}

my @oldenv;	my @oldenv;
{	{
my $fh;	my $fh;
unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {	unless (open($fh,"$ENV{'user.environment'}")) {
return 'error: '.$!;	return 'error: '.$!;
}	}
@oldenv=<$fh>;	@oldenv=<$fh>;
$fh->close();	close($fh);
}	}
for (my $i=0; $i<=$#oldenv; $i++) {	for (my $i=0; $i<=$#oldenv; $i++) {
chomp($oldenv[$i]);	chomp($oldenv[$i]);
if ($oldenv[$i] ne '') {	if ($oldenv[$i] ne '') {
my ($name,$value)=split(/=/,$oldenv[$i]);	my ($name,$value)=split(/=/,$oldenv[$i]);
unless (defined($newenv{$name})) {	unless (defined($newenv{$name})) {
$newenv{$name}=$value;	$newenv{$name}=$value;
}	}
}	}
}	}
{	{
my $fh;	my $fh;
unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {	unless (open($fh,">$ENV{'user.environment'}")) {
return 'error';	return 'error';
}	}
my $newname;	my $newname;
foreach $newname (keys %newenv) {	foreach $newname (keys %newenv) {
print $fh "$newname=$newenv{$newname}\n";	print $fh "$newname=$newenv{$newname}\n";
}	}
$fh->close();	close($fh);
}	}

$lockfh->close();	close($lockfh);
return 'ok';	return 'ok';
}	}
# ----------------------------------------------------- Delete from Environment	# ----------------------------------------------------- Delete from Environment
Line 324 sub delenv {	Line 329 sub delenv {
}	}
my @oldenv;	my @oldenv;
{	{
my $fh;	my $fh;
unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {	unless (open($fh,"$ENV{'user.environment'}")) {
return 'error';	return 'error';
}	}
unless (flock($fh,LOCK_SH)) {	unless (flock($fh,LOCK_SH)) {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=blue>WARNING: ".
'Could not obtain shared lock in delenv: '.$!);	'Could not obtain shared lock in delenv: '.$!);
$fh->close();	close($fh);
return 'error: '.$!;	return 'error: '.$!;
}	}
@oldenv=<$fh>;	@oldenv=<$fh>;
$fh->close();	close($fh);
}	}
{	{
my $fh;	my $fh;
unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {	unless (open($fh,">$ENV{'user.environment'}")) {
return 'error';	return 'error';
}	}
unless (flock($fh,LOCK_EX)) {	unless (flock($fh,LOCK_EX)) {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=blue>WARNING: ".
'Could not obtain exclusive lock in delenv: '.$!);	'Could not obtain exclusive lock in delenv: '.$!);
$fh->close();	close($fh);
return 'error: '.$!;	return 'error: '.$!;
}	}
foreach (@oldenv) {	foreach (@oldenv) {
unless ($_=~/^$delthis/) { print $fh $_; }	unless ($_=~/^$delthis/) { print $fh $_; }
}	}
$fh->close();	close($fh);
}	}
return 'ok';	return 'ok';
}	}
Line 387 sub overloaderror {	Line 392 sub overloaderror {
unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }	unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }
my $loadavg;	my $loadavg;
if ($checkserver eq $perlvar{'lonHostID'}) {	if ($checkserver eq $perlvar{'lonHostID'}) {
my $loadfile=Apache::File->new('/proc/loadavg');	open(my $loadfile,'/proc/loadavg');
$loadavg=<$loadfile>;	$loadavg=<$loadfile>;
$loadavg =~ s/\s.*//g;	$loadavg =~ s/\s.*//g;
$loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};	$loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};
	close($loadfile);
} else {	} else {
$loadavg=&reply('load',$checkserver);	$loadavg=&reply('load',$checkserver);
}	}
Line 823 sub devalidate_cache {	Line 829 sub devalidate_cache {
my ($cache,$id,$name) = @_;	my ($cache,$id,$name) = @_;
delete $$cache{$id.'.time'};	delete $$cache{$id.'.time'};
delete $$cache{$id};	delete $$cache{$id};
my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";	my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
open(DB,"$filename.lock");	open(DB,"$filename.lock");
flock(DB,LOCK_EX);	flock(DB,LOCK_EX);
my %hash;	my %hash;
if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {	if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
delete($hash{$id});	eval <<'EVALBLOCK';
delete($hash{$id.'.time'});	delete($hash{$id});
	delete($hash{$id.'.time'});
	EVALBLOCK
	if ($@) {
	&logthis("<font color='red'>devalidate_cache blew up :$@:$name</font>");
	unlink($filename);
	}
} else {	} else {
&logthis("Unable to tie hash (devalidate cache): $name");	if (-e $filename) {
	&logthis("Unable to tie hash (devalidate cache): $name");
	unlink($filename);
	}
}	}
untie(%hash);	untie(%hash);
flock(DB,LOCK_UN);	flock(DB,LOCK_UN);
Line 867 sub do_cache {	Line 882 sub do_cache {
$$cache{$id};	$$cache{$id};
}	}

sub save_cache {
my ($cache,$name)=@_;
my $starttime=&Time::HiRes::time();
# &logthis("Saving :$name:");
eval lock_store($cache,$perlvar{'lonDaemons'}.'/tmp/'.$name.".storable");
if ($@) { &logthis("lock_store threw a die ".$@); }
# &logthis("save_cache took ".(&Time::HiRes::time()-$starttime));
}

sub load_cache {
my ($cache,$name)=@_;
my $starttime=&Time::HiRes::time();
# &logthis("Before Loading $name size is ".scalar(%$cache));
my $tmpcache;
eval {
$tmpcache=lock_retrieve($perlvar{'lonDaemons'}.'/tmp/'.$name.".storable");
};
if ($@) { &logthis("lock_retreive threw a die ".$@); return; }
if (!%$cache) {
my $count;
while (my ($key,$value)=each(%$tmpcache)) {
$count++;
$$cache{$key}=$value;
}
# &logthis("Initial load: $count");
} else {
my $key;
my $count;
while ($key=each(%$tmpcache)) {
if ($key !~/^(.*)\.time$/) { next; }
my $name=$1;
if (exists($$cache{$key})) {
if ($$tmpcache{$key} >= $$cache{$key}) {
$$cache{$key}=$$tmpcache{$key};
$$cache{$name}=$$tmpcache{$name};
} else {
# &logthis("Would have overwritten $name with is set to expire at ".$$cache{$key}." with ".$$tmpcache{$key}." Whew!");
}
} else {
$count++;
$$cache{$key}=$$tmpcache{$key};
$$cache{$name}=$$tmpcache{$name};
}
}
# &logthis("Additional load: $count");
}
# &logthis("After Loading $name size is ".scalar(%$cache));
# &logthis("load_cache took ".(&Time::HiRes::time()-$starttime));
}

sub save_cache_item {	sub save_cache_item {
my ($cache,$name,$id)=@_;	my ($cache,$name,$id)=@_;
my $starttime=&Time::HiRes::time();	my $starttime=&Time::HiRes::time();
# &logthis("Saving :$name:$id");	# &logthis("Saving :$name:$id");
my %hash;	my %hash;
my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";	my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
open(DB,"$filename.lock");	open(DB,"$filename.lock");
flock(DB,LOCK_EX);	flock(DB,LOCK_EX);
if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {	if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
$hash{$id.'.time'}=$$cache{$id.'.time'};	eval <<'EVALBLOCK';
$hash{$id}=freeze({'item'=>$$cache{$id}});	$hash{$id.'.time'}=$$cache{$id.'.time'};
	$hash{$id}=freeze({'item'=>$$cache{$id}});
	EVALBLOCK
	if ($@) {
	&logthis("<font color='red'>save_cache blew up :$@:$name</font>");
	unlink($filename);
	}
} else {	} else {
&logthis("Unable to tie hash (save cache item): $name");	if (-e $filename) {
	&logthis("Unable to tie hash (save cache item): $name ($!)");
	unlink($filename);
	}
}	}
untie(%hash);	untie(%hash);
flock(DB,LOCK_UN);	flock(DB,LOCK_UN);
Line 942 sub load_cache_item {	Line 916 sub load_cache_item {
my $starttime=&Time::HiRes::time();	my $starttime=&Time::HiRes::time();
# &logthis("Before Loading $name for $id size is ".scalar(%$cache));	# &logthis("Before Loading $name for $id size is ".scalar(%$cache));
my %hash;	my %hash;
my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";	my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
open(DB,"$filename.lock");	open(DB,"$filename.lock");
flock(DB,LOCK_SH);	flock(DB,LOCK_SH);
if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) {	if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) {
if (!%$cache) {	eval <<'EVALBLOCK';
my $count;	if (!%$cache) {
while (my ($key,$value)=each(%hash)) {	my $count;
$count++;	while (my ($key,$value)=each(%hash)) {
if ($key =~ /\.time$/) {	$count++;
$$cache{$key}=$value;	if ($key =~ /\.time$/) {
} else {	$$cache{$key}=$value;
my $hashref=thaw($value);	} else {
$$cache{$key}=$hashref->{'item'};	my $hashref=thaw($value);
	$$cache{$key}=$hashref->{'item'};
	}
}	}
}
# &logthis("Initial load: $count");	# &logthis("Initial load: $count");
} else {	} else {
my $hashref=thaw($hash{$id});	my $hashref=thaw($hash{$id});
$$cache{$id}=$hashref->{'item'};	$$cache{$id}=$hashref->{'item'};
$$cache{$id.'.time'}=$hash{$id.'.time'};	$$cache{$id.'.time'}=$hash{$id.'.time'};
}	}
	EVALBLOCK
	if ($@) {
	&logthis("<font color='red'>load_cache blew up :$@:$name</font>");
	unlink($filename);
	}
} else {	} else {
&logthis("Unable to tie hash (load cache item): $name");	if (-e $filename) {
	&logthis("Unable to tie hash (load cache item): $name ($!)");
	unlink($filename);
	}
}	}
untie(%hash);	untie(%hash);
flock(DB,LOCK_UN);	flock(DB,LOCK_UN);
Line 1090 sub repcopy {	Line 1073 sub repcopy {
&logthis("Subscribe returned $remoteurl: $filename");	&logthis("Subscribe returned $remoteurl: $filename");
return HTTP_SERVICE_UNAVAILABLE;	return HTTP_SERVICE_UNAVAILABLE;
} elsif ($remoteurl eq 'not_found') {	} elsif ($remoteurl eq 'not_found') {
&logthis("Subscribe returned not_found: $filename");	#&logthis("Subscribe returned not_found: $filename");
return HTTP_NOT_FOUND;	return HTTP_NOT_FOUND;
} elsif ($remoteurl =~ /^rejected by/) {	} elsif ($remoteurl =~ /^rejected by/) {
&logthis("Subscribe returned $remoteurl: $filename");	&logthis("Subscribe returned $remoteurl: $filename");
Line 1252 sub finishuserfileupload {	Line 1235 sub finishuserfileupload {
}	}
# Save the file	# Save the file
{	{
my $fh=Apache::File->new('>'.$filepath.'/'.$fname);	open(my $fh,'>'.$filepath.'/'.$fname);
print $fh $ENV{'form.'.$formname};	print $fh $ENV{'form.'.$formname};
	close($fh);
}	}
# Notify homeserver to grep it	# Notify homeserver to grep it
#	#
Line 1477 sub postannounce {	Line 1461 sub postannounce {
}	}

sub getannounce {	sub getannounce {
if (my $fh=Apache::File->new($perlvar{'lonDocRoot'}.'/announcement.txt')) {
	if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) {
my $announcement='';	my $announcement='';
while (<$fh>) { $announcement .=$_; }	while (<$fh>) { $announcement .=$_; }
$fh->close();	close($fh);
if ($announcement=~/\w/) {	if ($announcement=~/\w/) {
return	return
'<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'.	'<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'.
Line 1993 sub store {	Line 1978 sub store {
}	}
}	}
if (!$home) { $home=$ENV{'user.home'}; }	if (!$home) { $home=$ENV{'user.home'}; }

	$$storehash{'ip'}=$ENV{'REMOTE_ADDR'};
	$$storehash{'host'}=$perlvar{'lonHostID'};

my $namevalue='';	my $namevalue='';
foreach (keys %$storehash) {	foreach (keys %$storehash) {
$namevalue.=escape($_).'='.escape($$storehash{$_}).'&';	$namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
Line 2026 sub cstore {	Line 2015 sub cstore {
}	}
if (!$home) { $home=$ENV{'user.home'}; }	if (!$home) { $home=$ENV{'user.home'}; }

	$$storehash{'ip'}=$ENV{'REMOTE_ADDR'};
	$$storehash{'host'}=$perlvar{'lonHostID'};

my $namevalue='';	my $namevalue='';
foreach (keys %$storehash) {	foreach (keys %$storehash) {
$namevalue.=escape($_).'='.escape($$storehash{$_}).'&';	$namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
Line 2860 sub get_query_reply {	Line 2852 sub get_query_reply {
for (1..100) {	for (1..100) {
sleep 2;	sleep 2;
if (-e $replyfile.'.end') {	if (-e $replyfile.'.end') {
if (my $fh=Apache::File->new($replyfile)) {	if (open(my $fh,$replyfile)) {
$reply.=<$fh>;	$reply.=<$fh>;
$fh->close;	close($fh);
} else { return 'error: reply_file_error'; }	} else { return 'error: reply_file_error'; }
return &unescape($reply);	return &unescape($reply);
}	}
Line 4092 sub fixversion {	Line 4084 sub fixversion {
&GDBM_READER(),0640)) {	&GDBM_READER(),0640)) {
if ($bighash{'version_'.$uri}) {	if ($bighash{'version_'.$uri}) {
my $version=$bighash{'version_'.$uri};	my $version=$bighash{'version_'.$uri};
unless ($version eq 'mostrecent') {	unless (($version eq 'mostrecent') \|\|
	($version==&getversion($uri))) {
$uri=~s/\.(\w+)$/\.$version\.$1/;	$uri=~s/\.(\w+)$/\.$version\.$1/;
}	}
}	}
Line 4205 sub numval {	Line 4198 sub numval {
}	}

sub latest_rnd_algorithm_id {	sub latest_rnd_algorithm_id {
return '64bit';	return '64bit2';
}	}

sub rndseed {	sub rndseed {
Line 4222 sub rndseed {	Line 4215 sub rndseed {
my $CODE=$ENV{'scantron.CODE'};	my $CODE=$ENV{'scantron.CODE'};
if (defined($CODE)) {	if (defined($CODE)) {
&rndseed_CODE_64bit($symb,$courseid,$domain,$username);	&rndseed_CODE_64bit($symb,$courseid,$domain,$username);
	} elsif ($which eq '64bit2') {
	return &rndseed_64bit2($symb,$courseid,$domain,$username);
} elsif ($which eq '64bit') {	} elsif ($which eq '64bit') {
return &rndseed_64bit($symb,$courseid,$domain,$username);	return &rndseed_64bit($symb,$courseid,$domain,$username);
}	}
Line 4265 sub rndseed_64bit {	Line 4260 sub rndseed_64bit {
}	}
}	}

	sub rndseed_64bit2 {
	my ($symb,$courseid,$domain,$username)=@_;
	{
	use integer;
	# strings need to be an even # of cahracters long, it it is odd the
	# last characters gets thrown away
	my $symbchck=unpack("%32S*",$symb.' ') << 21;
	my $symbseed=numval($symb) << 10;
	my $namechck=unpack("%32S*",$username.' ');

	my $nameseed=numval($username) << 21;
	my $domainseed=unpack("%32S*",$domain.' ') << 10;
	my $courseseed=unpack("%32S*",$courseid.' ');

	my $num1=$symbchck+$symbseed+$namechck;
	my $num2=$nameseed+$domainseed+$courseseed;
	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed\|$courseseed;$namechck:$symbchck");
	#&Apache::lonxml::debug("rndseed :$num:$symb");
	return "$num1,$num2";
	}
	}

sub rndseed_CODE_64bit {	sub rndseed_CODE_64bit {
my ($symb,$courseid,$domain,$username)=@_;	my ($symb,$courseid,$domain,$username)=@_;
{	{
use integer;	use integer;
my $symbchck=unpack("%32S*",$symb) << 16;	my $symbchck=unpack("%32S*",$symb.' ') << 16;
my $symbseed=numval($symb);	my $symbseed=numval($symb);
my $CODEseed=numval($ENV{'scantron.CODE'}) << 16;	my $CODEseed=numval($ENV{'scantron.CODE'}) << 16;
my $courseseed=unpack("%32S*",$courseid);	my $courseseed=unpack("%32S*",$courseid.' ');
my $num1=$symbseed+$CODEseed;	my $num1=$symbseed+$CODEseed;
my $num2=$courseseed+$symbchck;	my $num2=$courseseed+$symbchck;
#&Apache::lonxml::debug("$symbseed:$CODEseed\|$courseseed:$symbchck");	#&Apache::lonxml::debug("$symbseed:$CODEseed\|$courseseed:$symbchck");
Line 4328 sub getfile {	Line 4345 sub getfile {
} else { # normal file from res space	} else { # normal file from res space
&repcopy($file);	&repcopy($file);
if (! -e $file ) { return -1; };	if (! -e $file ) { return -1; };
my $fh=Apache::File->new($file);	my $fh;
	open($fh,"<$file");
my $a='';	my $a='';
while (<$fh>) { $a .=$_; }	while (<$fh>) { $a .=$_; }
return $a;	return $a;
Line 4416 sub mod_perl_version {	Line 4434 sub mod_perl_version {

sub correct_line_ends {	sub correct_line_ends {
my ($result)=@_;	my ($result)=@_;
&logthis("Wha $result");
$$result =~s/\r\n/\n/mg;	$$result =~s/\r\n/\n/mg;
$$result =~s/\r/\n/mg;	$$result =~s/\r/\n/mg;
}	}
Line 4424 sub correct_line_ends {	Line 4441 sub correct_line_ends {

sub goodbye {	sub goodbye {
&logthis("Starting Shut down");	&logthis("Starting Shut down");
#not converted to using infrastruture	#not converted to using infrastruture and probably shouldn't be
&logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache)));
&logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache)));	&logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache)));
&logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
#converted	#converted
	&logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
	&logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache)));
&logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache)));	&logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache)));
&logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));	&logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));
#1.1 only	#1.1 only
Line 4445 BEGIN {	Line 4462 BEGIN {
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf	# ----------------------------------- Read loncapa.conf and loncapa_apache.conf
unless ($readit) {	unless ($readit) {
{	{
my $config=Apache::File->new("/etc/httpd/conf/loncapa.conf");	open(my $config,"</etc/httpd/conf/loncapa.conf");

while (my $configline=<$config>) {	while (my $configline=<$config>) {
if ($configline =~ /^[^\#]*PerlSetVar/) {	if ($configline =~ /^[^\#]*PerlSetVar/) {
Line 4454 BEGIN {	Line 4471 BEGIN {
$perlvar{$varname}=$varvalue;	$perlvar{$varname}=$varvalue;
}	}
}	}
	close($config);
}	}
{	{
my $config=Apache::File->new("/etc/httpd/conf/loncapa_apache.conf");	open(my $config,"</etc/httpd/conf/loncapa_apache.conf");

while (my $configline=<$config>) {	while (my $configline=<$config>) {
if ($configline =~ /^[^\#]*PerlSetVar/) {	if ($configline =~ /^[^\#]*PerlSetVar/) {
Line 4465 BEGIN {	Line 4483 BEGIN {
$perlvar{$varname}=$varvalue;	$perlvar{$varname}=$varvalue;
}	}
}	}
	close($config);
}	}

# ------------------------------------------------------------ Read domain file	# ------------------------------------------------------------ Read domain file
{	{
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
'/domain.tab');
%domaindescription = ();	%domaindescription = ();
%domain_auth_def = ();	%domain_auth_def = ();
%domain_auth_arg_def = ();	%domain_auth_arg_def = ();
if ($fh) {	my $fh;
	if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {
while (<$fh>) {	while (<$fh>) {
next if (/^(\#\|\s*$)/);	next if (/^(\#\|\s*$)/);
# next if /^\#/;	# next if /^\#/;
Line 4489 BEGIN {	Line 4507 BEGIN {
$domain_longi{$domain}=$longi;	$domain_longi{$domain}=$longi;
$domain_lati{$domain}=$lati;	$domain_lati{$domain}=$lati;

# &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");	# &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");
# &logthis("Domain.tab: $domain ".$domaindescription{$domain} );	# &logthis("Domain.tab: $domain ".$domaindescription{$domain} );
}	}
}	}
	close ($fh);
}	}


# ------------------------------------------------------------- Read hosts file	# ------------------------------------------------------------- Read hosts file
{	{
my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");	open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");

while (my $configline=<$config>) {	while (my $configline=<$config>) {
next if ($configline =~ /^(\#\|\s*$)/);	next if ($configline =~ /^(\#\|\s*$)/);
Line 4516 BEGIN {	Line 4535 BEGIN {
}	}
}	}
}	}
	close($config);
}	}

# ------------------------------------------------------ Read spare server file	# ------------------------------------------------------ Read spare server file
{	{
my $config=Apache::File->new("$perlvar{'lonTabDir'}/spare.tab");	open(my $config,"<$perlvar{'lonTabDir'}/spare.tab");

while (my $configline=<$config>) {	while (my $configline=<$config>) {
chomp($configline);	chomp($configline);
Line 4528 BEGIN {	Line 4548 BEGIN {
$spareid{$configline}=1;	$spareid{$configline}=1;
}	}
}	}
	close($config);
}	}
# ------------------------------------------------------------ Read permissions	# ------------------------------------------------------------ Read permissions
{	{
my $config=Apache::File->new("$perlvar{'lonTabDir'}/roles.tab");	open(my $config,"<$perlvar{'lonTabDir'}/roles.tab");

while (my $configline=<$config>) {	while (my $configline=<$config>) {
chomp($configline);	chomp($configline);
if ($configline) {	if ($configline) {
my ($role,$perm)=split(/ /,$configline);	my ($role,$perm)=split(/ /,$configline);
if ($perm ne '') { $pr{$role}=$perm; }	if ($perm ne '') { $pr{$role}=$perm; }
}	}
}	}
	close($config);
}	}

# -------------------------------------------- Read plain texts for permissions	# -------------------------------------------- Read plain texts for permissions
{	{
my $config=Apache::File->new("$perlvar{'lonTabDir'}/rolesplain.tab");	open(my $config,"<$perlvar{'lonTabDir'}/rolesplain.tab");

while (my $configline=<$config>) {	while (my $configline=<$config>) {
chomp($configline);	chomp($configline);
if ($configline) {	if ($configline) {
my ($short,$plain)=split(/:/,$configline);	my ($short,$plain)=split(/:/,$configline);
if ($plain ne '') { $prp{$short}=$plain; }	if ($plain ne '') { $prp{$short}=$plain; }
}	}
}	}
	close($config);
}	}

# ---------------------------------------------------------- Read package table	# ---------------------------------------------------------- Read package table
{	{
my $config=Apache::File->new("$perlvar{'lonTabDir'}/packages.tab");	open(my $config,"<$perlvar{'lonTabDir'}/packages.tab");

while (my $configline=<$config>) {	while (my $configline=<$config>) {
chomp($configline);	chomp($configline);
my ($short,$plain)=split(/:/,$configline);	my ($short,$plain)=split(/:/,$configline);
my ($pack,$name)=split(/\&/,$short);	my ($pack,$name)=split(/\&/,$short);
if ($plain ne '') {	if ($plain ne '') {
$packagetab{$pack.'&'.$name.'&name'}=$name;	$packagetab{$pack.'&'.$name.'&name'}=$name;
$packagetab{$short}=$plain;	$packagetab{$short}=$plain;
}	}
}	}
	close($config);
}	}

# ------------- set up temporary directory	# ------------- set up temporary directory

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.440
changed lines
	Added in v.1.448