[LON-CAPA-cvs] cvs: loncom /cgi clusterstatus.pl

raeburn raeburn at source.lon-capa.org
Sun Jul 5 19:40:20 EDT 2026


raeburn		Sun Jul  5 23:40:20 2026 EDT

  Modified files:              
    /loncom/cgi	clusterstatus.pl 
  Log:
  - WCAG 2.2 compliance
    - Include labels for form elements
    - Include landmark for page's main content to support "Skip to main content"
    - Replace use of <table> for layout with <div>
    - Sequential headings
    - alt attribute for <img>
  - Display of "Could not determine" for MySQL Database and RPMs used less.
  - Satisfy w3c validation
  - Coding style: replace <font> tag with <span> + CSS. Use keys(), sort().
  
  
-------------- next part --------------
Index: loncom/cgi/clusterstatus.pl
diff -u loncom/cgi/clusterstatus.pl:1.30 loncom/cgi/clusterstatus.pl:1.31
--- loncom/cgi/clusterstatus.pl:1.30	Fri Jul  3 16:27:01 2026
+++ loncom/cgi/clusterstatus.pl	Sun Jul  5 23:40:20 2026
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 $|=1;
 # Generates a html page showing various status reports about the domain or cluster
-# $Id: clusterstatus.pl,v 1.30 2026/07/03 16:27:01 raeburn Exp $
+# $Id: clusterstatus.pl,v 1.31 2026/07/05 23:40:20 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -36,6 +36,7 @@
 use LONCAPA::lonauthcgi;
 use LONCAPA::LWPReq;
 use IO::File;
+use HTML::Entities();
 
 my $perlvar=&LONCAPA::Configuration::read_conf('loncapa.conf');
 
@@ -71,11 +72,11 @@
 my $stat_fromcache=0;
 
 sub select_form {
-    my ($def,$name,%hash) = @_;
-    my $selectform = "<select name=\"$name\" size=\"1\">\n";
+    my ($def,$name,$id,%hash) = @_;
+    my $selectform = "<select name=\"$name\" id=\"$id\" size=\"1\">\n";
     foreach my $key (sort(keys(%hash))) {
         $selectform.="<option value=\"$key\" ".
-            ($key eq $def? 'selected' : '').
+            ($key eq $def? 'selected="selected"' : '').
                 ">".$hash{$key}."</option>\n";
     }
     $selectform.="</select>";
@@ -92,7 +93,7 @@
 
 sub hidden {
     my ($name,$value)=@_;
-    print("\n<input type='hidden' name='$name' value='$value' />");
+    print "\n<input type=\"hidden\" name=\"$name\" value=\"".&HTML::Entities::encode($value,'"<>&')."\" />";
 }
 
 sub request {
@@ -194,8 +195,11 @@
 
 sub otherwindow {
     my ($local,$url,$label)=@_;
+    my $protocol = $Apache::lonnet::protocol{$local};
+    $protocol = 'http' if ($protocol ne 'https');
+    my $href = $protocol.'://'.$hostname{$local}.&HTML::Entities::encode($url,'<>&"');
     return
-  " <a href='http://$hostname{$local}$url' target='newwin$local'>$label</a> ";
+  " <a href=\"$href\" target=\"newwin$local\">$label</a> ";
 }
 
 sub login {
@@ -271,7 +275,7 @@
 	}
     }
     if ($reroute) {
-        print(&Apache::lonlocal::mt('Reroute to:').' <font size="1">'.$reroute.'</font>');
+        print(&Apache::lonlocal::mt('Reroute to:').' <span style="font-size: small;">'.$reroute.'</span>');
     }
 }
 
@@ -279,11 +283,8 @@
 sub bar {
     my $parm=shift;
     my $number=int($parm+0.5);
-    print('<table><tr><td bgcolor="#225522"><font color="#225522">');
-    for (my $i=0;$i<$number;$i++) {
-	print "+";
-    }
-    print("</font></td></tr></table>");
+    print '<div style="inline-block; background-color: #225522; font-family: monospace; width: '.$number.'ch; line-height: 90%;"> </div>';
+    return;
 }
 
 # ========================================================== Show server status
