version 1.1348, 2017/08/08 15:33:13
|
version 1.1359, 2017/11/13 00:49:31
|
Line 146 our @EXPORT = qw(%env);
|
Line 146 our @EXPORT = qw(%env);
|
sub logtouch { |
sub logtouch { |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
unless (-e "$execdir/logs/lonnet.log") { |
unless (-e "$execdir/logs/lonnet.log") { |
open(my $fh,">>$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 158 sub logthis {
|
Line 158 sub logthis {
|
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
my $now=time; |
my $now=time; |
my $local=localtime($now); |
my $local=localtime($now); |
if (open(my $fh,">>$execdir/logs/lonnet.log")) { |
if (open(my $fh,">>","$execdir/logs/lonnet.log")) { |
my $logstring = $local. " ($$): ".$message."\n"; # Keep any \'s in string. |
my $logstring = $local. " ($$): ".$message."\n"; # Keep any \'s in string. |
print $fh $logstring; |
print $fh $logstring; |
close($fh); |
close($fh); |
Line 171 sub logperm {
|
Line 171 sub logperm {
|
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
my $now=time; |
my $now=time; |
my $local=localtime($now); |
my $local=localtime($now); |
if (open(my $fh,">>$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); |
close($fh); |
} |
} |
Line 485 sub reconlonc {
|
Line 485 sub reconlonc {
|
|
|
&logthis("Trying to reconnect lonc"); |
&logthis("Trying to reconnect lonc"); |
my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; |
my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; |
if (open(my $fh,"<$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 525 sub critical {
|
Line 525 sub critical {
|
$dumpcount++; |
$dumpcount++; |
{ |
{ |
my $dfh; |
my $dfh; |
if (open($dfh,">$dfilename")) { |
if (open($dfh,">",$dfilename)) { |
print $dfh "$cmd\n"; |
print $dfh "$cmd\n"; |
close($dfh); |
close($dfh); |
} |
} |
Line 534 sub critical {
|
Line 534 sub critical {
|
my $wcmd=''; |
my $wcmd=''; |
{ |
{ |
my $dfh; |
my $dfh; |
if (open($dfh,"<$dfilename")) { |
if (open($dfh,"<",$dfilename)) { |
$wcmd=<$dfh>; |
$wcmd=<$dfh>; |
close($dfh); |
close($dfh); |
} |
} |
Line 650 sub transfer_profile_to_env {
|
Line 650 sub transfer_profile_to_env {
|
|
|
# ---------------------------------------------------- Check for valid session |
# ---------------------------------------------------- Check for valid session |
sub check_for_valid_session { |
sub check_for_valid_session { |
my ($r,$name,$userhashref) = @_; |
my ($r,$name,$userhashref,$domref) = @_; |
my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); |
my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); |
my ($linkname,$pubname); |
my ($linkname,$pubname); |
if ($name eq '') { |
if ($name eq '') { |
Line 678 sub check_for_valid_session {
|
Line 678 sub check_for_valid_session {
|
} else { |
} else { |
$lonidsdir=$r->dir_config('lonIDsDir'); |
$lonidsdir=$r->dir_config('lonIDsDir'); |
} |
} |
return undef if (!-e "$lonidsdir/$handle.id"); |
if (!-e "$lonidsdir/$handle.id") { |
|
if ((ref($domref)) && ($name eq 'lonID') && |
|
($handle =~ /^($match_username)\_\d+\_($match_domain)\_(.+)$/)) { |
|
my ($possuname,$possudom,$possuhome) = ($1,$2,$3); |
|
if ((&domain($possudom) ne '') && (&homeserver($possuname,$possudom) eq $possuhome)) { |
|
$$domref = $possudom; |
|
} |
|
} |
|
return undef; |
|
} |
|
|
my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id"); |
my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id"); |
return undef if (!$opened); |
return undef if (!$opened); |
Line 1600 sub internet_dom_servers {
|
Line 1609 sub internet_dom_servers {
|
|
|
sub trusted_domains { |
sub trusted_domains { |
my ($cmdtype,$calldom) = @_; |
my ($cmdtype,$calldom) = @_; |
my (%trusted,%untrusted); |
my ($trusted,$untrusted); |
if (&domain($calldom) eq '') { |
if (&domain($calldom) eq '') { |
return (\%trusted,\%untrusted); |
return ($trusted,$untrusted); |
} |
} |
unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) { |
unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) { |
return (\%trusted,\%untrusted); |
return ($trusted,$untrusted); |
} |
} |
my $callprimary = &domain($calldom,'primary'); |
my $callprimary = &domain($calldom,'primary'); |
my $intcalldom = &Apache::lonnet::internet_dom($callprimary); |
my $intcalldom = &Apache::lonnet::internet_dom($callprimary); |
if ($intcalldom eq '') { |
if ($intcalldom eq '') { |
return (\%trusted,\%untrusted); |
return ($trusted,$untrusted); |
} |
} |
|
|
my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom); |
my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom); |
Line 1660 sub trusted_domains {
|
Line 1669 sub trusted_domains {
|
} |
} |
foreach my $exc (@allexc) { |
foreach my $exc (@allexc) { |
if (ref($doms_by_intdom{$exc}) eq 'ARRAY') { |
if (ref($doms_by_intdom{$exc}) eq 'ARRAY') { |
map { $untrusted{$_}; } @{$doms_by_intdom{$exc}}; |
$untrusted = $doms_by_intdom{$exc}; |
} |
} |
} |
} |
foreach my $inc (@allinc) { |
foreach my $inc (@allinc) { |
if (ref($doms_by_intdom{$inc}) eq 'ARRAY') { |
if (ref($doms_by_intdom{$inc}) eq 'ARRAY') { |
map { $trusted{$_}; } @{$doms_by_intdom{$inc}}; |
$trusted = $doms_by_intdom{$inc}; |
} |
} |
} |
} |
} |
} |
} |
} |
return(\%trusted,\%untrusted); |
return ($trusted,$untrusted); |
} |
} |
|
|
sub will_trust { |
sub will_trust { |
Line 2085 sub inst_directory_query {
|
Line 2094 sub inst_directory_query {
|
my $homeserver = &domain($udom,'primary'); |
my $homeserver = &domain($udom,'primary'); |
my $outcome; |
my $outcome; |
if ($homeserver ne '') { |
if ($homeserver ne '') { |
|
unless ($homeserver eq $perlvar{'lonHostID'}) { |
|
if ($srch->{'srchby'} eq 'email') { |
|
my $lcrev = &get_server_loncaparev(undef,$homeserver); |
|
my ($major,$minor) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); |
|
if (($major eq '' && $minor eq '') || ($major < 2) || |
|
(($major == 2) && ($minor < 12))) { |
|
return; |
|
} |
|
} |
|
} |
my $queryid=&reply("querysend:instdirsearch:". |
my $queryid=&reply("querysend:instdirsearch:". |
&escape($srch->{'srchby'}).':'. |
&escape($srch->{'srchby'}).':'. |
&escape($srch->{'srchterm'}).':'. |
&escape($srch->{'srchterm'}).':'. |
Line 2126 sub usersearch {
|
Line 2145 sub usersearch {
|
my $query = 'usersearch'; |
my $query = 'usersearch'; |
foreach my $tryserver (keys(%libserv)) { |
foreach my $tryserver (keys(%libserv)) { |
if (&host_domain($tryserver) eq $dom) { |
if (&host_domain($tryserver) eq $dom) { |
|
unless ($tryserver eq $perlvar{'lonHostID'}) { |
|
if ($srch->{'srchby'} eq 'email') { |
|
my $lcrev = &get_server_loncaparev(undef,$tryserver); |
|
my ($major,$minor) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); |
|
next if (($major eq '' && $minor eq '') || ($major < 2) || |
|
(($major == 2) && ($minor < 12))); |
|
} |
|
} |
my $host=&hostname($tryserver); |
my $host=&hostname($tryserver); |
my $queryid= |
my $queryid= |
&reply("querysend:".&escape($query).':'. |
&reply("querysend:".&escape($query).':'. |
Line 2444 sub get_domain_defaults {
|
Line 2471 sub get_domain_defaults {
|
} elsif ($domconfig{'coursedefaults'}{'canclone'}) { |
} elsif ($domconfig{'coursedefaults'}{'canclone'}) { |
$domdefaults{'canclone'}=$domconfig{'coursedefaults'}{'canclone'}; |
$domdefaults{'canclone'}=$domconfig{'coursedefaults'}{'canclone'}; |
} |
} |
|
if ($domconfig{'coursedefaults'}{'texengine'}) { |
|
$domdefaults{'texengine'} = $domconfig{'coursedefaults'}{'texengine'}; |
|
} |
} |
} |
if (ref($domconfig{'usersessions'}) eq 'HASH') { |
if (ref($domconfig{'usersessions'}) eq 'HASH') { |
if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') { |
if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') { |
Line 3171 sub externalssi {
|
Line 3201 sub externalssi {
|
} |
} |
} |
} |
|
|
|
|
|
# If the local copy of a replicated resource is outdated, trigger a |
|
# connection from the homeserver to flush the delayed queue. If no update |
|
# happens, remove local copies of outdated resource (and corresponding |
|
# metadata file). |
|
|
|
sub remove_stale_resfile { |
|
my ($url) = @_; |
|
my $removed; |
|
if ($url=~m{^/res/($match_domain)/($match_username)/}) { |
|
my $audom = $1; |
|
my $auname = $2; |
|
unless (($url =~ /\.\d+\.\w+$/) || ($url =~ m{^/res/lib/templates/})) { |
|
my $homeserver = &homeserver($auname,$audom); |
|
unless (($homeserver eq 'no_host') || |
|
(grep { $_ eq $homeserver } ¤t_machine_ids())) { |
|
my $fname = &filelocation('',$url); |
|
if (-e $fname) { |
|
my $protocol = $protocol{$homeserver}; |
|
$protocol = 'http' if ($protocol ne 'https'); |
|
my $hostname = &hostname($homeserver); |
|
if ($hostname) { |
|
my $uri = &declutter($url); |
|
my $request=new HTTP::Request('HEAD',$protocol.'://'.$hostname.'/raw/'.$uri); |
|
my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,5,0,1); |
|
if ($response->is_success()) { |
|
my $remmodtime = &HTTP::Date::str2time( $response->header('Last-modified') ); |
|
my $locmodtime = (stat($fname))[9]; |
|
if ($locmodtime < $remmodtime) { |
|
my $stale; |
|
my $answer = &reply('pong',$homeserver); |
|
if ($answer eq $homeserver.':'.$perlvar{'lonHostID'}) { |
|
sleep(0.2); |
|
$locmodtime = (stat($fname))[9]; |
|
if ($locmodtime < $remmodtime) { |
|
my $posstransfer = $fname.'.in.transfer'; |
|
if ((-e $posstransfer) && ($remmodtime < (stat($posstransfer))[9])) { |
|
$removed = 1; |
|
} else { |
|
$stale = 1; |
|
} |
|
} else { |
|
$removed = 1; |
|
} |
|
} else { |
|
$stale = 1; |
|
} |
|
if ($stale) { |
|
unlink($fname); |
|
if ($uri!~/\.meta$/) { |
|
unlink($fname.'.meta'); |
|
} |
|
&reply("unsub:$fname",$homeserver); |
|
$removed = 1; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
return $removed; |
|
} |
|
|
# -------------------------------- Allow a /uploaded/ URI to be vouched for |
# -------------------------------- Allow a /uploaded/ URI to be vouched for |
|
|
sub allowuploaded { |
sub allowuploaded { |
Line 3520 sub process_coursefile {
|
Line 3615 sub process_coursefile {
|
$home); |
$home); |
} |
} |
} elsif ($action eq 'uploaddoc') { |
} elsif ($action eq 'uploaddoc') { |
open(my $fh,'>'.$filepath.'/'.$fname); |
open(my $fh,'>',$filepath.'/'.$fname); |
print $fh $env{'form.'.$source}; |
print $fh $env{'form.'.$source}; |
close($fh); |
close($fh); |
if ($parser eq 'parse') { |
if ($parser eq 'parse') { |
Line 3578 sub store_edited_file {
|
Line 3673 sub store_edited_file {
|
($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|); |
($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|); |
$fpath=$docudom.'/'.$docuname.'/'.$fpath; |
$fpath=$docudom.'/'.$docuname.'/'.$fpath; |
my $filepath = &build_filepath($fpath); |
my $filepath = &build_filepath($fpath); |
open(my $fh,'>'.$filepath.'/'.$fname); |
open(my $fh,'>',$filepath.'/'.$fname); |
print $fh $content; |
print $fh $content; |
close($fh); |
close($fh); |
my $home=&homeserver($docuname,$docudom); |
my $home=&homeserver($docuname,$docudom); |
Line 3694 sub userfileupload {
|
Line 3789 sub userfileupload {
|
'_'.$env{'user.domain'}.'/pending'; |
'_'.$env{'user.domain'}.'/pending'; |
} elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) { |
} elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) { |
my ($docuname,$docudom); |
my ($docuname,$docudom); |
if ($destudom) { |
if ($destudom =~ /^$match_domain$/) { |
$docudom = $destudom; |
$docudom = $destudom; |
} else { |
} else { |
$docudom = $env{'user.domain'}; |
$docudom = $env{'user.domain'}; |
} |
} |
if ($destuname) { |
if ($destuname =~ /^$match_username$/) { |
$docuname = $destuname; |
$docuname = $destuname; |
} else { |
} else { |
$docuname = $env{'user.name'}; |
$docuname = $env{'user.name'}; |
Line 3729 sub userfileupload {
|
Line 3824 sub userfileupload {
|
mkdir($fullpath,0777); |
mkdir($fullpath,0777); |
} |
} |
} |
} |
open(my $fh,'>'.$fullpath.'/'.$fname); |
open(my $fh,'>',$fullpath.'/'.$fname); |
print $fh $env{'form.'.$formname}; |
print $fh $env{'form.'.$formname}; |
close($fh); |
close($fh); |
if ($context eq 'existingfile') { |
if ($context eq 'existingfile') { |
Line 3804 sub finishuserfileupload {
|
Line 3899 sub finishuserfileupload {
|
|
|
# Save the file |
# Save the file |
{ |
{ |
if (!open(FH,'>'.$filepath.'/'.$file)) { |
if (!open(FH,'>',$filepath.'/'.$file)) { |
&logthis('Failed to create '.$filepath.'/'.$file); |
&logthis('Failed to create '.$filepath.'/'.$file); |
print STDERR ('Failed to create '.$filepath.'/'.$file."\n"); |
print STDERR ('Failed to create '.$filepath.'/'.$file."\n"); |
return '/adm/notfound.html'; |
return '/adm/notfound.html'; |
Line 3862 sub finishuserfileupload {
|
Line 3957 sub finishuserfileupload {
|
my $input = $filepath.'/'.$file; |
my $input = $filepath.'/'.$file; |
my $output = $filepath.'/'.'tn-'.$file; |
my $output = $filepath.'/'.'tn-'.$file; |
my $thumbsize = $thumbwidth.'x'.$thumbheight; |
my $thumbsize = $thumbwidth.'x'.$thumbheight; |
system("convert -sample $thumbsize $input $output"); |
my @args = ('convert','-sample',$thumbsize,$input,$output); |
|
system({$args[0]} @args); |
if (-e $filepath.'/'.'tn-'.$file) { |
if (-e $filepath.'/'.'tn-'.$file) { |
$fetchthumb = 1; |
$fetchthumb = 1; |
} |
} |
Line 4822 sub postannounce {
|
Line 4918 sub postannounce {
|
|
|
sub getannounce { |
sub getannounce { |
|
|
if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) { |
if (open(my $fh,"<",$perlvar{'lonDocRoot'}.'/announcement.txt')) { |
my $announcement=''; |
my $announcement=''; |
while (my $line = <$fh>) { $announcement .= $line; } |
while (my $line = <$fh>) { $announcement .= $line; } |
close($fh); |
close($fh); |
Line 8368 sub fetch_enrollment_query {
|
Line 8464 sub fetch_enrollment_query {
|
if ($xml_classlist =~ /^error/) { |
if ($xml_classlist =~ /^error/) { |
&logthis('fetch_enrollment_query - autoretrieve error: '.$xml_classlist.' for '.$filename.' from server: '.$homeserver.' '.$context.' '.$cnum); |
&logthis('fetch_enrollment_query - autoretrieve error: '.$xml_classlist.' for '.$filename.' from server: '.$homeserver.' '.$context.' '.$cnum); |
} else { |
} else { |
if ( open(FILE,">$destname") ) { |
if ( open(FILE,">",$destname) ) { |
print FILE &unescape($xml_classlist); |
print FILE &unescape($xml_classlist); |
close(FILE); |
close(FILE); |
} else { |
} else { |
Line 8397 sub get_query_reply {
|
Line 8493 sub get_query_reply {
|
for (1..$loopmax) { |
for (1..$loopmax) { |
sleep($sleep); |
sleep($sleep); |
if (-e $replyfile.'.end') { |
if (-e $replyfile.'.end') { |
if (open(my $fh,$replyfile)) { |
if (open(my $fh,"<",$replyfile)) { |
$reply = join('',<$fh>); |
$reply = join('',<$fh>); |
close($fh); |
close($fh); |
} else { return 'error: reply_file_error'; } |
} else { return 'error: reply_file_error'; } |
Line 10024 sub save_selected_files {
|
Line 10120 sub save_selected_files {
|
my ($user, $path, @files) = @_; |
my ($user, $path, @files) = @_; |
my $filename = $user."savedfiles"; |
my $filename = $user."savedfiles"; |
my @other_files = &files_not_in_path($user, $path); |
my @other_files = &files_not_in_path($user, $path); |
open (OUT, '>'.$tmpdir.$filename); |
open (OUT,'>',LONCAPA::tempdir().$filename); |
foreach my $file (@files) { |
foreach my $file (@files) { |
print (OUT $env{'form.currentpath'}.$file."\n"); |
print (OUT $env{'form.currentpath'}.$file."\n"); |
} |
} |
Line 10038 sub save_selected_files {
|
Line 10134 sub save_selected_files {
|
sub clear_selected_files { |
sub clear_selected_files { |
my ($user) = @_; |
my ($user) = @_; |
my $filename = $user."savedfiles"; |
my $filename = $user."savedfiles"; |
open (OUT, '>'.LONCAPA::tempdir().$filename); |
open (OUT,'>',LONCAPA::tempdir().$filename); |
print (OUT undef); |
print (OUT undef); |
close (OUT); |
close (OUT); |
return ("ok"); |
return ("ok"); |
Line 10048 sub files_in_path {
|
Line 10144 sub files_in_path {
|
my ($user, $path) = @_; |
my ($user, $path) = @_; |
my $filename = $user."savedfiles"; |
my $filename = $user."savedfiles"; |
my %return_files; |
my %return_files; |
open (IN, '<'.LONCAPA::tempdir().$filename); |
open (IN,'<',LONCAPA::tempdir().$filename); |
while (my $line_in = <IN>) { |
while (my $line_in = <IN>) { |
chomp ($line_in); |
chomp ($line_in); |
my @paths_and_file = split (m!/!, $line_in); |
my @paths_and_file = split (m!/!, $line_in); |
Line 10070 sub files_not_in_path {
|
Line 10166 sub files_not_in_path {
|
my $filename = $user."savedfiles"; |
my $filename = $user."savedfiles"; |
my @return_files; |
my @return_files; |
my $path_part; |
my $path_part; |
open(IN, '<'.LONCAPA::.$filename); |
open(IN, '<',LONCAPA::tempdir().$filename); |
while (my $line = <IN>) { |
while (my $line = <IN>) { |
#ok, I know it's clunky, but I want it to work |
#ok, I know it's clunky, but I want it to work |
my @paths_and_file = split(m|/|, $line); |
my @paths_and_file = split(m|/|, $line); |
Line 12933 sub readfile {
|
Line 13029 sub readfile {
|
my $file = shift; |
my $file = shift; |
if ( (! -e $file ) || ($file eq '') ) { return -1; }; |
if ( (! -e $file ) || ($file eq '') ) { return -1; }; |
my $fh; |
my $fh; |
open($fh,"<$file"); |
open($fh,"<",$file); |
my $a=''; |
my $a=''; |
while (my $line = <$fh>) { $a .= $line; } |
while (my $line = <$fh>) { $a .= $line; } |
return $a; |
return $a; |
Line 13046 sub machine_ids {
|
Line 13142 sub machine_ids {
|
|
|
sub additional_machine_domains { |
sub additional_machine_domains { |
my @domains; |
my @domains; |
open(my $fh,"<$perlvar{'lonTabDir'}/expected_domains.tab"); |
open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab"); |
while( my $line = <$fh>) { |
while( my $line = <$fh>) { |
$line =~ s/\s//g; |
$line =~ s/\s//g; |
push(@domains,$line); |
push(@domains,$line); |
Line 13192 sub get_dns {
|
Line 13288 sub get_dns {
|
} |
} |
|
|
my %alldns; |
my %alldns; |
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); |
open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab"); |
foreach my $dns (<$config>) { |
foreach my $dns (<$config>) { |
next if ($dns !~ /^\^(\S*)/x); |
next if ($dns !~ /^\^(\S*)/x); |
my $line = $1; |
my $line = $1; |
Line 13218 sub get_dns {
|
Line 13314 sub get_dns {
|
close($config); |
close($config); |
my $which = (split('/',$url))[3]; |
my $which = (split('/',$url))[3]; |
&logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n"); |
&logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n"); |
open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab"); |
open($config,"<","$perlvar{'lonTabDir'}/dns_$which.tab"); |
my @content = <$config>; |
my @content = <$config>; |
&$func(\@content,$hashref); |
&$func(\@content,$hashref); |
return; |
return; |
Line 13311 sub fetch_dns_checksums {
|
Line 13407 sub fetch_dns_checksums {
|
my ($ignore_cache,$nocache) = @_; |
my ($ignore_cache,$nocache) = @_; |
&get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache); |
&get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache); |
my $fh; |
my $fh; |
if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) { |
if (open($fh,"<",$perlvar{'lonTabDir'}.'/domain.tab')) { |
my @lines = <$fh>; |
my @lines = <$fh>; |
&parse_domain_tab(\@lines); |
&parse_domain_tab(\@lines); |
} |
} |
Line 13363 sub fetch_dns_checksums {
|
Line 13459 sub fetch_dns_checksums {
|
my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline); |
my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline); |
$name=~s/\s//g; |
$name=~s/\s//g; |
if ($id && $domain && $role && $name) { |
if ($id && $domain && $role && $name) { |
|
if ((exists($hostname{$id})) && ($hostname{$id} ne '')) { |
|
my $curr = $hostname{$id}; |
|
my $skip; |
|
if (ref($name_to_host{$curr}) eq 'ARRAY') { |
|
if (($curr eq $name) && (@{$name_to_host{$curr}} == 1)) { |
|
$skip = 1; |
|
} else { |
|
@{$name_to_host{$curr}} = grep { $_ ne $id } @{$name_to_host{$curr}}; |
|
} |
|
} |
|
unless ($skip) { |
|
push(@{$name_to_host{$name}},$id); |
|
} |
|
} else { |
|
push(@{$name_to_host{$name}},$id); |
|
} |
$hostname{$id}=$name; |
$hostname{$id}=$name; |
push(@{$name_to_host{$name}}, $id); |
|
$hostdom{$id}=$domain; |
$hostdom{$id}=$domain; |
if ($role eq 'library') { $libserv{$id}=$name; } |
if ($role eq 'library') { $libserv{$id}=$name; } |
if (defined($protocol)) { |
if (defined($protocol)) { |
Line 13398 sub fetch_dns_checksums {
|
Line 13509 sub fetch_dns_checksums {
|
sub load_hosts_tab { |
sub load_hosts_tab { |
my ($ignore_cache,$nocache) = @_; |
my ($ignore_cache,$nocache) = @_; |
&get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache,$nocache); |
&get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache,$nocache); |
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); |
open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab"); |
my @config = <$config>; |
my @config = <$config>; |
&parse_hosts_tab(\@config); |
&parse_hosts_tab(\@config); |
close($config); |
close($config); |
Line 13669 sub all_loncaparevs {
|
Line 13780 sub all_loncaparevs {
|
{ |
{ |
sub load_loncaparevs { |
sub load_loncaparevs { |
if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") { |
if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") { |
if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) { |
if (open(my $config,"<","$perlvar{'lonTabDir'}/loncaparevs.tab")) { |
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
chomp($configline); |
chomp($configline); |
my ($hostid,$loncaparev)=split(/:/,$configline); |
my ($hostid,$loncaparev)=split(/:/,$configline); |
Line 13685 sub all_loncaparevs {
|
Line 13796 sub all_loncaparevs {
|
{ |
{ |
sub load_serverhomeIDs { |
sub load_serverhomeIDs { |
if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") { |
if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") { |
if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { |
if (open(my $config,"<","$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { |
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
chomp($configline); |
chomp($configline); |
my ($name,$id)=split(/:/,$configline); |
my ($name,$id)=split(/:/,$configline); |
Line 13710 BEGIN {
|
Line 13821 BEGIN {
|
|
|
# ------------------------------------------------------ Read spare server file |
# ------------------------------------------------------ Read spare server file |
{ |
{ |
open(my $config,"<$perlvar{'lonTabDir'}/spare.tab"); |
open(my $config,"<","$perlvar{'lonTabDir'}/spare.tab"); |
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
chomp($configline); |
chomp($configline); |
Line 13724 BEGIN {
|
Line 13835 BEGIN {
|
} |
} |
# ------------------------------------------------------------ Read permissions |
# ------------------------------------------------------------ Read permissions |
{ |
{ |
open(my $config,"<$perlvar{'lonTabDir'}/roles.tab"); |
open(my $config,"<","$perlvar{'lonTabDir'}/roles.tab"); |
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
chomp($configline); |
chomp($configline); |
Line 13738 BEGIN {
|
Line 13849 BEGIN {
|
|
|
# -------------------------------------------- Read plain texts for permissions |
# -------------------------------------------- Read plain texts for permissions |
{ |
{ |
open(my $config,"<$perlvar{'lonTabDir'}/rolesplain.tab"); |
open(my $config,"<","$perlvar{'lonTabDir'}/rolesplain.tab"); |
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
chomp($configline); |
chomp($configline); |
Line 13758 BEGIN {
|
Line 13869 BEGIN {
|
|
|
# ---------------------------------------------------------- Read package table |
# ---------------------------------------------------------- Read package table |
{ |
{ |
open(my $config,"<$perlvar{'lonTabDir'}/packages.tab"); |
open(my $config,"<","$perlvar{'lonTabDir'}/packages.tab"); |
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
if ($configline !~ /\S/ || $configline=~/^#/) { next; } |
if ($configline !~ /\S/ || $configline=~/^#/) { next; } |
Line 13812 BEGIN {
|
Line 13923 BEGIN {
|
# ---------------------------------------------------------- Read managers table |
# ---------------------------------------------------------- Read managers table |
{ |
{ |
if (-e "$perlvar{'lonTabDir'}/managers.tab") { |
if (-e "$perlvar{'lonTabDir'}/managers.tab") { |
if (open(my $config,"<$perlvar{'lonTabDir'}/managers.tab")) { |
if (open(my $config,"<","$perlvar{'lonTabDir'}/managers.tab")) { |
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
chomp($configline); |
chomp($configline); |
next if ($configline =~ /^\#/); |
next if ($configline =~ /^\#/); |