--- loncom/loncron	2021/02/02 21:17:47	1.103.2.11
+++ loncom/loncron	2024/10/24 22:24:26	1.103.2.17
@@ -2,7 +2,7 @@
 
 # Housekeeping program, started by cron, loncontrol and loncron.pl
 #
-# $Id: loncron,v 1.103.2.11 2021/02/02 21:17:47 raeburn Exp $
+# $Id: loncron,v 1.103.2.17 2024/10/24 22:24:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -44,7 +44,7 @@ use IO::Socket;
 use HTML::Entities;
 use Getopt::Long;
 use GDBM_File qw(GDBM_READER);
-use Storable qw(thaw nfreeze);
+use Storable qw(thaw);
 use File::ReadBackwards;
 use File::Copy;
 use Sys::Hostname::FQDN();
@@ -307,7 +307,7 @@ 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);
 
@@ -335,6 +335,7 @@ sub start_logging {
 <li><a href="#lonc">lonc</a></li>
 <li><a href="#lonnet">lonnet</a></li>
 <li><a href="#connections">Connections</a></li>
+<li><a href="#bashconf">bash readline config</a></li>
 <li><a href="#delayed">Delayed Messages</a></li>
 <li><a href="#errcount">Error Count</a></li>
 </ol>
@@ -967,11 +968,15 @@ 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 {
@@ -997,10 +1002,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;
@@ -1033,10 +1040,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;
@@ -1097,6 +1106,8 @@ sub write_hostips {
             }
             close($fh);
             chmod(0644,$newfile);
+        } else {
+            print "Could not write to $lontabdir/currhostips.tab\n";
         }
     }
     if (keys(%prevhosts) && keys(%currhosts)) {
@@ -1122,6 +1133,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);
@@ -1263,6 +1276,158 @@ sub read_serverhomeIDs {
     return %server;
 }
 
+sub check_bash_settings {
+    my $distro = &LONCAPA::distro();
+    my ($check_bracketed_paste,$bracketed_warning);
+    if ($distro  =~ /^debian(\d+)$/) {
+        if ($1 >= 12) {
+            $check_bracketed_paste = 1;
+        }
+    } elsif ($distro =~ /^ubuntu(\d+)$/) {
+        if ($1 >= 22) {
+            $check_bracketed_paste = 1;
+        }
+    } elsif ($distro =~ /^(?:redhat|oracle|alma|rocky|centos-stream)(\d+)$/) {
+        if ($1 >= 9) {
+            $check_bracketed_paste = 1;
+        }
+    } elsif ($distro =~ /^fedora(\d+)/) {
+        if ($1 >= 34) {
+            $check_bracketed_paste = 1;
+        }
+    }
+    if ($check_bracketed_paste) {
+        if (open(PIPE,"bind -V 2>&1 | grep enable-bracketed-paste |")) {
+            my $info = <PIPE>;
+            chomp($info);
+            my ($bracketed) = ($info =~ /^\Qenable-bracketed-paste\E\s+is\s+set\s+to\s+\W(on|off)\W$/);
+            close(PIPE);
+            if ($bracketed eq 'on') {
+                $bracketed_warning = 1;
+            }
+        } else {
+            print "Unable to check if bracketed paste is set to off for www user's shell\n";
+        }
+    }
+    return ($bracketed_warning,$check_bracketed_paste);
+}
+
+sub set_bracketed_paste_off {
+    my $bash_www_cnf = '/home/www/.inputrc';
+    my $result;
+    if (!-e $bash_www_cnf) {
+        system("touch $bash_www_cnf");
+        if (open(my $cfh,'>',$bash_www_cnf)) {
+            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 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'";
+        }
+        my $wwwuid = getpwnam('www');
+        my $wwwgid = getgrnam('www');
+        if ($wwwuid!=$<) {
+            chown($wwwuid,$wwwgid,$bash_www_cnf);
+        }
+    } else {
+        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') {
+                        if ($condition ne '') {
+                            $bracketed_paste_off{$condition} = 1;
+                        } else {
+                            $bracketed_paste_off{all} = 1;
+                        }
+                        push(@preserve,$line);
+                    } else {
+                        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);
+        } 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
+                    }
+                } else {
+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 = "Could not open $bash_www_cnf to add 'set enable-bracketed-paste to off'";
+            }
+        } else {
+            $result = "No action needed; $bash_www_cnf already includes 'set enable-bracketed-paste to off'";
+        }
+    }
+    return $result;
+}
+
 sub send_mail {
     my ($sysmail,$reportstatus) = @_;
     my $defdom = $perlvar{'lonDefDomain'};
@@ -1285,7 +1450,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 .= $_;
         }
@@ -1367,7 +1532,7 @@ sub main () {
     my $wwwid=getpwnam('www');
     if ($wwwid!=$<) {
 	print("User ID mismatch. This program must be run as user 'www'.\n");
-	my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
+	my $emailto="$perlvar{'lonAdmEMail'} $perlvar{'lonSysEMail'}";
 	my $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
 	system("echo 'User ID mismatch. loncron must be run as user www.' |".
                " mail -s '$subj' $emailto > /dev/null");
@@ -1401,7 +1566,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";
@@ -1454,6 +1619,32 @@ sub main () {
 	&test_connections($fh);
     }
     if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) {
+        my ($bracketed_warning,$check_bracketed_paste) = &check_bash_settings();
+        if ($check_bracketed_paste) {
+           &log($fh,'<hr /><a name="bashconf" /><h2>bash readline config</h2><h3>Bracketed Paste</h3>'.
+                '<p>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.</p>');
+           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,'<p>'.$bash_update.'</p>'."\n");
+               }
+           } else {
+               &log($fh,'<p>No action needed; /home/www/.inputrc already set.</p>'."\n");
+           }
+        } else {
+            &log($fh,'<hr /><a name="bashconf" /><h2>bash readline config</h2><h3>Bracketed Paste</h3>'.
+                     '<p>No action needed for distros using pre-8.1 bash readline library</p>'."\n");
+        }
         my $domconf = &get_domain_config();
         my ($threshold,$sysmail,$reportstatus,$weightsref,$exclusionsref) =
             &get_permcount_settings($domconf);