");
if (open(DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|")) {
- while (my $line=) {
+ while (my $line=) {
&log($fh,"$line");
if ($line=~/WARNING/) { $notices++; }
if ($line=~/CRITICAL/) { $notices++; }
@@ -249,7 +249,7 @@ sub log_machine_info {
open (LOADAVGH,"/proc/loadavg");
my $loadavg=;
close (LOADAVGH);
-
+
&log($fh,"$loadavg");
my @parts=split(/\s+/,$loadavg);
@@ -309,10 +309,10 @@ sub log_machine_info {
sub start_logging {
my $fh=IO::File->new(">$statusdir/newstatus.html");
- my %simplestatus=();
+ %simplestatus=();
my $now=time;
my $date=localtime($now);
-
+
&log($fh,(<
@@ -426,7 +426,7 @@ sub recursive_clean_tmp {
} else {
$innerdir = $subdir.'/'.$file;
}
- ($cleaned,$old,$removed) =
+ ($cleaned,$old,$removed) =
&recursive_clean_tmp($innerdir,$cleaned,$old,$removed,$errors);
my @doms = &Apache::lonnet::current_machine_domains();
@@ -472,7 +472,7 @@ sub recursive_clean_tmp {
if ($line=~/^CHECKOUTTOKEN\&/) {
if ($since>365*$perlvar{'lonExpire'}) {
if (unlink($fname)) {
- $cleaned++;
+ $cleaned++;
} elsif (ref($errors->{file}) eq 'ARRAY') {
push(@{$errors->{file}},$fname);
}
@@ -638,7 +638,7 @@ sub clean_sockets {
my $cleaned=0;
opendir(SOCKETS,$perlvar{'lonSockDir'});
while (my $fname=readdir(SOCKETS)) {
- next if (-d $fname
+ next if (-d $fname
|| $fname=~/(mysqlsock|maximasock|rsock|\Q$perlvar{'lonSockDir'}\E)/);
$cleaned++;
&log($fh,"Unlinking $fname
");
@@ -745,7 +745,7 @@ sub check_delayed_msg {
my ($fh,$weightsref,$exclusionsref)=@_;
&log($fh,'
Delayed Messages
');
print "Checking buffers.\n";
-
+
&log($fh,'Scanning Permanent Log
');
my $unsend=0;
@@ -816,7 +816,7 @@ sub check_delayed_msg {
last;
}
undef $dfh;
- }
+ }
if ($checkbackwards) {
if (tie *BW, 'File::ReadBackwards', "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
@@ -996,13 +996,17 @@ sub finish_logging {
sub log_simplestatus {
rename("$statusdir/newstatus.html","$statusdir/index.html");
-
+
my $sfh=IO::File->new(">$statusdir/loncron_simple.txt");
- foreach (keys %simplestatus) {
- print $sfh $_.'='.$simplestatus{$_}.'&';
+ if (defined($sfh)) {
+ foreach my $key (keys(%simplestatus)) {
+ print $sfh $key.'='.$simplestatus{$key}.'&';
+ }
+ print $sfh "\n";
+ $sfh->close();
+ } else {
+ print "Could not write to $statusdir/loncron_simple.txt\n";
}
- print $sfh "\n";
- $sfh->close();
}
sub write_loncaparevs {
@@ -1020,7 +1024,7 @@ sub write_loncaparevs {
alarm(0);
};
if ($@ && $@ =~ m/TIMEOUT/) {
- print "Time out while contacting lonHost: $id for version.\n";
+ print "Time out while contacting lonHost: $id for version.\n";
}
if ($loncaparev =~ /^[\w.\-]+$/) {
$output .= $id.':'.$loncaparev."\n";
@@ -1028,10 +1032,12 @@ sub write_loncaparevs {
}
}
if ($output) {
- if (open(my $fh,">$perlvar{'lonTabDir'}/loncaparevs.tab")) {
+ if (open(my $fh,'>',"$perlvar{'lonTabDir'}/loncaparevs.tab")) {
print $fh $output;
close($fh);
&Apache::lonnet::load_loncaparevs();
+ } else {
+ print "Could not write to $perlvar{'lonTabDir'}/loncaparevs.tab\n";
}
}
return;
@@ -1053,7 +1059,7 @@ sub write_serverhomeIDs {
alarm(0);
};
if ($@ && $@ =~ m/TIMEOUT/) {
- print "Time out while contacting server: $name\n";
+ print "Time out while contacting server: $name\n";
}
if ($serverhomeID ne '') {
$output .= $name.':'.$serverhomeID."\n";
@@ -1064,10 +1070,12 @@ sub write_serverhomeIDs {
}
}
if ($output) {
- if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
+ if (open(my $fh,'>',"$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
print $fh $output;
close($fh);
&Apache::lonnet::load_serverhomeIDs();
+ } else {
+ print "Could not write to $perlvar{'lonTabDir'}/serverhomeIDs.tab\n";
}
}
return;
@@ -1088,7 +1096,7 @@ sub write_checksums {
}
print "File version retrieved and checksumming completed for $numchksums files.\n";
} else {
- print "File version retrieval and checksumming skipped - could not determine Linux distro.\n";
+ print "File version retrieval and checksumming skipped - could not determine Linux distro.\n";
}
return;
}
@@ -1128,6 +1136,8 @@ sub write_hostips {
}
close($fh);
chmod(0644,$newfile);
+ } else {
+ print "Could not write to $lontabdir/currhostips.tab\n";
}
}
if (keys(%prevhosts) && keys(%currhosts)) {
@@ -1153,6 +1163,8 @@ sub write_hostips {
}
print $fh "\n*******************\n\n";
close($fh);
+ } else {
+ print "Could not write to $perlvar{'lonDaemons'}/logs/hostip.log\n";
}
my $emailto = &Apache::loncommon::build_recipient_list(undef,
'hostipmail',$defdom);
@@ -1228,7 +1240,7 @@ sub write_connection_config {
}
}
if (keys(%connectssl)) {
- my %currconf;
+ my %currconf;
if (open(my $fh,'<',"$perlvar{'lonTabDir'}/connectionrules.tab")) {
while (my $line = <$fh>) {
chomp($line);
@@ -1243,7 +1255,7 @@ sub write_connection_config {
}
if (open(my $fh,'>',"$perlvar{'lonTabDir'}/connectionrules.tab")) {
my $count = 0;
- foreach my $key (sort(keys(%connectssl))) {
+ foreach my $key (sort(keys(%connectssl))) {
print $fh "$key=$connectssl{$key}\n";
if (exists($currconf{$key})) {
unless ($currconf{$key} eq $connectssl{$key}) {
@@ -1256,6 +1268,8 @@ sub write_connection_config {
}
close($fh);
print "Completed writing SSL options for lonc/lond for $count items.\n";
+ } else {
+ print "Could not write to $perlvar{'lonTabDir'}/connectionrules.tab\n";
}
} else {
print "Writing of SSL options skipped - no connection rules in domain configuration.\n";
@@ -1361,6 +1375,8 @@ sub write_hosttypes {
}
close($fh);
print "Completed writing host type data for $count hosts.\n";
+ } else {
+ print "Could not write to $perlvar{'lonTabDir'}/hosttypes.tab\n";
}
} else {
print "Writing of host types skipped - no hosts found.\n";
@@ -1522,7 +1538,7 @@ sub check_bash_settings {
$bracketed_warning = 1;
}
} else {
- print "Unable to check if bracketed paste is set to off for www user's shell\n";
+ print "Unable to check if bracketed paste is set to off for www user's shell\n";
}
}
return ($bracketed_warning,$check_bracketed_paste);
@@ -1534,9 +1550,17 @@ sub set_bracketed_paste_off {
if (!-e $bash_www_cnf) {
system("touch $bash_www_cnf");
if (open(my $cfh,'>',$bash_www_cnf)) {
- print $cfh "set enable-bracketed-paste off\n";
+ print $cfh <<'END';
+$if R
+ set enable-bracketed-paste off
+$endif
+
+$if maxima
+ set enable-bracketed-paste off
+$endif
+END
close($cfh);
- $result = "Updated $bash_www_cnf";
+ $result = "Updated $bash_www_cnf so enable-bracketed-paste is off for R bash shell";
} else {
$result = "Could not open $bash_www_cnf to add 'set enable-bracketed-paste to off'";
}
@@ -1546,39 +1570,91 @@ sub set_bracketed_paste_off {
chown($wwwuid,$wwwgid,$bash_www_cnf);
}
} else {
- my ($bracketed_paste_on,$bracketed_paste_off,@preserve);
+ my (%bracketed_paste_on,%bracketed_paste_off,@preserve,$condition);
+ $condition = '';
if (open(my $cfh,'<',$bash_www_cnf)) {
while (my $line=<$cfh>) {
chomp($line);
+ if ($line =~ /^\$if\s+(\w+)\s*$/) {
+ if ($1 eq 'R') {
+ $condition = 'r';
+ } elsif ($1 eq 'maxima') {
+ $condition = 'maxima';
+ } else {
+ $condition = 'other';
+ }
+ } elsif ($line =~ /^\$endif\s*$/) {
+ $condition = '';
+ }
if ($line =~ /^\s*set\s+enable\-bracketed\-paste\s+(off|on)\s*$/) {
if ($1 eq 'off') {
- $bracketed_paste_off = 1;
+ if ($condition ne '') {
+ $bracketed_paste_off{$condition} = 1;
+ } else {
+ $bracketed_paste_off{all} = 1;
+ }
+ push(@preserve,$line);
} else {
- $bracketed_paste_on = 1;
+ if ($condition ne '') {
+ $bracketed_paste_on{$condition} = 1;
+ if (($condition eq 'r') || ($condition eq 'maxima')) {
+ push(@preserve,' set enable-bracketed-paste off');
+ } else {
+ push(@preserve,$line);
+ }
+ } else {
+ $bracketed_paste_on{all} = 1;
+ push(@preserve,$line);
+ }
}
} else {
push(@preserve,$line);
}
}
close($cfh);
- if ($bracketed_paste_on || !$bracketed_paste_off) {
- if (open(my $cfh,'>',$bash_www_cnf)) {
- print $cfh "set enable-bracketed-paste off\n";
- if (@preserve) {
- foreach my $entry (@preserve) {
- print $cfh "$entry\n";
- }
+ } else {
+ $result = "Could not open $bash_www_cnf to check if a value is included for 'enable-bracketed-paste'.";
+ }
+ if (($bracketed_paste_on{r} || $bracketed_paste_on{maxima}) ||
+ (!exists($bracketed_paste_off{r}) && !exists($bracketed_paste_on{r}) &&
+ !exists($bracketed_paste_off{maxima}) && !exists($bracketed_paste_on{maxima}))) {
+ if (open(my $cfh,'>',$bash_www_cnf)) {
+ if (@preserve) {
+ foreach my $entry (@preserve) {
+ print $cfh "$entry\n";
+ }
+ if (!exists($bracketed_paste_off{r}) && !exists($bracketed_paste_on{r})) {
+print $cfh <<'END';
+$if R
+ set enable-bracketed-paste off
+$endif
+END
+ }
+ if (!exists($bracketed_paste_off{r}) && !exists($bracketed_paste_on{r})) {
+print $cfh <<'END';
+$if maxima
+ set enable-bracketed-paste off
+$endif
+END
}
- close($cfh);
- $result = "Updated $bash_www_cnf";
} else {
- $result = "Could not open $bash_www_cnf to add 'set enable-bracketed-paste to off'";
+print $cfh <<'END';
+$if R
+ set enable-bracketed-paste off
+$endif
+
+$if maxima
+ set enable-bracketed-paste off
+$endif
+END
}
+ close($cfh);
+ $result = "Updated $bash_www_cnf";
} else {
- $result = "No action needed; $bash_www_cnf already includes 'set enable-bracketed-paste to off'";
+ $result = "Could not open $bash_www_cnf to add 'set enable-bracketed-paste to off'";
}
} else {
- $result = "Could not open $bash_www_cnf to check if a value is included for 'enable-bracketed-paste'.";
+ $result = "No action needed; $bash_www_cnf already includes 'set enable-bracketed-paste to off'";
}
}
return $result;
@@ -1606,7 +1682,7 @@ sub send_mail {
"Subject: ".$subj."\n".
"Content-type: text/html\; charset=UTF-8\n".
"MIME-Version: 1.0\n\n";
- if (open(my $fh,"<$statusdir/index.html")) {
+ if (open(my $fh,'<',"$statusdir/index.html")) {
while (<$fh>) {
$loncronmail .= $_;
}
@@ -1629,7 +1705,7 @@ sub usage {
loncron - housekeeping program that checks up on various parts of LON-CAPA
Options:
- --help Display
+ --help Display
--noemail Do not send the status email
--justcheckconnections Only check the current status of the lonc/d
connections, do not send emails do not
@@ -1722,7 +1798,7 @@ sub main () {
my $now = time;
my $tmpfile = $perlvar{'lonDaemons'}.'/tmp/lciptables_iphost_'.
$now.$$.int(rand(10000));
- if (open(my $fh,">$tmpfile")) {
+ if (open(my $fh,'>',"$tmpfile")) {
my %iphosts = &Apache::lonnet::get_iphost();
foreach my $key (keys(%iphosts)) {
print $fh "$key\n";
@@ -1772,7 +1848,7 @@ sub main () {
&clean_nosslverify($fh);
&write_connection_config();
&write_hosttypes();
- &update_revocation_list();
+ &update_revocation_list();
&checkon_daemon($fh,'lond',40000,'USR2');
&checkon_daemon($fh,'lonc',40000,'USR2');
}
@@ -1783,14 +1859,24 @@ sub main () {
my ($bracketed_warning,$check_bracketed_paste) = &check_bash_settings();
if ($check_bracketed_paste) {
&log($fh,'
bash readline config
Bracketed Paste
'.
- 'Distros using bash readline library 8.1 or later need bracketed paste disabled for www, so R commands sent to lon daemon will be processed.
');
- if ($bracketed_warning) {
+ 'Distros using bash readline library 8.1 or later need bracketed paste disabled for the R bash shell for the www user so R commands sent to lonr daemon will be processed.
');
+ my $bash_www_cnf = '/home/www/.inputrc';
+ my $non_empty_conffile;
+ unless ($bracketed_warning) {
+ if (-e $bash_www_cnf) {
+ my $filesize = (stat($bash_www_cnf))[7];
+ if ($filesize > 0) {
+ $non_empty_conffile = 1;
+ }
+ }
+ }
+ if (($bracketed_warning) || ($non_empty_conffile)) {
my $bash_update = &set_bracketed_paste_off();
if ($bash_update) {
&log($fh,''.$bash_update.'
'."\n");
}
} else {
- &log($fh,'No action needed; /home/www/.inputrc already set.
'."\n");
+ &log($fh,'No action needed; /home/www/.inputrc already set.
'."\n");
}
} else {
&log($fh,'
bash readline config
Bracketed Paste
'.