@@ -307,65 +308,74 @@
                                           lonc => 'loncron errors',
                                          );
    
-    print(<<ENDHEADER);
-<a name="$local" />
-<table width="100%" bgcolor="#225522" cellspacing="2" cellpadding="2" border="0">
-<tr><td bgcolor="#BBDDBB"><font color="#225522" face="arial"><b>
-$local $hostdom{$local}</b> <tt>($hostname{$local}); $hostrole</tt>
+    print <<ENDHEADER;
+<a name="$local"></a>
+<div class="LC_grid" role="grid" style="margin: 2px; padding: 2px;">
+<div class="LC_grid_row" role="row">
+<div class="LC_grid_cell" role="gridcell" style="background-color: #BBDDBB; font-family: arial; color: #225522;">
+<b>$local $hostdom{$local}</b> <tt>($hostname{$local}); $hostrole</tt>
 <br />$domaininfo{$hostdom{$local}}{'description'}
 $domaininfo{$hostdom{$local}}{'city'}
-</font></th></tr><tr><td bgcolor="#DDDDBB"><font color="#225522">
+</div>
+</div>
+<div class="LC_grid_row" role="row">
+<div class="LC_grid_cell" role="gridcell" style="background-color: #DDDDBB; color: #225522;">
 ENDHEADER
     &login($local);&server($local);&users($local);&versions($local);
     &announcement($local);
     &loncron($local);&lond($local);&lonc($local);&runloncron($local);
-    print("</font></td></tr>");
+    print '</div></div>';
     if ($trouble) {
-	print("<tr><td bgcolor='#DDBBBB'><font color='#552222' size='+2'>$trouble</font></td></tr>");
+        print '<div class="LC_grid_row" role="row">'.
+              '<div class="LC_grid_cell" role="gridcell" style="background-color: #DDDDBB; color: #552222; font-size: larger;">'.
+              $trouble.'</div></div>';
     }
-    print("<tr><td bgcolor='#BBBBBB'>");
+    print '<div class="LC_grid_row" role="row">'.
+          '<div class="LC_grid_cell" role="gridcell" style="background-color: #BBBBBB;">';
 # re-routing
     if ($host{$local.'_reroute'}) {
-	print('<br />'.$lt{'rero'}.' '.$host{$local.'_reroute'});
+	print '<br />'.$lt{'rero'}.' '.$host{$local.'_reroute'};
 	&takeonline($local);
     }
 # version
     if ($host{$local.'_version'}) {
-	print('<br />'.$lt{'vers'}.' '.$host{$local.'_version'});
+	print '<br />'.$lt{'vers'}.' '.$host{$local.'_version'};
     }
 # load
     if (($host{$local.'_load_doomed'}>0.5) || ($mode eq 'load_doomed')) {
-	print('<br />'.$lt{'load'}.' '.$host{$local.'_load'});
+	print '<br />'.$lt{'load'}.' '.$host{$local.'_load'};
     }
 # users
     if (($host{$local.'_users_doomed'}>10) || ($mode eq 'users_doomed')) {
-	print('<br />'.$lt{'acti'}.' '.$host{$local.'_users'});
+	print '<br />'.$lt{'acti'}.' '.$host{$local.'_users'};
     }
 
 # checkrpms
     if ($host{$local.'_checkrpms'}) {
-	print('<br />'.$lt{'rpms'}.' '.$host{$local.'_checkrpms'});
+	print '<br />'.$lt{'rpms'}.' '.$host{$local.'_checkrpms'};
     }
 # mysql
     if ($host{$local.'_mysql'}) {
-	print('<br />'.$lt{'mysq'}.' '.$host{$local.'_mysql'});
+	print '<br />'.$lt{'mysq'}.' '.$host{$local.'_mysql'};
     }
 # connections
     if ($host{$local.'_notconnected'}) {
-	print('<br />'.$lt{'notc'}.' ');
+	print '<br />'.$lt{'notc'}.' ';
 	foreach my $item (split(/ /,$host{$local.'_notconnected'})) {
 	    if ($item) {
-		print(' <a href="#$item">'.$item.'</a>');
+		print ' <a href="#$item">'.$item.'</a>';
 	    }
 	}
     }
 # errors
     if ($host{$local.'_errors'}) {
-	print('<br />'.$lt{'lonc'}.' '.$host{$local.'_errors'});
+	print '<br />'.$lt{'lonc'}.' '.$host{$local.'_errors'};
     }
