aptcheck/aptcheck.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # Check what packages are needed to get upgraded on all machines
   4 #
   5 # Depends heavily on having ssh key authentication set up to all
   6 # boxes. That's why I run it on my own workstation.
   7 #
   8 # Regular debian upgrades are detected by running
   9 #  apt-get upgrade -s
  10 # on every machine, and parsing the output.
  11
  12 # We have decided to maintain some packages manually on some
  13 # machines, so that system-level upgrades will not disturb
  14 # applications, which may need more hand-holding. These are
  15 # extracted from our apt repository, and queried on every
  16 # server with apt-cache policy. This way, as soon as a package
  17 # is released on our repo, it will get listed here.
  18 #
  19 # 11-Mar-2011 Heikki: Started this
  20 # 22-Mar-2011 Heikki: Adding manually maintained packages
  21 # 15-Aug-2011 Heikki: Adding a total in the headline, for nagiosgrapher
  22 # 21-May-2012 Heikki: Added a date since when a package has been pending
  23 # 31-May-2012 Heikki: Pointing to the new wiki
  24 # 01-Jan-2013 Heikki: Get hosts from nagios-us as well.
  25 #
  26 # TODO: Assumes that we release our restricted packages for all versions
  27 # and architectures at the same time. Gets only the highest version from
  28 # all, and reports anything less than this. Good enough for now.
  29 #
  30 # TODO: Check CentOs systems too
  31 # Need a check_rpm plugin, and nagios checks defined on the CentOs machines,
  32 # then we can grep for that check in nagios configs, and find rpm machines
  33 # that way. Or, check all machines listed in nagios, determine what they
  34 # run, and use proper commands to check for packages.
  35 #
  36 # TODO: Summary section for hosts that have too old updates still pending
  37 # - those that are marked with (!)
  38
  39 #### Init
  40 use strict;
  41 my $debug= $ARGV[0] || 0; # 0=none, 1=some, 2=more, 3=much
  42 my $year =`date +%Y`;
  43 #my $wikilink = 'http://twiki.indexdata.dk/cgi-bin/twiki/view/ID/';
  44 my $wikilink = 'https://twiki.indexdata.com/twiki/bin/view/ID/';
  45 my $restrictedpackages = "ssh -q kebab cat /home/ftp/pub/debian/dists/*/restricted/*/Packages";
  46 my $updlink="<i>-u</i>"; # to display after a name, liking to the upd page
  47
  48 #### Host comments
  49 my %hostcomments = (
  50       "ariel"    => "<i>Niels Erik</i> does the manual upgrades",
  51       "bellone"  => "<i>Niels Erik</i> does the manual upgrades",
  52       "cfrepous" => "<i>Wolfram</i> does the manual upgrades",
  53       "leopard"  => "<i>Wolfram</i> does the manual upgrades",
  54       "lsd"      => "<i>Heikki</i> takes care of all upgrades",
  55       );
  56
  57
  58 #### Get list of hosts
  59 # I could use a hard-coded list, but I would forget to maintain it.
  60 # Nagios knows most of our hosts. It even knows which are worth
  61 # checking, they have a command to check apts!
  62 print "Getting hostlist from nagios\n" if $debug;
  63 my $hostlist1 = `ssh nagios grep -l \\"define host\\" /etc/nagios3/indexdata-conf.d/*.cfg`
  64   or die "Could not get host list from nagios (dk)";
  65
  66 print "Getting hostlist from nagios-us\n" if $debug;
  67 #my $hostlist2 = `ssh nagios-us grep -l Apt /etc/nagios3/indexdata-conf.d/*.cfg`
  68 my $hostlist2 = `ssh nagios-us grep -l \\"define host\\" /etc/nagios3/indexdata-conf.d/*.cfg`
  69   or die "Could not get host list from nagios (us)";
  70
  71 my $hostlist = $hostlist1 . $hostlist2;
  72 print "Got list:\n$hostlist\n" if $debug>2;
  73
  74 ###### Get list of packages that can be manually maintained
  75 print "getting restricted package versions\n" if $debug;
  76 my %restrpkgs;
  77 my $restplines = `$restrictedpackages`
  78   or die "Could not get the list of restricted packages " .
  79          "from $restrictedpackages: $! ";
  80 print "Got package list: \n$restplines\n" if $debug>2;
  81 my $pname;
  82 my $pver;
  83 for my $pline ( split("\n",$restplines) ) {
  84     chomp($pline);
  85     $pname = $1 if $pline =~ /^Package:\s+(\S*)\s*$/;
  86     $pver = $1 if $pline =~ /^Version:\s+(\S*)\s*$/;
  87     print "$pline: p=$pname v=$pver\n" if $debug>2;
  88     if ( $pname && $pver ) {
  89         print "\nPackage $pname version $pver \n" if $debug>2;
  90         if ( ! $restrpkgs{$pname} ) {
  91             $restrpkgs{$pname} = $pver;
  92             print "found $pname, first version $pver\n" if $debug>1;
  93         } else {
  94             my $bver = $restrpkgs{$pname};
  95             `dpkg --compare-versions "$bver" lt "$pver" 2>/dev/null `;
  96             if ( ! $? ) {
  97                 print "found $pname, better version $pver (better than $bver)\n"
  98                     if $debug>1;
  99                 $restrpkgs{$pname} = $pver;
 100             } else {
 101                 print "found $pname, but version $pver is no better than $bver\n"
 102                     if $debug>2;
 103             }
 104         }
 105         $pname = ""; # clear for the next one.
 106         $pver = "";
 107     }
 108 }
 109
 110 print "got " . scalar(keys(%restrpkgs)) . " restricted packages\n" if $debug;
 111 if ( $debug >1 ) {
 112     for $pname ( sort (keys(%restrpkgs)) ) {
 113         print "  $pname " . $restrpkgs{$pname} . "\n";
 114     }
 115 }
 116
 117 # Statistics
 118 my %summary;
 119 my ( %sechosts, %secpkgs );
 120 my ( %ownhosts, %ownpkgs );
 121 my ( %manhosts, %manpkgs );
 122 my ( %normhosts, %normpkgs );
 123 my %okhosts;
 124 my %skiphosts;
 125 my %allhosts;
 126 my $sectot = 0;
 127 my $owntot = 0;
 128 my $mantot = 0;
 129 my $normtot = 0;
 130 my %updlinks;
 131 my %debversions;
 132
 133 # Pending modification dates
 134 my %olddates;  # Read in from the file
 135 my %newdates;  # To be written in the new version of the file
 136 my $datefilename = "aptcheck.data";
 137 my $dateoldfilename = "aptcheck.old";
 138 my $thisdate = "*"; # indicates really old stuff
 139 my $warndate; # Older than this will be boldfaced
 140
 141 if ( -f $datefilename ) {
 142   print "Reading dates from $datefilename\n" if $debug;
 143   open F, $datefilename or die "Could not open date file $datefilename: $!";
 144   while (<F>) {
 145     chop();
 146     my ($pkg, $date) = split;
 147     next unless $pkg;  # skip empty lines
 148     $olddates{$pkg} = $date;
 149     print "Date for '$pkg' is '$date' \n" if $debug;
 150   }
 151   close F;
 152   $thisdate = `date +%F`;
 153   chomp($thisdate);
 154   $warndate = `date +%F -d "30 days ago"` ; ;
 155   chomp($warndate);
 156   print "Dates: now: '$thisdate' warn: '$warndate'\n" if $debug;
 157 } else {
 158   print "No datefile $datefilename found, starting from scratch\n";
 159 }
 160
 161
 162 my $table = "<table>\n";
 163
 164 HOSTLOOP:
 165 for my $hline ( sort( split("\n",$hostlist) ) ) {
 166     next unless ( $hline =~ /\/([a-z0-9-]+)\.cfg$/ );
 167     my $H = $1;
 168     print "Checking $H\n" if $debug;
 169     next if ($H =~ /^xdummy/ );
 170     next if ($H =~ /^commands/ );
 171     next if ($H =~ /^contacts/ );
 172     next if ($H =~ /^servicegroups/ );
 173     next if ($H =~ /^hostgroups/ );
 174     next if ($H =~ /^host-/ );
 175     last if ($H =~/cookie/) && $debug;
 176     $allhosts{$H}=1;
 177     my $cmd =
 178         "if test -f /etc/debian_version; " .
 179         "then " .
 180             " cat /etc/debian_version; " .
 181             " apt-cache -q policy " . join(" ",sort(keys(%restrpkgs))) .";" .
 182             " apt-get upgrade -s -o 'Debug::NoLocking=true'; " .
 183         "else " .
 184             " cat /etc/redhat-release; " .
 185             # " yum check-update -q; ".
 186             " echo done ;".  # to be sure we have one "real" line
 187         "fi " ;
 188
 189     my $cmd0 = "cat /etc/debian_version";
 190     my $cmd1 = "apt-cache -q policy " . join(" ",sort(keys(%restrpkgs)));
 191     my $cmd2 = "apt-get upgrade -s -o 'Debug::NoLocking=true' ";
 192     # Note, do not append -qq, we want some output even when nothing to do
 193     print "ssh -q $H \"$cmd\" 2>/dev/null \n" if ($debug>1);
 194     my $apt = `ssh -q $H "$cmd" 2>/dev/null`;
 195     if ( !$apt ) {
 196         $table .= "<tr><td colspan='3'>&nbsp;</td></tr>\n";
 197         $table .= "<tr><td colspan='3'><b><u>$H</u></b> (skipped)</td></tr>\n";
 198         $skiphosts{$H}=1;
 199         next HOSTLOOP;
 200     }
 201     print "Got apts for $H: \n$apt\n" if $debug>2;
 202     my $det = ""; # detail lines
 203     my $pkgs = 0;
 204     my $secs = 0;
 205     my $own = 0;
 206     my $man = 0;
 207     my $restrname = "";
 208     my $restrinst = "";
 209     my $restrcand = "";
 210     my $versionseen = 0;
 211     my $is_debian = 0;
 212     for my $p ( split("\n",$apt) ) {
 213         if ( !$versionseen ) {  # first line
 214             $versionseen = 1;
 215             if ( $p =~ /Centos/i ) {
 216                 print "CentOs version for $H is $p\n" if ($debug>1);
 217                 $debversions{$H} = $p;
 218             } else { # must be Debian
 219                 $p =~ s/(5[0-9.]+)/$1 LENNY !!!/;
 220                 $p =~ s/(6[0-9.]+)/$1 squeeze/;
 221                 $p =~ s/(7[0-9.]+)/$1 wheezy/;
 222                 $p = "&nbsp;Debian $p";
 223                 $debversions{$H} = $p;
 224                 $is_debian = 1;
 225                 print "Deb version for $H is $p\n" if ($debug>1);
 226             }
 227             next;
 228         }
 229         if ( ! $is_debian ) {
 230             $table .= "<tr><td colspan='3'>&nbsp;</td></tr>\n";
 231             $table .= "<tr><td colspan='3'><b><u>$H</u></b> (skipped)</td></tr>\n";
 232             $table .= "<tr><td colspan='3'>Looks like Centos, " .
 233                       "not yet implemented </td></tr>\n";
 234             $skiphosts{$H}=1;
 235             next HOSTLOOP;
 236         }
 237         # parse apt-cache output
 238         $restrname = $1 if $p =~ /^(\S+):$/;
 239         $restrinst = $1 if $p =~ /^\s+Installed:\s+(\S+)$/;
 240         $restrcand = $1 if $p =~ /^\s+Candidate:\s+(\S+)$/;
 241         if ( $p =~ /^\s+Version table:/ ) { # have all for that package
 242             my $bver = $restrpkgs{$restrname};
 243             if ( ( $restrinst eq $restrcand ) &&
 244                  ( $restrinst ne $bver ) ) {
 245                 # if different, it is a regular apt upgrade, and will be seen
 246                 # later. AND we want to have a different version in our repo
 247                 `dpkg --compare-versions "$bver" lt "$restrinst"  2>/dev/null`;
 248                 if ( $? ) { # It was not a downgrade
 249                             # manual packages may be ahead of the repo!
 250                     $mantot++;
 251                     $man++;
 252                     $pkgs++;
 253                     $manhosts{$H} = 1;
 254                     $manpkgs{$restrname} = 1;
 255                     $det .= "<tr>";
 256                     $det .= "<td>&nbsp;&nbsp;$restrname <b>(M)</b></td>";
 257                     $det .= "<td>". strdiff($bver,$restrinst)."</td>";
 258                     $det .= "<td>". strdiff($restrinst,$bver)."</td>";
 259                     my $datekey = "$H:$restrname";
 260                     if ( $olddates{$datekey} ) {
 261                         $newdates{$datekey} = $olddates{$datekey};
 262                     } else {
 263                         $newdates{$datekey} = $thisdate;
 264                     }
 265                     my $dispdate = $newdates{$datekey};
 266                     # if ( $dispdate lt $warndate ) {
 267                     if ( 0 ) { # manual packages don't need to be highlighted
 268                         $dispdate = "<b>$dispdate !</b>";
 269                     }
 270                     $det .= "<td>" . $dispdate . "</td>";
 271                     $det .= "</tr>\n";
 272                     my $key = "$restrname";
 273                     if ( !$summary{$key} ) {
 274                         $summary{$key} = "";
 275                     }
 276                     $summary{$key} .= "$H ";
 277                 }
 278             }
 279             $restrname = ""; # clear for next round
 280             $restrinst = "";
 281             $restrcand = "";
 282         }
 283         next unless $p =~
 284             /^Inst ([^ ]+) \[([^]]+)\] \(([^ ]+) ([^:]+):/;
 285         my ( $pkg,$cur,$new,$src ) = ( $1,$2,$3,$4 );
 286         print "$H: $pkg: $cur -> $new ($src)\n" if $debug>1;
 287         $det .= "<tr><td>&nbsp;&nbsp;";
 288         $pkgs++;
 289         my $key = $pkg;
 290         if ( $src =~ /Security/ ) {
 291             $det .= "<b>$pkg (s)</b> ";
 292             $sechosts{$H} = 1;
 293             $secpkgs{$pkg} = 1;
 294             $secs++;
 295             $sectot++;
 296         } elsif ( $src =~ /Indexdata/ ) {
 297             $det .= "<i><b>$pkg</b> (id) </i>";
 298             $ownhosts{$H}=1;
 299             $ownpkgs{$pkg}=1;
 300             $own++;
 301             $owntot++;
 302         } else {
 303             $det .= "$pkg ";
 304             $normhosts{$H}=1;
 305             $normpkgs{$pkg}=1;
 306             $normtot++;
 307         }
 308         if ( !$summary{$key} ) {
 309             $summary{$key} = "";
 310         }
 311         $summary{$key} .= "$H ";
 312         $new = strdiff($cur,$new);
 313         $cur = strdiff($new,$cur);
 314         $det .= "</td> ";
 315         $det .= "<td>$cur</td> ";
 316         $det .= "<td>$new</td> ";
 317         my $datekey = "$H:$pkg";
 318         if ( $olddates{$datekey} ) {
 319             $newdates{$datekey} = $olddates{$datekey};
 320         } else {
 321             $newdates{$datekey} = $thisdate;
 322         }
 323         my $dispdate = $newdates{$datekey};
 324         if ( ( $dispdate lt $warndate ) && ( $src =~ /Security/) ) {
 325             $dispdate = "<b>$dispdate !</b>";
 326         }
 327         $det .= "<td>" . $dispdate . "</td>";
 328         $det .= "</tr>\n";
 329
 330     }
 331     $table .= "<tr><td colspan='4'>&nbsp;</td></tr>\n";
 332     $table .= "<tr><td colspan='4'><a name='$H'><b><u>$H</u></b></a> &nbsp;\n";
 333     if ( $pkgs ) {
 334         $table .= "<b>$pkgs</b> packages to upgrade. ";
 335         $table .= "<b>$secs security</b>. " if $secs;
 336         $table .= " $own from indexdata. " if $own;
 337         $table .= " $man manual. " if $man;
 338     } else {
 339         $table .= "ok";
 340         $okhosts{$H} = 1;
 341     }
 342     my $updlink = $wikilink . ucfirst($H) . "Updates" . $year;
 343     # Fix some pages that do not follow the convention.
 344     # Mostly because the host names would not make proper WikiWords
 345     $updlink =~ s/Bugzilla3Updates/BugzillaUpdates/;
 346     $updlink =~ s/Opencontent-solrUpdates/OpenContentSolrUpdates/;
 347     $updlinks{$H} = $updlink;
 348     $table .= "&nbsp;<a href='$updlink' >Upd</a>";
 349     $table .= "&nbsp;" . $debversions{$H};
 350     $table .= "</td></tr>\n";
 351     $table .= "<tr><td>$hostcomments{$H}</td></tr>\n"
 352         if ( $hostcomments{$H} );
 353     $table .= $det if $pkgs;
 354     print "\n$table\n" if $debug>2;
 355 }
 356 $table .= "</table>\n";
 357
 358 # Save the date file
 359 if ( ! $debug ) {
 360     `mv -f $datefilename $dateoldfilename`;
 361     open F, ">$datefilename" or die "Could not open date file $datefilename for writing";
 362     for  my $k (sort(keys(%newdates)) ) {
 363         print F "$k " . $newdates{$k}. "\n";
 364         print "date for '$k' '" . $newdates{$k}. "'\n" if $debug;
 365     }
 366     close F
 367       or die "Could not close date file $datefilename: $!";
 368 } else {
 369     print "Not updating the date file, this is a debug run\n";
 370 }
 371
 372 # Page header
 373 my $outfile = "/tmp/aptcheck.html";
 374 open F, ">$outfile"
 375     or die "Could not open $outfile for writing: $!";
 376 print F "<html>\n";
 377 print F "<head><title>Apt upgrade status</title></head>\n";
 378 print F "<body>\n";
 379 print F "<H1>Package status</H1>\n";
 380 print F "<b>" .  ( $sectot + $owntot + $mantot + $normtot ) .
 381         "</b> packages pending (<b>$sectot</b> critical) \n";
 382
 383 print F "<H2>Debug run, many hosts missing!</H2>\n"
 384    if $debug;
 385
 386
 387 # Summary table: one row for per host group
 388 print F "<p/>\n";
 389 print F "<table border='1' >\n";
 390 print F "<tr><td>&nbsp;</td>" ;
 391 print F "<td><b>Hosts</b></td>\n";
 392 print F "<td><b>Packages</b></td></tr>\n";
 393
 394 if ( $sectot ) {
 395     print F "<tr><td><b>Security</b><br/>" . scalar(keys(%sechosts)) .
 396         "&nbsp;/&nbsp;" .  scalar(keys(%secpkgs)) . "&nbsp;/&nbsp;$sectot </td>\n" ;
 397     print F "<td>";
 398     for my $HH ( sort(keys(%sechosts)) ) {
 399         my $upd = $updlinks{$HH} || "#" ;
 400         print F "<a href='#$HH'><b>$HH</b></a><a href='$upd'>$updlink</a> ";
 401     }
 402     print F "</td>";
 403     print F "<td>";
 404     for my $PP ( sort(keys(%secpkgs)) ) {
 405         print F "<a href='#$PP'>$PP</a> ";
 406     }
 407     print F "</td>";
 408     print F "</tr>\n";
 409 }
 410 if ( $owntot ) {
 411     print F "<tr><td><b>Indexdata</b><br/>" . scalar(keys(%ownhosts)) .
 412         "&nbsp;/&nbsp;" .  scalar(keys(%ownpkgs)) . "&nbsp;/&nbsp;$owntot </td>\n" ;
 413     print F "<td>";
 414     for my $HH ( sort(keys(%ownhosts)) ) {
 415         my $upd = $updlinks{$HH} || "#" ;
 416         print F "<a href='#$HH'><b>$HH</b></a><a href='$upd'>$updlink</a> ";
 417         #print F "<a href='#$HH'><b>$HH</b></a> ";
 418     }
 419     print F "</td>";
 420     print F "<td>";
 421     for my $PP ( sort(keys(%ownpkgs)) ) {
 422         print F "<a href='#$PP'>$PP</a> ";
 423     }
 424     print F "</td>";
 425     print F "</tr>\n";
 426 }
 427 if ( $mantot ) {
 428     print F "<tr><td><b>Manual</b><br/>" . scalar(keys(%manhosts)) .
 429         "&nbsp;/&nbsp;" .  scalar(keys(%manpkgs)) . "&nbsp;/&nbsp;$mantot </td>\n" ;
 430     print F "<td>";
 431     for my $HH ( sort(keys(%manhosts)) ) {
 432         my $upd = $updlinks{$HH} || "#" ;
 433         print F "<a href='#$HH'><b>$HH</b></a><a href='$upd'>$updlink</a> ";
 434         #print F "<a href='#$HH'><b>$HH</b></a> ";
 435     }
 436     print F "</td>";
 437     print F "<td>";
 438     for my $PP ( sort(keys(%manpkgs)) ) {
 439         print F "<a href='#$PP'>$PP</a> ";
 440     }
 441     print F "</td>";
 442     print F "</tr>\n";
 443 }
 444 if ( $normtot ) {
 445     print F "<tr><td>Normal<br/>" . scalar(keys(%normhosts)) .
 446         "&nbsp;/&nbsp;" .  scalar(keys(%normpkgs)) . "&nbsp;/&nbsp;$normtot </td>\n" ;
 447     print F "<td>";
 448     for my $HH ( sort(keys(%normhosts)) ) {
 449         my $upd = $updlinks{$HH} || "#" ;
 450         print F "<a href='#$HH'><b>$HH</b></a><a href='$upd'>$updlink</a> ";
 451         #print F "<a href='#$HH'><b>$HH</b></a> ";
 452     }
 453     print F "</td>";
 454     print F "<td>";
 455     for my $PP ( sort(keys(%normpkgs)) ) {
 456         print F "<a href='#$PP'>$PP</a> ";
 457     }
 458     print F "</td>";
 459     print F "</tr>\n";
 460 }
 461 if ( %skiphosts ) {
 462     print F "<tr><td>Skipped " . scalar(keys(%skiphosts)) . "</td>\n";
 463     print F "<td colspan='2'>";
 464     for my $HH ( sort(keys(%skiphosts)) ) {
 465         my $upd = $updlinks{$HH} ||
 466                   $wikilink . ucfirst($HH) . "Updates" . $year;
 467         print F "<a href='#$HH'><b>$HH</b></a><a href='$upd'>$updlink</a> ";
 468         #print F "<a href='#$HH'><b>$HH</b></a> ";
 469     }
 470     print F "</td></tr>\n";
 471 }
 472 if ( 1 ) {
 473     print F "<tr><td>Ok <br/>" . scalar(keys(%okhosts)) .
 474            " of " . scalar(keys(%allhosts)) . "</td>\n";
 475     print F "<td colspan='2'>";
 476     for my $HH ( sort(keys(%okhosts)) ) {
 477         my $upd = $updlinks{$HH} || "#" ;
 478         print F "<a href='#$HH'><b>$HH</b></a><a href='$upd'>$updlink</a> ";
 479         #print F "<a href='#$HH'><b>$HH</b></a> ";
 480     }
 481     if ( !%okhosts ) {
 482         print F "<b>None at all!</b>";
 483     }
 484     print F "</td></tr>\n";
 485 }
 486 print F "</table>\n";
 487
 488 print F "<p/><b>" .  ( $sectot + $owntot + $mantot + $normtot ) .
 489         "</b> packages pending (<b>$sectot</b> critical) \n";
 490
 491 # Graph
 492 #my $secs = 60*60*24 * 7 * 2; # 2 weeks in secods
 493 #my $secs = "1m"; # one month, let nagios do the math
 494 my $secs = "45d";
 495 print F "<p/>" .
 496         "<a href='http://nagios.indexdata.com/cgi-bin/nagios3/graphs.cgi?" .
 497         "host=nagios&service=Apt%20Summary'>\n".
 498         "<img src='http://nagios.indexdata.com/" .
 499               "cgi-bin/nagios3/rrd2-system.cgi?" .
 500               "host=nagios&service=Apt%20Summary&" .
 501               "start=-$secs&" .
 502               "width=800&height=100&type=AVERAGE' /> ".
 503         "</a>" .
 504         "<br/>\n";
 505
 506 # The host table
 507 print F $table;
 508
 509 # Package table
 510 print F "<p/><b><u>Packages</u></b>\n";
 511 print F "<table>\n";
 512 for my $P ( sort(keys(%summary)) ) {
 513     my $PN = $P;
 514     $PN = "<b>$P&nbsp;(s)</b>" if ($secpkgs{$P});
 515     $PN = "<i>$P&nbsp;(id)</i>" if ($ownpkgs{$P});
 516     $PN = "$P&nbsp;<b>(M)</b>" if ($manpkgs{$P});
 517     print F "<tr><td><a name='$P'/>$PN</td>\n";
 518     print F "<td>";
 519     for my $HH ( split(' ',$summary{$P} )) {
 520         print F "<a href=#$HH>$HH</a> ";
 521     }
 522     print F "</td>\n";
 523
 524 }
 525 print F "</table>\n";
 526
 527 print F "<p/>Produced " . `date`.
 528         " on " . `hostname` . " by " . `whoami` .
 529         "<br/>\n";
 530 print F "</body></html>\n";
 531
 532 close(F)
 533     or die "Could not close $outfile: $!";
 534
 535 system "scp -q $outfile nagios:/var/www/heikki/index.html";
 536
 537 exit(0);
 538
 539 # Helper to take two strings and highligt that part of the second
 540 # that is different from the first.
 541 sub strdiff {
 542     my $x = shift;
 543     my $y = shift;
 544     print "strdiff: '$x' '$y' \n" if $debug>2;
 545     if ( $x eq $y ) {
 546         return "$x <b>??</b>";
 547     }
 548     my $a = 0;
 549     while ( $a < length($y) &&
 550         substr($x,$a,1) eq substr($y,$a,1) ) {
 551         $a++;
 552     }
 553     if ( $a == length($y) ) {
 554         return "$y";
 555     }
 556     my $b = 1;
 557     while ( $b < length($y)-$a &&
 558         substr($x,-$b,1) eq substr($y, -$b,1) ) {
 559         $b++;
 560     }
 561     my $c = length($y) - $b +1;
 562     print "strdiff:   a=$a " . substr($y,0,$a) ."\n" if $debug>2;
 563     print "strdiff:   b=$b " . "\n" if $debug>2;
 564     print "strdiff:   c=$c " . substr($y,$c) ."\n" if $debug>2;
 565     print "strdiff:        " . substr($y,$a, $c-$a) ."\n" if $debug>2;
 566     my $z =  substr($y,0,$a) .
 567              "<b>" . substr($y,$a, $c-$a) . "</b>" .
 568              substr($y,$c);
 569     print "strdiff:        " . $z ."\n" if $debug>2;
 570     print "\n" if $debug>2;
 571     return $z;
 572 }