-    print "</td></tr><tr><td bgcolor='#DDDDDD'>";
+    print '</div></div>'.
+          '<div class="LC_grid_row" role="row">'.
+          '<div class="LC_grid_cell" role="gridcell" style="background-color: #DDDDDD;">';
     &allreroutes($local);
-    print "</td></tr></table><br />";
+    print '</div></div></div><br />';
 }
 
 # =========================================================== Doomedness sorted
@@ -482,7 +492,10 @@
 	} elsif ($mysql{'mysql'} eq 'defunct') {
 	    $host{$local.'_mysql'}='Defunct.';
 	    $host{$local.'_mysql_doomed'}=3;
-	}
+        } elsif ($mysql{'mysql'} eq 'ok') {
+            $host{$local.'_mysql'}='OK';
+            $host{$local.'_mysql_doomed'}=0;
+        }
     }
 # -- Check rpm status
     &statuslist($local,'RPMs');
@@ -496,13 +509,16 @@
 	    $host{$local.'_checkrpms_doomed'}=50;
 	    $host{$local.'_unresponsive_doomed'}++;
 	} elsif ($checkrpms{'status'} eq 'fail') {
-	    $host{$local.'_checkrpms'}='Could not checked RPMs.';
+	    $host{$local.'_checkrpms'}='Could not check RPMs.';
 	    $host{$local.'_checkrpms_doomed'}=100;
 	} elsif ($checkrpms{'rpmcount'}) {
-	    $host{$local.'_checkrpms'}='Outdated RPMs: '.
+	    $host{$local.'_checkrpms'}='Outdated package count: '.
 		$checkrpms{'rpmcount'};
 	    $host{$local.'_checkrpms_doomed'}=$checkrpms{'rpmcount'};
-	}
+        } elsif ($checkrpms{'status'} eq 'ok') {
+            $host{$local.'_checkrpms'}='Up to date';
+            $host{$local.'_checkrpms_doomed'}=$checkrpms{'rpmcount'};
+        }
     }
 # -- Check connections
     &statuslist($local,'Connections');
@@ -529,26 +545,30 @@
 	    &serverstatus($_);
 	}
     } elsif ($mode eq 'connections') {
-	print 
-       "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>".
-       "<tr><td bgcolor='#225522'> </td>";
+        print '<div class="LC_grid" role="grid">'.
+              '<div class="LC_grid_row" role="row">'.
+              '<div class="LC_grid_cell" role="gridcell"> </div>';
 	foreach my $remote (sort keys %hostname) {
-	    print '<td bgcolor="#DDDDBB">'.$remote.'</td>';
+	    print '<div class="LC_grid_cell" role="gridcell" style="background-color: #DDDDBB">'.$remote.'</div>';
 	}
-	print "</tr>\n";
+	print "</div>\n";
 # connection matrix
-	foreach my $local (sort keys %hostname) {
-	    print '<tr><td bgcolor="#DDDDBB">'.$local.'</td>';
-	    foreach my $remote (sort keys %hostname) {
+	foreach my $local (sort(keys(%hostname))) {
+            print '<div class="LC_grid_row" role="row">'.
+                  '<div class="LC_grid_cell" role="gridcell" style="background-color: #DDDDBB;">'.$local.'</div>';
+	    foreach my $remote (sort(keys(%hostname))) {
 		if ($connectionstatus{$local.'_TO_'.$remote} eq 'not_yet') {
 		    my $cellcolor='#FFFFFF';
 		    if ($local eq $remote) { $cellcolor='#DDDDDD'; }
-		    print '<td bgcolor="'.$cellcolor.'"><font color="#555522" size="-2">not yet tested</font></td>';
+		    print '<div class="LC_grid_cell" role="gridcell" style="background-color: '.$cellcolor.'">'.
+                          '<span style="color: #555522; font-size: smaller;">'.
+                          &Apache::lonlocal::mt('not yet tested').'</span></div>';
 		} elsif ($connectionstatus{$local.'_TO_'.$remote} eq 'ok') {
 		    my $cellcolor='#BBDDBB';
 		    if ($local eq $remote) { $cellcolor='#99DD99'; }
-		    print 
-'<td bgcolor="'.$cellcolor.'"><font color="#225522" face="arial"><b>'.&Apache::lonlocal::mt('ok').'</b></td>';
+                    print '<div class="LC_grid_cell" role="gridcell" style="background-color: '.$cellcolor.'">'.
+                          '<span style="color: #225522; font-family: arial; font-face: bold;">'.
+                          &Apache::lonlocal::mt('ok').'</span></div>';
 		} else {
 		    my $cellcolor='#DDCCAA';
 		    if ($connectionstatus{$local.'_TO_'.$remote} eq 'local_error') {
@@ -560,39 +580,42 @@
 		    } else {
 			if ($local eq $remote) { $cellcolor='#DDBB77'; }
 		    }
-		    print 
-		  '<td bgcolor="'.$cellcolor.'"><font color="#552222" size="-2">'.
-		  $connectionstatus{$local.'_TO_'.$remote}.'<br />';
-		    &lonc($local); &lond($remote);
-		    print '</td>';
+                    print '<div class="LC_grid_cell" role="gridcell" style="background-color: '.$cellcolor.'">'.
+                          '<span style="color: #552222; font-size: smaller;">'.
+                          $connectionstatus{$local.'_TO_'.$remote}.'<br />';
+		    &lonc($local);
+                    &lond($remote);
+		    print '</div>';
 		}
 	    }
-	    print "</tr>\n";
+	    print "</div>\n";
 	}
-	print "</table>";
+	print '</div>';
     } elsif ($mode eq 'users') {
 # Users
 	if ($maxusers) {
 	    my $factor=50/$maxusers;
-	    print '<h3>'.&Apache::lonlocal::mt('Total active user(s)').': '.$totalusers.'</h3>'. 
-                  '<table cellspacing="3" cellpadding="3" border="0" bgcolor="#225522">';
-
+	    print '<h2 class="LC_heading_2">'.
+                  &Apache::lonlocal::mt('Total active user(s)').': '.$totalusers.'</h2>'. 
+                  '<div class="LC_grid" role="grid">';
 	    foreach my $local (sort keys %hostname) {
 		if (defined($host{$local.'_users'})) {
-		    print 
-'<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.$local.
-			'</font><br /><font size="-2">'.
-			$domaininfo{$hostdom{$local}}{'description'}.
-		       '</font></td><td bgcolor="#DDDDBB">';
-		    &users($local);
-		    print 
-	      '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
-	      $host{$local.'_users'}.'</font></td><td bgcolor="#DDDDBB">';
-		    &bar($factor*$host{$local.'_users'});
-		    print '</td></tr>'."\n";
+                    print '<div class="LC_grid_row" role="row">'.
+                          '<div class="LC_grid_cell" role="gridcell" style="background-color: #BBDDBB;">'.
+                          '<span style="color: #225522; font-family: arial; font-size: larger;">'.$local.'</span>'.
+                          '<br /><span style="font-size: smaller;">'.
+                          $domaininfo{$hostdom{$local}}{'description'}.'</span>'.
+                          '</div><div class="LC_grid_cell" role="gridcell" style="background-color: #DDDDBB;">';
+                    &users($local);
+                    print '</div><div class="LC_grid_cell" role="gridcell" style="background-color: #DDDDBB;">'.
+                          '<span style="color: #225522; font-family: arial;">'.
+                          $host{$local.'_users'}.'</span></div>'.
+                          '<div class="LC_grid_cell" role="gridcell" style="background-color: #DDDDBB; vertical-align: middle;">';
+                    &bar($factor*$host{$local.'_users'});
+                    print "</div></div>\n";
 		}
 	    }
-	    print '</table>';
+	    print '</div>';
 	} else {
 	    print &Apache::lonlocal::mt('No active users logged in.');
 	}
@@ -600,31 +623,32 @@
 # Load
 	if ($maxload) {
 	    my $factor=50/$maxload; 
-	    print
-       "<table cellspacing='3' cellpadding='3' border='0' bgcolor='#225522'>";
-	    foreach my $local (sort keys %hostname) {
-		if (defined($host{$local.'_load_doomed'})) {
-		    print 
-'<tr><td bgcolor="#BBDDBB"><font face="arial" color="#225522" size="+1">'.
-                        $local.
-			'</font><br /><font size="-2">'.
-			$Apache::lonnet::domain{$hostdom{$local}}{'description'}.
-		       '</font></td><td bgcolor="#DDDDBB">';
-		    &server($local);
-		    print 
-	      '</td><td bgcolor="#DDDDBB"><font face="arial" color="#225522">'.
-	      $host{$local.'_load_doomed'}.'</font></td><td bgcolor="#DDDDBB">';
-		    &bar($factor*$host{$local.'_load_doomed'});
-		    print "</td></tr>\n";
+            print '<div class="LC_grid" role="grid">';
+            foreach my $local (sort(keys(%hostname))) {
+                if (defined($host{$local.'_load_doomed'})) {
+                    print '<div class="LC_grid_row" role="row">'.
+                          '<div class="LC_grid_cell" role="gridcell" style="background-color: #BBDDBB;">'.
+                          '<span style="color: #225522; font-family: arial; font-size: larger;">'.$local.'</span>'.
+                          '<br /><span style="font-size: smaller;">'.
+                          $Apache::lonnet::domain{$hostdom{$local}}{'description'}.
+                          '</span></div>'.
+                          '<div class="LC_grid_cell" role="gridcell" style="background-color: #DDDDBB;">';
+                    &server($local);
+                    print '</div><div class="LC_grid_cell" role="gridcell" style="background-color: #DDDDBB;">'.
+                          '<span style="color: #225522; font-family: arial;">'.$host{$local.'_load_doomed'}.'</span>'.
+                          '</div>'.
+                          '<div class="LC_grid_cell" role="gridcell" style="background-color: #DDDDBB; vertical-align: middle;">';
+                    &bar($factor*$host{$local.'_load_doomed'});
+                    print "</div></div>\n";
 		}
 	    }
-	    print "</table>";
+	    print '</div>';
 	} else {
 	    print &Apache::lonlocal::mt('No workload.');
 	}
     } elsif ($mode eq 'trouble') {
 	my $count=0;
-	foreach my $local (sort keys %hostname) {
+	foreach my $local (sort(keys(%hostname))) {
 	    my $trouble='';
 	    if ($host{$local.'_unresponsive_doomed'}>3) {
 		$trouble=&Apache::lonlocal::mt('Does not respond to several queries.').
@@ -669,7 +693,7 @@
     } else {
         $output .= &Apache::lonlocal::mt($what);
     }
-    print '<script>document.prgstat.progress.value="'.$output.'";</script>'."\n";
+    print '<script type="text/javascript">document.prgstat.progress.value="'.$output.'";</script>'."\n";
 }
 
 # =============================================================================
@@ -723,8 +747,61 @@
 $mode=$FORM{'mode'};
 unless ($modes{$mode}) { $mode='trouble'; }
 # ================================================================ Send Headers
-print("Content-type: text/html\n\n".
-      '<html><body bgcolor="#FFFFFF">'."\n");
+print "Content-type: text/html\n\n";
+print <<START;
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Domain Status</title>
+<style type="text/css">
+  body {
+    background-color: #ffffff;
+  }
+  .LC_skip-to-main-content-link {
+    position: absolute;
+    left: -9999px;
+    z-index: 999;
+    padding: 1em;
+    font-size: 1.2em;
+    font-weight: bold;
+    background-color: #ffffff;
+    color: #000000;
+    opacity: 0;
+  }
+  .LC_heading_1 {
+    font-size: 1.5em;
+  }
+  .LC_heading_2 {
+    font-size: 1.17em;
+  }
+  .LC_warning {
+    color: #8F4F00;
+  }
+  .LC_nobreak {
+    white-space: nowrap;
+  }
+  div.LC_grid {
+    display: table;
+    background-color: #225522;
+    padding: 3px;
+    margin: 3px;
+    border-collapse: collapse;
+  }
+  div.LC_grid_row {
+    display: table-row;
+  }
+  div.LC_grid_cell {
+    display: table-cell;
+    padding: 2px 4px 2px 4px;
+    border: 1px solid #225522;
+  }
+</style>
+</head>
+<body>
+START
+    print "\n".'<a href="#LC_main_content" class="LC_skip-to-main-content-link">'.
+          &Apache::lonlocal::mt('Skip to main content').'</a>';
+    print "\n".'<div style="margin: 0; padding: 0; border: 0;" role="main" id="LC_main_content">'."\n";
 # -------------------- Read loncapa.conf (and by default, loncapa_apache.conf).
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
 %perlvar=%{$perlvarref};
@@ -735,12 +812,14 @@
 if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
     &Apache::lonlocal::get_language_handle();
     print(&LONCAPA::loncgi::missing_cookie_msg());
+    print '</div>';
     exit;
 }
 
 if (!&LONCAPA::lonauthcgi::can_view('clusterstatus')) {
     &Apache::lonlocal::get_language_handle();
     print &LONCAPA::lonauthcgi::unauthorized_msg('clusterstatus');
+    print '</div>';
     exit;
 }
 
@@ -774,17 +853,24 @@
     }
 }
 
-print '<img src="/adm/lonIcons/lonlogos.gif" align="right" /><h1>'.&Apache::lonlocal::mt("LON-CAPA $scope Status").' '.localtime()."</h1>";
-print "<form name='prgstat'>\n".
-'<input type="text" name="progress" value="'."'".&Apache::lonlocal::mt('Starting ...')."'".'" size="100" /><br />'.
-"</form>\n";
-print "<form name='status' method='post'>\n";
-print &Apache::lonlocal::mt('Choose next report:').' '.&select_form($mode,'mode',%modes).'<input type="submit" name="getreport" value="'.&Apache::lonlocal::mt('Go').'" /><hr />';
+print '<img src="/adm/lonIcons/lonlogos.gif" align="right" alt="" />'.
+      '<h1 class="LC_heading_1">'.&Apache::lonlocal::mt("LON-CAPA $scope Status").' '.
+      localtime().'</h1>';
+print '<form name="prgstat" action="">'."\n".
+      '<input type="text" name="progress" value="'.
+      "'".&Apache::lonlocal::mt('Starting ...')."'".'" size="100" '.
+      'aria-label="'.&Apache::lonlocal::mt('Status').'" /><br />'.
+      "</form>\n";
+print '<form name="status" method="post" action="">'."\n".
+      '<div style="margin: 4px 0;"><span class="LC_nobreak">'.
+      '<label for="mode">'.&Apache::lonlocal::mt('Choose next report:').'</label> '.
+      &select_form($mode,'mode','mode',%modes).' <input type="submit" name="getreport" value="'.
+      &Apache::lonlocal::mt('Go').'" /></span></div><hr />';
 &hidden('refresh',$refresh);
 
     if (!$FORM{'runonetime'}) {
         my $lcscope = lc($scope);
-	print '<h3>'.&Apache::lonlocal::mt("Gathering initial $lcscope data").'</h3>'.
+	print '<h2 class="LC_heading_2">'.&Apache::lonlocal::mt("Gathering initial $lcscope data").'</h2>'.
               &Apache::lonlocal::mt('This may take some time ...').'<br />';
 	$fromcache=0;
 	&mainloop();
@@ -808,7 +894,7 @@
     }
 
 # ============================================================== Close, refresh
-print "</form><script>";
+print '</form></div><script type="text/javascript">';
 my $runtime=time-$starttime;
 if (($refresh-$runtime)<0) {
     print "document.status.submit();";


More information about the LON-CAPA-cvs mailing list