From: Nigel Metheringham <nigel@exim.org>
Date: Tue, 22 Jun 2010 20:05:09 +0000 (+0100)
Subject: Stupid idiot did not get prog update right
X-Git-Url: https://git.exim.org/mirror-monitor.git/commitdiff_plain/9513c275c8f3b482625bb8d38aecb57d65337987

Stupid idiot did not get prog update right
---

diff --git a/mirmon/mirmon b/mirmon/mirmon
index edaf65f..27175e3 100755
--- a/mirmon/mirmon
+++ b/mirmon/mirmon
@@ -1,9 +1,8 @@
-#!/usr/bin/perl -w
-#
+#! /usr/bin/perl -w
+
 # Copyright (c) 2003 Henk Penning, all rights reserved.
 # penning@cs.uu.nl, http://www.cs.uu.nl/staff/henkp.html
-# Version 1.1 was donated to the Apache Software Foundation 2003 Jan 28
-# $Id: mirmon,v 1.37 2006/12/04 15:16:11 henkp Exp henkp $
+# Version 1.1 was donated to the Apache Software Foundation 2003 Jan 28.
 # Permission is hereby granted, free of charge, to any person obtaining a
 # copy of this software and associated documentation files (the "Software"),
 # to deal in the Software without restriction, including without limitation
@@ -22,830 +21,579 @@
 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 # DEALINGS IN THE SOFTWARE.
 #
-# Thanks to Klaus Heinz <heinz@NetBSD.org> for sugestions ao htm_head
-my $PRG = 'mirmon';
-my $VER = '$Id: mirmon,v 1.37 2006/12/04 15:16:11 henkp Exp henkp $';
-use strict;
-use IO::Pipe;
-use IO::Select;
-use Net::hostent;
-my $DEF_CNF = "/etc/$PRG.conf";
-my %CNF = qw( timeout    300
-  max_probes 25
-  min_poll   1h
-  max_poll   4h
-  min_sync   1d
-  max_sync   2d
-  list_style plain
-  put_histo  top
-  randomize  1
-);
-my @REQ_KEYS = qw( web_page state countries mirror_list probe
-  project_name project_url icons
-);
-my @OPT_KEYS =
-  qw( project_logo min_poll min_sync max_sync list_style htm_top htm_foot
-  htm_head put_histo
-);
-my %CNF_KEYS;
-for ( @REQ_KEYS, @OPT_KEYS, keys %CNF ) { $CNF_KEYS{$_}++; }
-my $TIM_PAT    = '^(\d+)([smhd])$';
-my @LIST_STYLE = qw(plain apache);
-my @GET_OPTS   = qw(all update);
-my @PUT_HGRAM  = qw(top bottom nowhere);
-my $HIST       = 14;
-my %APA_TYPES  = ();
-for (qw(backup ftp http)) { $APA_TYPES{$_}++; }
-my $prog = substr( $0, rindex( $0, '/' ) + 1 );
-my $Usage = <<USAGE ;
-Usage: $prog [ -v ] [ -q ] [ -t timeout ] [ -get opt ] [ -c conf ]
-option v   : be verbose
-option q   : be quiet
-option t   : set timeout [ default $CNF{timeout} ] ;
-option get : 'all'    : probe all sites
-           : 'update' : probe a selection of the sites (see doc)
-option c   : configuration file [ default $DEF_CNF ]
--------------------------------------------------------------------
-Documentation : the program contains 'pod' style documentation.
-Extract the doc with 'pod2text $prog' or 'pod2html $prog OUT', etc.
--------------------------------------------------------------------
-USAGE
-sub Usage { die "$_[0]$Usage"; }
-sub Error { die "$prog: $_[0]\n"; }
-sub Warn  { warn "$prog: $_[0]\n"; }
-# usage: &GetOptions(ARG,ARG,..) defines $opt_ID as 1 or user spec'ed value
-# usage: &GetOptions(\%opt,ARG,ARG,..) defines $opt{ID} as 1 or user value
-# ARG = 'ID' | 'ID=SPC' | 'ID:SPC' for no-arg, required-arg or optional-arg
-# ID  = perl identifier
-# SPC = i|f|s for integer, fixedpoint real or string argument
-use Getopt::Long;
-Getopt::Long::config('no_ignore_case');
-# Usage() unless GetOptions() ;
-my %opt = ();
-Usage() unless GetOptions( \%opt, 'v', 'q', 't=i', 'get=s', 'c=s' );
-Usage("Arg count\n") unless @ARGV >= 0;
-my %WGT;
-my $GET = IO::Select->new();
-my %URL;
-my %RES;
-my %OLD;
-my %LST;
-my %CCS;
-my %HREF;
-# <META HTTP-EQUIV=Expires CONTENT="Tue, 04 Dec 1993 21:29:02 GMT">
-sub exp_date {
-    my @day = qw(Sun Mon Tue Wed Thu Fri Sat);
-    my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
-    my @gmt = gmtime time + 3600;
-    sprintf "%s, %02d %s %4d %02d:%02d:%02d GMT", $day[ $gmt[6] ], $gmt[3],
-      $mon[ $gmt[4] ], $gmt[5] + 1900, @gmt[ 2, 1, 0 ];
-}
-sub find_conf {
-    return $opt{c} if $opt{c};
-    my $HOME = ( getpwuid $< )[7] or Error "can get homedir '$<' ($!)";
-    my @LIST = ( "$PRG.conf", "$HOME/.$PRG.conf", $DEF_CNF );
-    for my $conf (@LIST) { return $conf if -f $conf; }
-    Error sprintf "can't find a config file :\n  %s", join "\n  ", @LIST;
-}
-sub show_conf {
-    print "vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv\n";
-    for my $key ( sort keys %CNF ) {
-        next if $key =~ m/^_/;
-        print "show_conf : $key = '$CNF{$key}'\n";
-    }
-    for my $key ( sort keys %HREF ) {
-        printf "show_conf : for site '%s' use instead\n   '%s'\n", $key,
-          $HREF{$key}
-          if $opt{v};
-    }
-    printf "show_conf : included '%s'\n", join "', '", @{ $CNF{_include} };
-    print "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n";
-}
-sub get_conf;
-sub get_conf {
-    my $FILE = shift;
-    if ( grep $_ eq $FILE, @{ $CNF{_include} } ) {
-        Error "already included : '$FILE'";
-    }
-    else { push @{ $CNF{_include} }, $FILE; }
-    open FILE, $FILE or Error "can't open '$FILE' ($!)";
-    my $CONF = join "\n", grep /./, <FILE>;
-    close FILE;
-    $CONF =~ s/\t/ /g;          # replace tabs
-    $CONF =~ s/^[+ ]+//;        # delete leading space, plus
-    $CONF =~ s/\n\n\s+/ /g;     # glue continuation lines
-    $CONF =~ s/\n\n\+\s+//g;    # glue concatenation lines
-    $CONF =~ s/\n\n\./\n/g;     # glue concatenation lines
-    chop $CONF;
-    print "--$CONF--\n" if $opt{d};
-    for ( grep !/^#/, split /\n\n/, $CONF ) {
-        my ( $key, $val ) = split ' ', $_, 2;
-        $val = '' unless defined $val;
-        print "conf '$FILE' : key '$key', val '$val'\n" if $opt{d};
-        if ( exists $CNF_KEYS{$key} ) { $CNF{$key} = $val; }
-        elsif ( $key eq 'site_url' ) {
-            my ( $site, $url ) = split ' ', $val;
-            $url .= '/' unless $url =~ m!/$!;
-            $HREF{ lc $site } = $url;
-            printf "config : for site '%s' use instead\n   '%s'\n", $site, $url
-              if $opt{v};
-        }
-        elsif ( $key eq 'env' ) {
-            my ( $x, $y ) = split ' ', $val;
-            $ENV{$x} = $y;
-            printf "config : setenv '%s'\n   '%s'\n", $x, $y if $opt{v};
-        }
-        elsif ( $key eq 'no_randomize' ) { $CNF{randomize} = 0; }
-        elsif ( $key eq 'include' ) { get_conf $val ; }
-        elsif ( $key eq 'show' )    { show_conf unless $opt{q}; }
-        elsif ( $key eq 'exit' )    { Error 'exit per config directive'; }
-        elsif ( $key eq 'max_age' ) { $CNF{max_sync} = $val; }
-        else {
-            show_conf;
-            Error "unknown keyword '$key' (value '$val')";
-        }
-    }
-}
-sub get_conf_opt {
-    my $err = '';
-    get_conf find_conf;
-    $CNF{timeout} = $opt{t} if $opt{t};
-    for my $key (@REQ_KEYS) {
-        unless ( exists $CNF{$key} ) {
-            $err .= "$prog error: missing config for '$key'\n";
-        }
-    }
-    for my $key (qw(min_poll max_poll max_sync min_sync)) {
-        my $max = $CNF{$key};
-        unless ( $max =~ /$TIM_PAT/o ) {
-            $err .= "$prog error: $key ($max) doesn't match /$TIM_PAT/\n";
-        }
-    }
-    unless ( grep $CNF{list_style} eq $_, @LIST_STYLE ) {
-        $err .= sprintf "%s : error: unknown 'list_style' '%s'\n", $prog,
-          $CNF{list_style};
-    }
-    unless ( grep $CNF{put_histo} eq $_, @PUT_HGRAM ) {
-        $err .= sprintf "%s : error: unknown 'put_histo' '%s'\n", $prog,
-          $CNF{put_histo};
-    }
-    if ( $opt{get} and not grep $opt{get} eq $_, @GET_OPTS ) {
-        $err .= sprintf "%s : error: unknown 'get option' '%s'\n", $prog,
-          $opt{get};
-    }
-    Error $err if $err;
-    $opt{q} = 0 if $opt{v};
-}
-sub tim_to_s {
-    my $tim = shift;
-    my %tab = ( 's' => 1, 'm' => 60, 'h' => 60 * 60, 'd' => 60 * 60 * 24 );
-    Error "wrong time '$tim'" unless $tim =~ /$TIM_PAT/o;
-    my $m = $1;
-    my $u = $2;
-    return $m * $tab{$u};
-}
-sub aprx_eq { my ( $t1, $t2 ) = @_; abs( $t1 - $t2 ) < 60; }
-sub aprx_ge { my ( $t1, $t2 ) = @_; $t1 > $t2 or aprx_eq $t1, $t2; }
-sub aprx_le { my ( $t1, $t2 ) = @_; $t1 < $t2 or aprx_eq $t1, $t2; }
-sub aprx_gt { my ( $t1, $t2 ) = @_; $t1 > $t2 and not aprx_eq $t1, $t2; }
-sub aprx_lt { my ( $t1, $t2 ) = @_; $t1 < $t2 and not aprx_eq $t1, $t2; }
-sub pr_interval {
-    my $s = shift;
-    my ( $magn, $unit );
-    my $mins  = $s / 60;
-    my $m     = int( $mins + 0.5 );
-    my $hours = $s / ( 60 * 60 );
-    my $h     = int( $hours + 0.5 );
-    if    ( $s < 50 ) { $magn = $s; $unit = 'second'; }
-    elsif ( $m < 50 ) { $magn = $m; $unit = 'minute'; }
-    elsif ( $h < 36 ) { $magn = $h; $unit = 'hour'; }
-    else              { $magn = sprintf "%.1f", $hours / 24; $unit = 'day'; }
-    $unit .= 's' unless $magn == 1;
-    return "$magn $unit";
-}
-sub max_age1 {
-    ( tim_to_s $CNF {min_sync} ) + ( tim_to_s $CNF {max_poll} );
-}
-sub max_age2 {
-    ( tim_to_s $CNF {max_sync} ) + ( tim_to_s $CNF {max_poll} );
-}
-sub max_vrfy {
-    ( tim_to_s $CNF {min_poll} ) + ( tim_to_s $CNF {max_poll} );
-}
-sub age_code {
-    my $time = shift;
-    return 'z' unless $time =~ /^\d+$/;
-    return (
-        ( aprx_ge( $time, $^T - max_age1 ) )
-        ? 's'
-        : ( aprx_ge( $time, $^T - max_age2 ) ? 'b' : 'f' )
-    );
-}
-sub err {
-    my $url  = shift;
-    my $stat = shift;
-    printf "*** %-10s %s\n", $stat, $url unless $opt{q};
-    my ( $time, $vrfy, $hstp, $hsts );
-    if ( exists $OLD{$url} ) {
-        $time = $OLD{$url}[0];
-        $vrfy = $OLD{$url}[2];
-        $hstp = substr $OLD{$url}[3], 1 - $HIST;
-        $hsts = $OLD{$url}[4];
-    }
-    else {
-        $time = 'undef';
-        $vrfy = 'undef';
-        $hstp = '';
-        $hsts = '';
-    }
-    $RES{$url} = [ $time, $stat, $vrfy, $hstp . 'f', $hsts, $^T ];
-}
-sub res {
-    my $url  = shift;
-    my $time = shift;
-    my $stat = shift;
-    my $hstp = (
-        exists $OLD{$url}
-        ? substr( $OLD{$url}[3], 1 - $HIST )
-        : ''
-    );
-    my $hsts = ( exists $OLD{$url} ? $OLD{$url}[4] : '' );
-    printf "result %d %s\n", $time, $url if $opt{v};
-    $RES{$url} = [ $time, $stat, $^T, $hstp . 's', $hsts, $^T ];
-}
-sub get_state {
-    my $STT = shift;
-    open STT, $STT or Error "can't open '$STT' ($!)";
-    while (<STT>) {
-        chop;
-        my ( $url, $time, $stat, $vrfy, $hstp, $hsts, $lprb ) = split ' ';
-        $stat =~ s/_/ /g;
-        $hstp = '' unless defined $hstp;
-        $hsts = '' unless defined $hsts;
-        $hsts = '' if $hsts eq 'undef';
-        $lprb = 'undef' unless defined $lprb;
-        $OLD{$url} = [ $time, $stat, $vrfy, $hstp, $hsts, $lprb ];
-    }
-    close STT;
-}
-sub check_hist {
-    my $time = shift;
-    my $hsts = shift;
-    printf "check_hist: last '$time' hsts '$hsts'\n" if $opt{d};
-    my $res = $hsts;
-    my ( $stmp, $hist );
-    if ( $hsts eq '' ) { $stmp = 0; $hist = ''; }
-    else               { ( $stmp, $hist ) = split '-', $hsts; }
-    if ( aprx_le $stmp, $^T - tim_to_s '1d' ) {
-        $res = sprintf "%s-%s%s", $^T, substr( $hist, 1 - $HIST ),
-          age_code($time);
-    }
-    return $res;
-}
-sub put_state {
-    my $STT = shift;
-    my $TMP = "$STT.tmp";
-    open TMP, ">$TMP" or Error "can't write '$TMP' ($!)";
-    for my $url ( sort keys %RES ) {
-        $RES{$url}[4] = check_hist $RES {$url}[0], $RES{$url}[4];
-        my @OUT = @{ $RES{$url} };
-        $OUT[1] =~ s/\s/_/g;
-        printf TMP "%s %s\n", $url, join ' ', @OUT
-          or Error "can't print to $TMP ($!)";
-    }
-    close TMP;
-    if ( -z $TMP ) { Warn "wrote empty state file; keeping previous version"; }
-    else { rename $TMP, $STT or Error "can't rename '$TMP', '$STT' ($!)"; }
-}
-sub get_ccs {
-    my $CCS = shift;
-    open CCS, $CCS or Error "can't open '$CCS' ($!)";
-    while (<CCS>) {
-        chop;
-        next if /^#/;
-        my ( $code, $dash, $reg ) = split ' ', $_, 3;
-        $CCS{ lc $code } = lc $reg;
-    }
-    close CCS;
-}
-sub type_site {
-    my $url = shift;
-    my ( $type, $site, $home );
-    if ( $url =~ m!^(ftp|http)://([^/:]+)(:\d+)?/! ) {
-        $type = $1;
-        $site = $2;
-        $home = $&;
-    }
-    return $type, $site, $home;
-}
-sub type { my ( $t, $s, $h ) = type_site $_[0]; $t; }
-sub site { my ( $t, $s, $h ) = type_site $_[0]; $s; }
-sub home { my ( $t, $s, $h ) = type_site $_[0]; $h; }
-sub get_list {
-    my $LST = shift;
-    my ( $reg, $url );
-    open LST, $LST or Error "can't open '$LST' ($!)";
-    while (<LST>) {
-        chop;
-        next if /^#/;
-        next if /^\s*$/;
-        if ( $CNF{list_style} eq 'plain' ) {
-            ( $reg, $url ) = split ' ';
-            unless ( $url =~ m!/$! ) {
-                print "*** mirmon appended '/' to $url\n" unless $opt{q};
-                $url .= '/';
-            }
-        }
-        elsif ( $CNF{list_style} eq 'apache' ) {
-            my $apache_type;
-            ( $apache_type, $reg, $url ) = split ' ';
-            unless ( defined $APA_TYPES{$apache_type} ) {
-                print "*** strange type : $apache_type\n" unless $opt{q};
-                next;
-            }
-            unless ( $url =~ m!/$! ) {
-                print "*** missing '/' in $url\n" unless $opt{q};
-                $url .= '/';
-            }
-        }
-        my $site = site $url ;
-        my $type = type $url ;
-        unless ( defined $site ) {
-            print "*** strange url : '$url'\n" unless $opt{q};
-            next;
-        }
-        $LST{$url} = [ $type, $site, $reg ];
-    }
-}
-sub url { sprintf '<A HREF="%s">%s</A>', $_[0], $_[1]; }
-sub nam { sprintf '<A NAME="%s">%s</A>', $_[0], $_[1]; }
-sub SMA { sprintf "<FONT SIZE=\"-1\">%s</FONT>", $_[0]; }
-sub BLD { sprintf "<B>%s</B>", $_[0]; }
-sub NSS { sprintf SMA('%s&nbsp;site%s'), $_[0], ( $_[0] == 1 ? '' : 's' ); }
-sub TAB { sprintf "<TABLE BORDER=2 CELLPADDING=3>%s</TABLE>", $_[0]; }
-sub TR  { sprintf "<TR>%s</TR>\n",                            $_[0]; }
-sub TH  { sprintf "<TH>%s</TH>\n",                            $_[0]; }
-sub TD  { sprintf "<TD>%s</TD>\n",                            $_[0]; }
-sub TDr { sprintf "<TD ALIGN=\"RIGHT\">%s</TD>\n",            $_[0]; }
-sub RED { sprintf "<FONT COLOR=\"RED\">%s</FONT>",            $_[0]; }
-sub GRN { sprintf '<FONT COLOR="GREEN">%s</FONT>',            $_[0]; }
-sub htmlquote {
-    my $x = shift;
-    $x =~ s/&/&amp;/g;
-    $x =~ s/</&lt;/g;
-    $x =~ s/>/&gt;/g;
-    return $x;
-}
-sub diff {
-    my $time = shift;
-    my $max  = shift;
-    my $res;
-    if ( $time == $^T ) { $res = BLD 'renewed'; }
-    else {
-        $res = pr_interval $^T - $time;
-        $res = BLD RED $res if aprx_lt $time, $max;
-    }
-    return $res;
-}
-sub img_sf_cnt {
-    sprintf '<IMG BORDER=1 SRC="%s/mm%s%02d.gif" ALT="">', $CNF{icons}, $_[0],
-      $_[1];
-}
-sub img_sf { img_sf_cnt $_[0], 1; }
-sub show_hist {
-    my $hst = shift;
-    return '' unless $hst =~ m/^[sbfz]+$/;
-    if ( length $hst == $HIST and $hst =~ /^(s*b)s*$/ ) {
-        return img_sf_cnt 'sb', length $1;
-    }
-    elsif ( length $hst == $HIST and $hst =~ /^(s*f)s*$/ ) {
-        return img_sf_cnt 'sf', length $1;
-    }
-    elsif ( length $hst == $HIST and $hst =~ /^(s*b)fs*$/ ) {
-        return img_sf_cnt 'sbf', length $1;
-    }
-    my $res = '';
-    my $cnt = 1;
-    my $prf = substr $hst, 0, 1;
-    $hst = substr $hst, 1;
-    while ( $hst ne '' ) {
-        if ( substr( $prf, 0, 1 ) eq substr( $hst, 0, 1 ) ) {
-            $cnt++;
-            $hst = substr $hst, 1;
-        }
-        else {
-            $res .= img_sf_cnt $prf, $cnt;
-            $prf = substr $hst, 0, 1;
-            $hst = substr $hst, 1;
-            $cnt = 1;
-        }
-    }
-    $res .= img_sf_cnt $prf, $cnt if $cnt;
-    return $res;
-}
-sub show_hist_age {
-    my $hsts = shift;
-    my $time = shift;
-    return '' if $hsts eq '';
-    my ( $t, $h ) = split '-', $hsts;
-    if ( aprx_lt $t, $^T ) { $h .= age_code $time ; }
-    return show_hist substr $h, -$HIST;
-}
-sub gen_histogram_probes {
-    my ( $time, $stat, $vrfy, $hstp, $hsts, $lprb );
-    my %tab   = ();
-    my %bad   = ();
-    my $res   = '';
-    my $s_cnt = 0;
-    my $f_cnt = 0;
-    my $hr_min;
-    my $hr_max;
-    return '' unless scalar keys %RES;
-    for my $url ( keys %RES ) {
-        ( $time, $stat, $vrfy, $hstp, $hsts, $lprb ) = @{ $RES{$url} };
-        my $hr = int( ( $^T - $lprb ) / 3600 + 0.5 );
-        $hr_min = $hr if !defined $hr_min or $hr < $hr_min;
-        $hr_max = $hr if !defined $hr_max or $hr > $hr_max;
-        if   ( $stat eq 'ok' ) { $tab{$hr}++; $s_cnt++; }
-        else                   { $bad{$hr}++; $f_cnt++; }
-    }
-    $res = TR(
-            TH('hours ago')
-          . TH('succ')
-          . TH('fail')
-          . TH sprintf( '%s %s, %s %s',
-            $s_cnt, GRN('successful'), $f_cnt, RED('failed') )
-    );
-    my $max = 0;
-    for my $x ( keys %tab ) {
-        my $tot = $tab{$x} + ( $bad{$x} || 0 );
-        $max = $tot if $max < $tot;
-    }
-    return "<BLOCKQUOTE>\nnothing yet\n</BLOCKQUOTE>\n" unless $max;
-    for my $hr ( $hr_min .. $hr_max ) {
-        my $x = $tab{$hr} || 0;
-        my $y = $bad{$hr} || 0;
-        my $n = int( $x / $max * $HIST );
-        my $b = int( $y / $max * $HIST );
-        $res .= TR(
-                TDr($hr)
-              . TDr($x)
-              . TDr($y)
-              . TD(
-                  ( $n ? img_sf_cnt( 's', $n ) : '' )
-                . ( $b ? img_sf_cnt( 'f', $b ) : '' )
-                  . ( ( $n + $b ) ? '' : '&nbsp;' )
+# Thanks to Klaus Heinz <heinz@NetBSD.org> for sugestions ao htm_head ;
+# Peter Pöml for MirrorBrain support ; Jeremy Olexa, Karl Berry, Roland
+# Pelzer for suggestions regarding rsync support.
+
+use strict ;
+
+our $PRG = 'mirmon' ;
+our $VER = "2.3" ;
+
+our $DEF_TIMEOUT = 300 ;
+our $HIST        = 14 ;
+our $TIM_PAT     = '^(\d+)([smhd])$' ;
+our %APA_TYPES   = () ; for ( qw(backup ftp http) ) { $APA_TYPES { $_ } ++ ; }
+our %GET_OPTS    = () ; for ( qw(all update) )      { $GET_OPTS  { $_ } ++ ; }
+our $HIST_DELTA  = 24 * 60 * 60 ;
+our $APRX_DELTA  = 60 ;
+our $HOME        = 'http://www.cs.uu.nl/people/henkp/mirmon/' ;
+
+package Base ; #####################################################
+
+use base 'Exporter' ;
+
+our ( @ISA, @EXPORT ) ;
+BEGIN
+  { @ISA = qw(Exporter) ;
+    @EXPORT =
+      qw(aprx_eq aprx_ge aprx_le aprx_gt aprx_lt
+         URL NAM SMA BLD NSS TAB BQ TR TH TD TDr RED GRN H1 H2 H3
+         s4tim pr_interval pr_diff
+        ) ;
+  }
+
+sub Version { "$PRG version $VER" ; }
+sub version { "$PRG-$VER" ; }
+sub DEF_TIMEOUT { $DEF_TIMEOUT ; }
+sub is_get_opt  { my $opt = shift ; exists $GET_OPTS { $opt } ; }
+
+sub getset
+  { my $self = shift ;
+    my $attr = shift ;
+    if ( @_ ) { $self -> { $attr } = shift ; }
+    die "no attr '$attr'" unless exists $self -> { $attr } ;
+    $self -> { $attr } ;
+  }
+
+sub mk_method
+  { my $self = shift ;
+    my $attr = shift ;
+    sprintf 'sub %s { my $self = shift ; $self -> getset ( "%s",  @_ ) ; }'
+      , $attr, $attr ;
+  }
+
+sub mk_methods
+  { my $self = shift ;
+    join "\n", map { Base -> mk_method ( $_ ) ; } @_ ;
+  }
+
+sub aprx_eq { my ( $t1, $t2 ) = @_ ; abs ( $t1 - $t2 ) < $APRX_DELTA ; }
+sub aprx_ge { my ( $t1, $t2 ) = @_ ; $t1 > $t2 or      aprx_eq $t1, $t2 ; }
+sub aprx_le { my ( $t1, $t2 ) = @_ ; $t1 < $t2 or      aprx_eq $t1, $t2 ; }
+sub aprx_gt { my ( $t1, $t2 ) = @_ ; $t1 > $t2 and not aprx_eq $t1, $t2 ; }
+sub aprx_lt { my ( $t1, $t2 ) = @_ ; $t1 < $t2 and not aprx_eq $t1, $t2 ; }
+
+sub URL { sprintf '<A HREF="%s">%s</A>', $_[0], $_[1] ; }
+sub NAM { sprintf '<A NAME="%s">%s</A>', $_[0], $_[1] ; }
+sub SMA { sprintf "<FONT SIZE=\"-1\">%s</FONT>", $_[0] ; }
+sub BLD { sprintf "<B>%s</B>", $_[0] ; }
+sub NSS { sprintf SMA('%s&nbsp;site%s'), $_[0], ( $_[0] == 1 ? '' : 's' ) ; }
+sub TAB { sprintf "<TABLE BORDER=2 CELLPADDING=3>%s</TABLE>", $_[0] ; }
+sub BQ  { sprintf "<BLOCKQUOTE>\n%s\n</BLOCKQUOTE>\n", $_[0] ; }
+sub TR  { sprintf "<TR>%s</TR>\n", $_[0] ; }
+sub TH  { sprintf "<TH>%s</TH>\n", $_[0] ; }
+sub TD  { sprintf "<TD>%s</TD>\n", $_[0] ; }
+sub H1  { sprintf "<H1>%s</H1>\n", $_[0] ; }
+sub H2  { sprintf "<H2>%s</H2>\n", $_[0] ; }
+sub H3  { sprintf "<H3>%s</H3>\n", $_[0] ; }
+sub TDr { sprintf "<TD ALIGN=\"RIGHT\">%s</TD>\n", $_[0] ; }
+sub RED { sprintf "<FONT COLOR=\"RED\">%s</FONT>", $_[0] ; }
+sub GRN { sprintf '<FONT COLOR="GREEN">%s</FONT>', $_[0] ; }
+
+sub s4tim
+  { my $tim = shift ;
+    my %tab = ( 's' => 1, 'm' => 60, 'h' => 60 * 60, 'd' => 60 * 60 * 24 ) ;
+    die "wrong time '$tim'" unless $tim =~ /$TIM_PAT/o ;
+    my $m = $1 ; my $u = $2 ;
+    return $m * $tab { $u } ;
+  }
+
+sub pr_interval
+  { my $s = shift ;
+    my ( $magn, $unit ) ;
+    my $mins  = $s / 60          ; my $m = int ( $mins + 0.5 ) ;
+    my $hours = $s / ( 60 * 60 ) ; my $h = int ( $hours + 0.5 ) ;
+
+    if ( $s < 50 )
+      { $magn = $s ; $unit = 'second' ; }
+    elsif ( $m < 50 )
+      { $magn = $m ; $unit = 'minute' ; }
+    elsif ( $h < 36 )
+      { $magn = $h ; $unit = 'hour' ; }
+    else
+      { $magn = sprintf "%.1f", $hours / 24 ; $unit = 'day' ; }
+
+    $unit .= 's' unless $magn == 1 ;
+
+    return "$magn $unit" ;
+  }
+
+sub pr_diff
+  { my $time = shift ;
+    my $max  = shift ;
+    my $res ;
+
+    if ( $time == $^T )
+      { $res = BLD 'renewed' ; }
+    else
+      { $res = pr_interval $^T - $time ;
+        $res = BLD RED $res if aprx_lt $time, $max ;
+      }
+    return $res ;
+  }
+
+sub exp_date
+  { my @day = qw(Sun Mon Tue Wed Thu Fri Sat) ;
+    my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) ;
+    my @gmt = gmtime time + 3600 ;
+    sprintf "%s, %02d %s %4d %02d:%02d:%02d GMT"
+      , $day [ $gmt [ 6 ] ]
+      , $gmt [ 3 ]
+      , $mon [ $gmt [ 4 ] ]
+      , $gmt [ 5 ] + 1900
+      , @gmt [ 2, 1, 0 ]
+      ;
+  }
+
+sub htmlquote
+  { my $x = shift ;
+    $x =~ s/&/&amp;/g ;
+    $x =~ s/</&lt;/g ;
+    $x =~ s/>/&gt;/g ;
+    return $x ;
+  }
+
+package Mirmon ; ###################################################
+
+BEGIN { use base 'Base' ; Base -> import () ; }
+
+use IO::Select ;
+use Net::hostent ;
+
+  { my %opt = ( v => 0 , d => 0 , q => 0 ) ;
+    sub _opt
+      { my ( $key, $val ) = @_ ;
+        my $res ;
+        unless ( exists $opt { $key } )
+          { warn "unknown Mirmon option '$key'\n" ; }
+        else
+          { $res = $opt { $key } ;
+            $opt { $key } = $val if defined $val ;
+          }
+        $res ;
+      }
+  }
+
+sub verbose { _opt ( 'v', shift ) ; }
+sub quiet   { _opt ( 'q', shift ) ; }
+sub debug   { _opt ( 'd', shift ) ; }
+
+eval Base -> mk_methods ( qw(conf state regions) ) ;
+
+sub config_list
+  { my $self = shift ;
+    my $home = ( getpwuid $< ) [ 7 ] or die "can get homedir '$<' ($!)" ;
+    ( 'mirmon.conf', "$home/.mirmon.conf", '/etc/mirmon.conf' ) ;
+  }
+
+sub new
+  { my $self = shift ;
+    my $path = shift ;
+    my $res  = bless {}, $self ;
+    $res -> get_config ( $path ) ;
+    $res -> get_state ;
+    $res -> get_regions ;
+    $res ;
+  }
+
+sub find_config
+  { my $self = shift ;
+    my $arg = shift ;
+    my @LIST = $arg ? ( $arg ) : Mirmon -> config_list ;
+    for my $conf ( @LIST ) { return $conf if -f $conf ; }
+    die sprintf "can't find a config file :\n  %s\n" , join "\n  ", @LIST ;
+  }
+
+sub get_config
+  { my $self = shift ;
+    my $path = shift ;
+    my $file = $self -> find_config ( $path ) ; # or die
+    $self -> conf ( Mirmon::Conf -> new ( $file ) ) ;
+  }
+
+sub get_state
+  { my $self = shift ;
+    my $conf = $self -> conf ;
+    my $state = $conf -> state ;
+    my $res = {} ;
+    open STATE, $state or die "can't open $state ($!)" ;
+    for my $line ( <STATE> )
+      { chop $line ;
+        my $mirror = Mirmon::Mirror -> new ( $self, $line ) ;
+        $res -> { $mirror -> url } = $mirror ;
+      }
+    close STATE ;
+
+    my $mlist = $conf -> mirror_list ;
+    my $style = $conf -> list_style ;
+    my %in_list = () ;
+    open MLIST, $mlist or die "can't open $mlist ($!)" ;
+    for my $line ( <MLIST> )
+      { chop $line ;
+        next if $line =~ /^#/ ;
+        next if $line =~ /^\s*$/ ;
+        my ( $reg, $url, $mail ) ;
+        if ( $style eq 'plain' )
+          { ( $reg, $url, $mail ) = split ' ', $line ; }
+        elsif ( $style eq 'apache' )
+          { my $apache_type ;
+            ( $apache_type, $reg, $url, $mail ) = split ' ', $line ;
+            unless (  defined $APA_TYPES { $apache_type } )
+              { print "*** strange type in $url ($apache_type)\n"
+                  unless Mirmon::quiet ;
+                next ;
+              }
+          }
+
+        if ( $conf -> add_slash and $url !~ m!/$! )
+          { print "*** appended '/' to $url\n" unless Mirmon::quiet ;
+            $url .= '/' ;
+          }
+
+        $in_list { $url } ++ ;
+
+        unless ( exists $res -> { $url } )
+          { printf "*** added to list %s\n", $url unless Mirmon::quiet ;
+            $res -> { $url } = Mirmon::Mirror -> init ( $self, $url ) ;
+          }
+        my $mirror = $res -> { $url } ;
+        $mirror -> region ( $reg ) ;
+        $mirror -> mail ( $mail || '' ) ;
+      }
+    close MLIST ;
+
+    for my $url ( sort keys %$res )
+      { # printf "%s\n", $res -> { $url } -> state ;
+        unless ( exists $in_list { $url } )
+          { printf "*** removed from list %s\n", $url unless Mirmon::quiet ;
+            delete $res -> { $url } ;
+          }
+      }
+    $self -> state ( $res ) ;
+  }
+
+sub put_state
+  { my $self  = shift ;
+    my $state = $self -> state ;
+    my $file  = $self -> conf -> state ;
+    my $TMP = "$file.tmp" ;
+    open TMP, ">$TMP" or die "can't write '$TMP' ($!)" ;
+    for my $url ( sort keys %$state )
+      { printf TMP "%s\n", $state -> { $url } -> state
+          or die "can't print $url to $TMP ($!)" ;
+      }
+    close TMP ;
+
+    if ( -z $TMP )
+      { warn "wrote empty state file; keeping previous version" ; }
+    else
+      { rename $TMP, $file or die "can't rename '$TMP', '$file' ($!)" ; }
+  }
+
+sub get_regions
+  { my $self = shift ;
+    my $file =  $self -> conf -> countries ;
+    open REGS, $file or die "can't open countries '$file' ($!)" ;
+    while ( <REGS> )
+      { chop ;
+        next if /^#/ ;
+        my ( $code, $dash, $reg ) = split ' ', $_, 3 ;
+        $self -> { regions } { lc $code } = lc $reg ;
+      }
+    close REGS ;
+  }
+
+sub get_dates
+  { my $self  = shift ;
+    my $get   = shift ;
+    my $state = $self -> state ;
+    my $conf = $self -> conf ;
+    my $CMD  = $conf -> probe ;
+    my $PAR  = $conf -> max_probes ;
+    my %m4h  = () ;
+    my @QUE  = () ;
+    my @NOQ  = () ;
+    my $GET = IO::Select -> new () ;
+
+    my $cnt = 0 ;
+    my $nok = 0 ;
+
+    for my $url ( sort keys %$state )
+      { my $mirror = $state -> { $url } ;
+        $cnt ++ if $mirror -> last_status eq 'ok' ;
+        if ( $get eq 'all' or $mirror -> last_probe eq 'undef' )
+          { push @QUE, $mirror ; }
+        elsif ( $get eq 'update' )
+          { my $stat = $mirror -> last_status ;
+            my $vrfy = $mirror -> last_ok_probe ;
+            my $lprb = $mirror -> last_probe ;
+            if ( aprx_le $lprb, $^T - s4tim $conf -> min_poll )
+              { if ( $stat ne 'ok' )
+                  { push @QUE, $mirror ; $nok ++ ; }
+                elsif ( aprx_le $vrfy, $^T - s4tim $conf -> max_poll )
+                  { push @QUE, $mirror ; }
+                else
+                  { push @NOQ, $mirror ; }
+              }
+          }
+        else
+          { die "unknown opt_get '$get'" ; }
+      }
+
+    if ( Mirmon::verbose )
+      { my $que = scalar @QUE ; my $noq = scalar @NOQ ;
+        printf "ok mirrors %d, queued %d, not queued %d, ok %d, nok %d\n"
+          , $cnt, $que, $noq, $que - $nok, $nok
+      }
+
+    if ( $conf -> randomize )
+      { my $hrs  = int ( ( s4tim $conf -> max_poll ) / 60 / 60 + 0.5 ) ;
+        my $avg  = int ( $cnt / $hrs + 0.5 ) ;
+        my $prc  = ( scalar keys %$state ) / 50 ;
+        my $flr  = int $prc ;
+        my $extras = $flr + ( rand 1 < ( $prc - $flr ) ) ;
+        my $picked = 0 ;
+
+        while ( @QUE < $avg + $nok and @NOQ and $picked < $extras )
+          { my $idx = int rand @NOQ ;
+            push @QUE, $NOQ [ $idx ] ;
+            $NOQ [ $idx ] = $NOQ [ $#NOQ ] ;
+            pop @NOQ ;
+            $picked ++ ;
+          }
+
+        printf "avg mirrors/hr %d, max extras %d, picked %d ; queued %s\n"
+          , $avg, $extras, $picked, scalar @QUE if Mirmon::verbose ;
+      }
+
+    while ( @QUE )
+      { my $started = 0 ;
+        while ( $GET -> count () < $PAR and @QUE )
+          { my $mirror = shift @QUE ;
+            if ( gethost $mirror -> site )
+              { my $handle = $mirror -> start_probe ;
+                $m4h { $handle } = $mirror ;
+                $GET -> add ( $handle ) ;
+                $started ++ ;
+              }
+            else
+              { $mirror -> update ( 0, 'site_not_found', undef ) ; }
+          }
+
+        my @can_read = $GET -> can_read ( 0 ) ;
+
+        printf "queue %d, started %d, probes %d, can_read %d\n",
+          scalar @QUE, $started, $GET -> count (), scalar @can_read
+            if Mirmon::verbose ;
+
+        for my $handle ( @can_read )
+          { # order is important ; wget's hang if/when actions are reversed
+            $GET -> remove ( $handle ) ;
+            $m4h { $handle } -> finish_probe ( $handle ) ;
+          }
+
+        sleep 1 ;
+      }
+
+    my $stop = time + $conf -> timeout + 10 ;
+
+    while ( $GET -> count () and time < $stop )
+      { my @can_read = $GET -> can_read ( 0 ) ;
+
+        printf "wait %2d, probes %d, can_read %d\n",
+          $stop - scalar time, $GET -> count (), scalar @can_read
+            if Mirmon::verbose ;
+
+        for my $handle ( @can_read )
+          { $GET -> remove ( $handle ) ;
+            $m4h { $handle } -> finish_probe ( $handle ) ;
+          }
+
+        sleep 10 ;
+      }
+
+    for my $handle ( $GET -> handles () )
+      { $m4h { $handle } -> update ( 0, 'hangs', undef ) ; }
+  }
+
+sub img_sf_cnt
+  { my $self = shift ;
+    my $prf  = shift ;
+    my $cnt  = shift ;
+    my $res ;
+    if ( $prf eq 'x' )
+      { sprintf
+          ( '<IMG BORDER=1 SRC="%s/bar.gif" ALT="">'
+          , $self -> conf -> icons
+          ) x $cnt ;
+      }
+    else
+     { sprintf '<IMG BORDER=1 SRC="%s/mm%s%02d.gif" ALT="">'
+         , $self -> conf -> icons, $prf, $cnt ;
+     }
+  }
+
+sub img_sf { my $self = shift ; $self -> img_sf_cnt ( $_[0], 1 ) ; }
+
+sub show_hist
+  { my $self = shift ;
+    my $hst = shift ;
+    if ( $hst =~ /-(.*)$/ ) { $hst = $1 ; }
+    return '' unless $hst =~ m/^[sbfzx]+$/ ;
+    if ( length $hst == $HIST and $hst =~ /^(s*b)s*$/ )
+      { return $self -> img_sf_cnt ( 'sb',  length $1 ) ; }
+    elsif ( length $hst == $HIST and $hst =~ /^(s*f)s*$/ )
+      { return $self -> img_sf_cnt ( 'sf',  length $1 ) ; }
+    elsif ( length $hst == $HIST and $hst =~ /^(s*b)fs*$/ )
+      { return $self -> img_sf_cnt ( 'sbf', length $1 ) ; }
+    my $res = '' ;
+    my $cnt = 1 ;
+    my $prf = substr $hst, 0, 1 ;
+    $hst = substr $hst, 1 ;
+    while ( $hst ne '' )
+      { if ( substr ( $prf, 0, 1 ) eq substr ( $hst, 0, 1 ) )
+          { $cnt ++ ;
+            $hst = substr $hst, 1 ;
+          }
+        else
+          { $res .= $self -> img_sf_cnt ( $prf, $cnt ) ;
+            $prf = substr $hst, 0, 1 ;
+            $hst = substr $hst, 1 ;
+            $cnt = 1 ;
+          }
+      }
+    $res .= $self -> img_sf_cnt ( $prf, $cnt ) if $cnt ;
+    $res ;
+  }
+
+sub gen_histogram_probes
+  { my $self = shift ;
+    my $state = $self -> state ;
+    my %tab = () ;
+    my %bad = () ;
+    my $res = '' ;
+    my $s_cnt = 0 ;
+    my $f_cnt = 0 ;
+    my $hr_min ;
+    my $hr_max ;
+    for my $url ( keys %$state )
+      { my $mirror = $state -> { $url } ;
+        my $lprb = $mirror -> last_probe ;
+        my $stat = $mirror -> last_status ;
+        next if $lprb eq 'undef' ;
+        my $hr = int ( ( $^T - $lprb ) / 3600 + 0.5 ) ;
+        $hr_min = $hr if ! defined $hr_min or $hr < $hr_min ;
+        $hr_max = $hr if ! defined $hr_max or $hr > $hr_max ;
+        if ( $stat eq 'ok' )
+          { $tab { $hr } ++ ; $s_cnt ++ ; }
+        else
+          { $bad { $hr } ++ ; $f_cnt ++ ; }
+      }
+    return BQ 'nothing yet' unless scalar keys %tab ;
+
+    $res = TR
+      ( TH ( 'hours ago' )
+      . TH ( 'succ' )
+      . TH ( 'fail' )
+      . TH sprintf
+          ( '%s %s, %s %s'
+          , $s_cnt , GRN ( 'successful' )
+          , $f_cnt , RED ( 'failed' )
+          )
+      ) ;
+
+    my $max = 0 ;
+    for my $x ( keys %tab )
+      { my $tot = $tab { $x } + ( $bad { $x } || 0 ) ;
+        $max = $tot if $max < $tot ;
+      }
+
+    return BQ "nothing yet" unless $max ;
+
+    for my $hr ( $hr_min .. $hr_max )
+      { my $x = $tab { $hr } || 0 ;
+        my $y = $bad { $hr } || 0 ;
+        my $n = int ( $x / $max * $HIST ) ;
+        my $b = int ( $y / $max * $HIST ) ;
+        $res .= TR
+          ( TDr ( $hr )
+          . TDr ( $x )
+          . TDr ( $y )
+          . TD
+              ( ( $n ? $self -> img_sf_cnt ( 's', $n ) : '' )
+              . ( $b ? $self -> img_sf_cnt ( 'f', $b ) : '' )
+              . ( ( $n + $b ) ? '' : '&nbsp;' )
               )
-        );
-    }
-    return "<BLOCKQUOTE>\n" . TAB($res) . "</BLOCKQUOTE>\n";
-}
-sub gen_histogram {
-    my $MAX_H = max_age1;
-    my $MAX_h = 1 + (
-        ( 20 * 3600 <= $MAX_H and $MAX_H <= 36 * 3600 )
-        ? int( $MAX_H / 3600 )
-        : 25
-    );
-    my $MAX_O = max_age2;
-    my $MAX_o = int( $MAX_O / 3600 + 0.5 );
-    my $H     = 18;
-    my %W     = ( 'old' => 1, 'ded' => 1, 'bad' => 1 );
-    my %Wmx   = ( 'old' => 5, 'ded' => 3, 'bad' => 3 );
-    my %tab;
-    my %hst;
-    my $res;
-    for ( my $x = 0 ; $x < $MAX_h ; $x++ ) { $tab{$x} = 0; }
-    $tab{old} = 0;
-    $tab{ded} = 0;
-    $tab{bad} = 0;
-    for my $url ( keys %RES ) {
-        my $time = $RES{$url}[0];
-        if ( $time =~ /^\d+$/ ) {
-            my $s = $^T - $time;
-            my $hr = int( $s / $MAX_H * ( $MAX_h - 1 ) + 0.5 );
-            if    ( $s <= $MAX_H ) { $tab{$hr}++; }
-            elsif ( $s <= $MAX_O ) { $tab{old}++; }
-            else                   { $tab{ded}++; }
-        }
-        else { $tab{bad}++; }
-    }
-    my $max = 0;
-    for ( grep !exists $Wmx{$_}, keys %tab ) {
-        $max = $tab{$_} if $tab{$_} > $max;
-    }
-    my %bad;
-    for my $aux ( keys %Wmx ) {
-        $bad{$aux} = $tab{$aux};
-        if ( $bad{$aux} > $max ) {
-            $W{$aux} = $Wmx{$aux};
-            my $d = int( $bad{$aux} / $W{$aux} );
-            for ( my $i = 1 ; $i < $W{$aux} ; $i++ ) {
-                $tab{ $aux . $i } = $d;
-                if ( $bad{$aux} % $Wmx{$aux} > $i ) {
-                    $tab{ $aux . $i }++;
-                    $tab{$aux}--;
-                }
-            }
-            $tab{$aux} -= ( $W{$aux} - 1 ) * $d;
-            $max = $tab{$aux} if $max < $tab{$aux};
-        }
-    }
-    #   if ( $opt{v} )
-    #     { for my $hr ( keys %tab )
-    #         { printf "tab '%s' = '%s'\n", $hr, $tab { $hr } ; }
-    #     }
-    return 'nothing yet' unless $max;
-    $H = $max if 8 <= $max and $max <= 26;
-    for ( keys %tab ) { $hst{$_} = int( $H * $tab{$_} / $max + 0.5 ); }
-    my @keys = sort { $a <=> $b } grep /^\d+$/, keys %hst;
-    my $tab_hr = 0;
-    for my $hr (@keys) { $tab_hr += $tab{$hr}; }
-    push @keys, grep ( m/^old/, sort keys %tab ),
-      grep ( m/^ded/, sort keys %tab ), grep ( m/^bad/, sort keys %tab );
-    for ( my $h = $H ; $h > 0 ; $h-- ) {
-        $res .= "<TR>\n";
-        $res .= sprintf "<TH ROWSPAN=3 VALIGN=\"TOP\">&uarr;</TH>\n"
-          if $h == $H;
-        $res .= sprintf '<TD ROWSPAN=%d ALIGN="CENTER">%s</TD>' . "\n", $H - 6,
-          NSS($max)
-          if $h == $H - 3;
-        $res .= sprintf "<TH ROWSPAN=3 VALIGN=\"BOTTOM\">&darr;</TH>\n"
-          if $h == 3;
-        for my $x (@keys) {
-            $res .= sprintf "<TH>%s</TH>\n",
-              (
-                ( $hst{$x} >= $h )
-                ? img_sf(
-                    $x =~ /^\d+$/
-                    ? 's'
-                    : ( $x =~ /^old/ ? 'b' : ( $x =~ /^ded/ ? 'f' : 'z' ) )
-                  )
-                : (
-                    ( $h == 1 and $hst{$x} == 0 )
-                    ? sprintf( '<IMG SRC="%s/bar.gif" ALT="" BORDER=0>',
-                        $CNF{icons} )
-                    : ''
-                )
-              );
-        }
-        $res .= "</TR>\n";
-    }
-    my $HR = '<HR SIZE=2 WIDTH="95%%" NOSHADE>';
-    $res .= "<TR>\n";
-    $res .= sprintf "<TD COLSPAN=%d>$HR</TD>\n", 1;
-    $res .= sprintf "<TD COLSPAN=%d>$HR</TD>\n", $MAX_h;
-    $res .= sprintf "<TD COLSPAN=%d>$HR</TD>\n", $W{old};
-    $res .= sprintf "<TD COLSPAN=%d>$HR</TD>\n", $W{ded};
-    $res .= sprintf "<TD COLSPAN=%d>$HR</TD>\n", $W{bad};
-    $res .= "</TR>\n";
-    $res .= "<TR>\n";
-    $res .= '<TD ALIGN="CENTER">&nbsp;<B>age</B>&nbsp;&rarr;&nbsp;</TD>';
-    $res .= "<TH>|</TH>\n";
-    $res .=
-      sprintf( '<TD COLSPAN=%d ALIGN="CENTER">'
-          . '&larr;&nbsp; 0 &le; <B>age</B> &le; %s &nbsp;&rarr;'
-          . "</TD>\n",
-        $MAX_h - 2, pr_interval($MAX_H) );
-    $res .= "<TH>|</TH>\n";
-    $res .= sprintf(
-        '<TD ALIGN="CENTER" COLSPAN=%d>'
-          . '&nbsp;%sh&nbsp;&lt;&nbsp;%s&nbsp;&le;&nbsp;%sh&nbsp;'
-          . "</TD>\n",
-        $W{old}, int( $MAX_H / 60 / 60 ),
-        BLD('age'), $MAX_o
-    );
-    $res .= sprintf(
-        '<TD ALIGN="CENTER" COLSPAN=%d>'
-          . '&nbsp;<FONT COLOR="RED">old</FONT>&nbsp;'
-          . "</TD>\n",
-        $W{ded}
-    );
-    $res .= sprintf(
-        '<TD ALIGN="CENTER" COLSPAN=%d>'
-          . '&nbsp;<FONT COLOR="RED">bad</FONT>&nbsp;'
-          . "</TD>\n",
-        $W{bad}
-    );
-    $res .= "</TR>\n";
-    my $FRMT = '<TD ALIGN="CENTER" COLSPAN=%d>&nbsp;%s&nbsp;</TD>';
-    $res .= "<TR>\n";
-    $res .= sprintf "$FRMT\n", 1, NSS scalar keys %RES;
-    $res .= "<TH>|</TH>\n";
-    $res .= sprintf "$FRMT\n", $MAX_h - 2, NSS $tab_hr ;
-    $res .= "<TH>|</TH>\n";
-    $res .= sprintf "$FRMT\n", $W{old}, NSS $bad {old};
-    $res .= sprintf "$FRMT\n", $W{ded}, NSS $bad {ded};
-    $res .= sprintf "$FRMT\n", $W{bad}, NSS $bad {bad};
-    $res .= "</TR>\n";
-    $res = "<TABLE CELLSPACING=0 CELLPADDING=1 BORDER=0>\n$res\n</TABLE>\n";
-    $res = sprintf "<TABLE CELLPADDING=5 BORDER=4>%s</TABLE>\n",
-      "<TR><TH>\n$res\n</TH></TR>";
-    if ( $max == $H ) {
-        $res .= sprintf "<BR>units %s %s %s %s represent one mirror site.\n",
-          img_sf('s'), img_sf('f'), img_sf('b'), img_sf('z');
-    }
-    else {
-        $res .=
-          sprintf "<BR>each %s %s %s %s unit represents %s mirror sites.\n",
-          img_sf('s'), img_sf('f'), img_sf('b'), img_sf('z'),
-          sprintf( "%.1f", $max / $H );
-    }
-    return $res;
-}
-sub revdom { my $dom = shift; join '.', reverse split /\./, $dom; }
-sub by_type_site {
-    my $a_type = $a->[0];
-    my $b_type = $b->[0];
-    my $a_site = $a->[2];
-    my $b_site = $b->[2];
-    ( revdom $a_site ) cmp( revdom $b_site )
-      or $a_type cmp $b_type;
-}
-sub by_CCS { ( $CCS{$a} || $a ) cmp( $CCS{$b} || $b ); }
-sub legend;
-sub gen_page {
-    my $PPP = shift;
-    my $TMP = "$PPP.tmp";
-    my %tab;
-    my $refs;
-    for my $url ( keys %LST ) {
-        my ( $type, $site, $reg ) = @{ $LST{$url} };
-        push @{ $tab{$reg} }, [ $type, $url, $site ];
-    }
-    my $bad = 0;
-    my $old = 0;
-    my $unr = 0;
-    my %stats;
-    my @stats;
-    my $ok = 0;
-    for my $url ( keys %RES ) {
-        my ( $time, $stat, $vrfy ) = @{ $RES{$url} };
-        if   ( $stat eq 'ok' ) { $ok++; }
-        else                   { $stats{$stat}++; }
-        if    ( $time eq 'undef' )        { $bad++; }
-        elsif ( 'f'   eq age_code $time ) { $old++; }
-        if ( $vrfy eq 'undef' or aprx_lt $vrfy, $^T - max_vrfy ) { $unr++; }
-    }
-    my $STAT =
-      sprintf "%d bad -- %d older than %s -- %s unreachable for more than %s",
-      $bad, $old, pr_interval(max_age2), $unr, pr_interval(max_vrfy);
-    my $PROB = 'last probes : ';
-    push @stats, "$ok were ok" if $ok;
-    for my $stat ( sort keys %stats ) {
-        push @stats, sprintf "%s had %s", $stats{$stat}, RED $stat ;
-    }
-    $PROB .= join ', ', @stats;
-    for my $reg ( sort keys %tab ) {
-        $refs .= sprintf "&nbsp;%s&nbsp;\n", url "#$reg",
-          "<FONT SIZE=\"+1\">$reg</FONT>";
-    }
-    my $COLS = 5;
-    my $LOGO =
-      $CNF{project_logo}
-      ? url(
-        $CNF{project_url},
-        sprintf(
-            '<IMG SRC="%s" ALT="%s" ALIGN="RIGHT" BORDER=0>',
-            $CNF{project_logo}, $CNF{project_name}
-        )
-      )
-      : '';
-    my $HTOP = $CNF{htm_top}  ? $CNF{htm_top} . "\n"  : '';
-    my $FOOT = $CNF{htm_foot} ? $CNF{htm_foot} . "\n" : '';
-    my $HEAD = $CNF{htm_head} ? $CNF{htm_head} . "\n" : '';
-    my $TITL = url $CNF{project_url}, $CNF{project_name};
-    my $EXPD = exp_date;
-    open PPP, ">$TMP" or Error "can't write $TMP ($!)";
-    print PPP '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01'
-      . ' Transitional//EN"' . '>';
-    print PPP "<HTML>\n";
-    print PPP "<HEAD>\n";
-    print PPP "<TITLE>the status of $CNF{project_name} mirrors</TITLE>\n";
-    printf PPP "%s\n", '<meta HTTP-EQUIV="content-type" '
-      . 'CONTENT="text/html; charset=ISO-8859-1">';
-    print PPP "<META HTTP-EQUIV=\"refresh\" CONTENT=\"3600\">\n";
-    print PPP "<META HTTP-EQUIV=\"Expires\" CONTENT=\"$EXPD\">\n";
-    print PPP $HEAD if $HEAD;
-    print PPP "</HEAD>\n";
-    print PPP "<BODY BGCOLOR=\"#FFFFFF\">\n";
-    print PPP $LOGO;
-    print PPP "<H2>the status of $TITL mirrors</H2>\n";
-    print PPP "<TABLE BORDER=0 CELLPADDING=2>\n";
-    printf PPP "<TR><TD>date</TD><TD>:</TD><TD>%s (GMT)</TD></TR>\n",
-      scalar gmtime $^T;
-    printf PPP "<TR><TD>last&nbsp;check</TD><TD>:</TD><TD>%s (GMT)</TD></TR>\n",
-      scalar gmtime( $opt{get} ? $^T : ( stat $CNF{state} )[9] );
-    print PPP "</TABLE>\n";
-    printf PPP "<P>%s</P>\n", $HTOP if $HTOP;
-    if ( $CNF{put_histo} eq 'top' ) {
-        print PPP "<H2>age histogram</H2>\n";
-        print PPP "<BLOCKQUOTE>\n";
-        print PPP gen_histogram;
-        print PPP "</BLOCKQUOTE>\n";
-    }
-    print PPP "<H2>regions</H2>\n";
-    print PPP "<BLOCKQUOTE>\n";
-    print PPP "<CENTER>\n";
-    printf PPP "%s\n", $refs;
-    print PPP "</CENTER>\n";
-    print PPP "</BLOCKQUOTE>\n";
-    print PPP "<H2>report</H2>\n";
-    my $attr1 = "COLSPAN=$COLS BGCOLOR=\"LIME\"";
-    my $attr2 = 'BGCOLOR="AQUA"';
-    print PPP "<BLOCKQUOTE>\n";
-    print PPP "<TABLE BORDER=2 CELLPADDING=5>\n";
-    printf PPP "<TR><TH $attr1>%d sites in %d regions</TH></TR>\n",
-      scalar keys %LST, scalar keys %tab;
-    printf PPP "<TR><TH $attr1>%s</TH></TR>\n", $STAT;
-    printf PPP "<TR><TH $attr1>%s</TH></TR>\n", $PROB;
-    print PPP "<TR>\n";
-    printf PPP "  <TH $attr2>%s site -- home</TH>\n", $CNF{project_name};
-    printf PPP "  <TH $attr2>%s</TH>\n",              'type';
-    printf PPP "  <TH $attr2>%s</TH>\n", 'mirror age,<BR>daily stats';
-    printf PPP "  <TH $attr2>%s</TH>\n", 'last probe,<BR>probe stats';
-    printf PPP "  <TH $attr2>%s</TH>\n", 'last stat';
-    print PPP "</TR>\n";
-    for my $reg ( sort by_CCS keys %tab ) {
-        my $itms = $tab{$reg};
-        my $ccs = exists $CCS{$reg} ? $CCS{$reg} : $reg;
-        $ccs = nam $reg,
-          (
-            scalar @{$itms} > 6
-            ? sprintf "%s&nbsp;&nbsp;-&nbsp;&nbsp;%d sites",
-            $ccs,
-            scalar @{$itms}
-            : $ccs
-          );
-        my $attr3 = "COLSPAN=$COLS BGCOLOR=\"YELLOW\"";
-        printf PPP "<TR><TH $attr3>$ccs</TH></TR>\n";
-        for my $itm ( sort by_type_site @{$itms} ) {
-            my ( $type, $url, $site ) = @{$itm};
-            my ( $time, $stat, $hstp, $hsts, $vrfy );
-            my ( $pr_time, $pr_last, $pr_hstp, $pr_hsts );
-            print PPP "<TR>\n";
-            printf PPP "  <TD ALIGN=\"RIGHT\">%s&nbsp;&nbsp;%s</TD>\n"
-              . "  <TD>%s</TD>\n", url( $url, $site ), url( home($url), '@' ),
-              $type;
-            if ( exists $RES{$url} ) {
-                ( $time, $stat, $vrfy, $hstp, $hsts ) = @{ $RES{$url} };
-                $pr_time = $time =~ /^\d+$/
-                  ? diff $time, $^T - max_age2
-                  : '&nbsp;';
-                $pr_last = $vrfy =~ /^\d+$/
-                  ? diff $vrfy, $^T - max_vrfy
-                  : '&nbsp;';
-                $pr_hstp = show_hist $hstp ;
-                $pr_hsts = show_hist_age $hsts, $time;
-            }
-            else {
-                ( $pr_time, $pr_last, $pr_hstp, $pr_hsts, $stat ) =
-                  ( '&nbsp;', '&nbsp;', '', '', '&nbsp;' );
-            }
-            $stat = RED $stat if $stat ne 'ok';
-            printf PPP "  <TD ALIGN=\"RIGHT\">%s<BR>%s</TD>\n", $pr_time,
-              $pr_hsts;
-            printf PPP "  <TD ALIGN=\"RIGHT\">%s<BR>%s</TD>\n", $pr_last,
-              $pr_hstp;
-            printf PPP "  <TD>%s</TD>\n", $stat;
-            print PPP "</TR>\n";
-        }
-    }
-    print PPP "</TABLE>\n";
-    print PPP "</BLOCKQUOTE>\n";
-    if ( $CNF{put_histo} eq 'bottom' ) {
-        print PPP "<H2>age histogram</H2>\n";
-        print PPP "<BLOCKQUOTE>\n";
-        print PPP gen_histogram;
-        print PPP "</BLOCKQUOTE>\n";
-    }
-    print PPP legend;
-    print PPP "<H3>probe results</H3>\n";
-    print PPP gen_histogram_probes;
-    print PPP "<H3>software</H3>\n";
-    print PPP "<BLOCKQUOTE><TABLE><TR>\n";
-    my $MIR_IMG = sprintf '<IMG BORDER=2 ALT="mirmon" SRC="%s/mirmon.gif">',
-      $CNF{icons};
-    print PPP sprintf "<TH><A HREF=\"%s\">%s</A></TH>\n",
-      'http://www.cs.uu.nl/people/henkp/mirmon/', $MIR_IMG;
-    print PPP "<TD>$VER</TD>\n";
-    print PPP "</TR></TABLE></BLOCKQUOTE>\n";
-    print PPP $FOOT;
-    print PPP "</BODY>\n";
-    print PPP "</HTML>";
-    if ( print PPP "\n" ) {
-        close PPP;
-        if ( -z $TMP ) {
-            Warn "wrote empty html file; keeping previous version";
-        }
-        else { rename $TMP, $PPP or Error "can't rename $TMP, $PPP ($!)"; }
-    }
-    else { Error "can't print to $TMP ($!)"; }
-}
-sub legend {
+          ) ;
+      }
+    return BQ TAB $res ;
+  }
+
+sub age_avg
+  { my $self = shift ;
+    my $state = $self -> state ;
+    my @tab = () ;
+    for my $url ( keys %$state )
+      { my $time = $state -> { $url } -> age ;
+        push @tab, $^T - $time if $time =~ /^\d+$/ ;
+      }
+    my $cnt = @tab ;
+
+    return undef if $cnt == 0 ;
+
+    @tab = sort { $a <=> $b } @tab ;
+
+    my $tot = 0 ;
+    for my $age ( @tab ) { $tot += $age ; }
+    my $mean = $tot / $cnt ;
+
+    my $median ;
+    if ( $cnt == 1 )
+      { $median = $tab [ 0 ] ; }
+    elsif ( $cnt % 2 )
+      { my $mid = int ( $#tab / 2 ) ;
+        $median = ( $tab [ $mid ] + $tab [ $mid + 1 ] ) / 2 ;
+      }
+    else
+      { my $mid = int ( $#tab / 2 ) ;
+        $median = $tab [ $mid ] ;
+      }
+
+    if ( @tab < 2 )
+      { return $mean, $median, undef ; }
+
+    my $sum = 0 ;
+    for my $age ( @tab )
+      { $sum += ( $age - $mean ) ** 2 ; }
+    my $stddev = sqrt ( $sum / ( $cnt - 1 ) ) ;
+
+    return $mean, $median, $stddev ;
+  }
+
+sub legend
+  { my $self = shift ;
+    my $conf = $self -> conf ;
+    my $min_sync = $conf -> min_sync ;
+    my $max_sync = $conf -> max_sync ;
+    my $min_poll = $conf -> min_poll ;
+    my $max_poll = $conf -> max_poll ;
+
     return <<LEGENDA ;
 <H3>legend</H3>
+
 <H4><I>project</I> site -- home</H4>
+
 <BLOCKQUOTE>
 <B><I>project</I> site</B> is an url.
 The <B>href</B> is the href for the site in the list of mirrors,
@@ -857,12 +605,16 @@ pointing to the document root of the site. This pointer is
 useful if the <B><I>project</I> site</B> url is invalid,
 possibly because the mirror site moved the archive.
 </BLOCKQUOTE>
+
 <H4>type</H4>
+
 <BLOCKQUOTE>
 Indicates the type (<B>ftp</B> or <B>http</B>) of
 the <B><I>project</I> site</B> and <B>home</B> urls.
 </BLOCKQUOTE>
+
 <H4>mirror age, daily stats</H4>
+
 <BLOCKQUOTE>
 The <B>mirror age</B> is based upon the last successful probe.
 <P>
@@ -880,176 +632,1173 @@ configuration parameters :
   <TH COLSPAN=4>age</TH>
 </TR>
 <TR>
-  <TH COLSPAN=2 BGCOLOR="YELLOW">this project</TH>
-  <TH COLSPAN=2 BGCOLOR="AQUA">in general</TH>
+  <TH COLSPAN=2 BGCOLOR=YELLOW>this project</TH>
+  <TH COLSPAN=2 BGCOLOR=AQUA>in general</TH>
 </TR>
 <TR>
-  <TH BGCOLOR="YELLOW">min</TH>
-  <TH BGCOLOR="YELLOW">max</TH>
-  <TH BGCOLOR="AQUA">min</TH>
-  <TH BGCOLOR="AQUA">max</TH>
+  <TH BGCOLOR=YELLOW>min</TH>
+  <TH BGCOLOR=YELLOW>max</TH>
+  <TH BGCOLOR=AQUA>min</TH>
+  <TH BGCOLOR=AQUA>max</TH>
 </TR>
 <TR>
-  <TH><FONT COLOR="GREEN">fresh</FONT></TH>
-  <TD BGCOLOR="YELLOW" ALIGN="CENTER">0</TD>
-  <TD BGCOLOR="YELLOW" ALIGN="CENTER">
-    @{[$CNF{min_sync}]} + @{[$CNF{max_poll}]}</TD>
-  <TD BGCOLOR="AQUA"   ALIGN="CENTER">0</TD>
-  <TD BGCOLOR="AQUA"   ALIGN="CENTER">min_sync + max_poll</TD>
+  <TH><FONT COLOR=GREEN>fresh</FONT></TH>
+  <TD BGCOLOR=YELLOW ALIGN=CENTER>0</TD>
+  <TD BGCOLOR=YELLOW ALIGN=CENTER>$min_sync + $max_poll</TD>
+  <TD BGCOLOR=AQUA   ALIGN=CENTER>0</TD>
+  <TD BGCOLOR=AQUA   ALIGN=CENTER>min_sync + max_poll</TD>
 </TR>
 <TR>
-  <TH><FONT COLOR="BLUE">oldish</FONT></TH>
-  <TD BGCOLOR="YELLOW" ALIGN="CENTER">
-    @{[$CNF{min_sync}]} + @{[$CNF{max_poll}]}</TD>
-  <TD BGCOLOR="YELLOW" ALIGN="CENTER">
-    @{[$CNF{max_sync}]} + @{[$CNF{max_poll}]}</TD>
-  <TD BGCOLOR="AQUA"   ALIGN="CENTER">min_sync + max_poll</TD>
-  <TD BGCOLOR="AQUA"   ALIGN="CENTER">max_sync + max_poll</TD>
+  <TH><FONT COLOR=BLUE>oldish</FONT></TH>
+  <TD BGCOLOR=YELLOW ALIGN=CENTER>$min_sync + $max_poll</TD>
+  <TD BGCOLOR=YELLOW ALIGN=CENTER>$max_sync + $max_poll</TD>
+  <TD BGCOLOR=AQUA   ALIGN=CENTER>min_sync + max_poll</TD>
+  <TD BGCOLOR=AQUA   ALIGN=CENTER>max_sync + max_poll</TD>
 </TR>
 <TR>
   <TH><FONT COLOR="RED">old</FONT></TH>
-  <TD BGCOLOR="YELLOW" ALIGN="CENTER">
-    @{[$CNF{max_sync}]} + @{[$CNF{max_poll}]}</TD>
-  <TD BGCOLOR="YELLOW" ALIGN="CENTER">&infin;</TD>
-  <TD BGCOLOR="AQUA"   ALIGN="CENTER">max_sync + max_poll</TD>
-  <TD BGCOLOR="AQUA"   ALIGN="CENTER">&infin;</TD>
+  <TD BGCOLOR=YELLOW ALIGN=CENTER>$max_sync + $max_poll</TD>
+  <TD BGCOLOR=YELLOW ALIGN=CENTER>&infin;</TD>
+  <TD BGCOLOR=AQUA   ALIGN=CENTER>max_sync + max_poll</TD>
+  <TD BGCOLOR=AQUA   ALIGN=CENTER>&infin;</TD>
 </TR>
 <TR>
-  <TH><FONT COLOR="BLACK">bad</FONT></TH>
-  <TH COLSPAN=4 BGCOLOR="BLACK">
-    <FONT COLOR="WHITE">the site or mirror tree was never found</FONT></TH>
+  <TH><FONT COLOR=BLACK>bad</FONT></TH>
+  <TH COLSPAN=4 BGCOLOR=BLACK>
+    <FONT COLOR=WHITE>the site or mirror tree was never found</FONT></TH>
 </TR>
 </TABLE>
 </BLOCKQUOTE>
 </BLOCKQUOTE>
+
 <H4>last probe, probe stats</H4>
+
 <BLOCKQUOTE>
 <B>Last probe</B> indicates when the last successful probe was made.
 <B>Probe stats</B> gives the probe history (<I>right</I> is <I>recent</I>).
 A probe is either a
-<FONT COLOR="GREEN"><B>success</B></FONT> or a
-<FONT COLOR="RED"><B>failure</B></FONT>.
+<FONT COLOR=GREEN><B>success</B></FONT> or a
+<FONT COLOR=RED><B>failure</B></FONT>.
 </BLOCKQUOTE>
+
 <H4>last stat</H4>
+
 <BLOCKQUOTE>
 <B>Last stat</B> gives the status of the last probe.
 </BLOCKQUOTE>
+
 LEGENDA
-}
-sub start_date {
-    my $url     = shift;
-    my $CMD     = shift;
-    my $TIMEOUT = $CNF{timeout};
-    my $src     = $HREF{ lc site $url } || $url;
-    $CMD =~ s/%TIMEOUT%/$TIMEOUT/g;
-    $CMD =~ s/%URL%/$src/g;
-    printf "*** SUBSTITUTE site %s\n+  url %s\n+  %s\n", site($url),
-      $HREF{ lc site $url }, $CMD
-      if $HREF{ lc site $url } and $opt{v};
-    my $WGT = new IO::Pipe;
-    my $res = $WGT->reader( split ' ', $CMD );
-    if ($res) {
-        $WGT->blocking(0);
-        $GET->add($WGT);
-        $URL{$WGT} = $url;
-    }
-    else { err $url, 'no pipe'; }
-}
-sub get_date {
-    my $WGT  = shift;
-    my $url  = $URL{$WGT};
-    my $time = undef;
-    $WGT->blocking(1);
-    unless ( $WGT->eof() ) { $time = $WGT->getline(); }
-    $GET->remove($WGT);
-    $WGT->flush;
-    $WGT->close;
-    return err $url, 'no time' unless defined $time;
-    return err $url, "empty" if $time =~ /^\s*$/;
-    $time = ( split ' ', $time )[0];
-    if ( $time !~ /^\d+$/ ) {
-        $time = htmlquote $time ;
-        $time = substr( $time, 0, 15 ) . '..' if length $time > 15;
-          err $url, "'$time'";
-    }
-    else { res $url, $time, 'ok'; }
-}
-sub get_dates {
-    my $CMD = shift;
-    my @QUE;
-    my $PAR     = $CNF{max_probes};
-    my $cnt_LST = scalar keys %LST;
-    for my $url ( sort keys %LST ) {
-        if ( $opt{get} eq 'all' or !exists $OLD{$url} ) { push @QUE, $url; }
-        elsif ( $opt{get} eq 'update' ) {
-            my $stat = $OLD{$url}[1];
-            my $vrfy = $OLD{$url}[2];
-            my $lprb = $OLD{$url}[5];
-            if (
-                (
-                    $lprb eq 'undef'
-                    or aprx_le $lprb,
-                    $^T - tim_to_s $CNF {min_poll}
-                )
-                and (
-                    $stat ne 'ok' or aprx_le $vrfy,
-                    $^T - tim_to_s $CNF {max_poll}
+  }
+
+sub _ths
+  { return '' unless my $ths = shift ;
+    $ths == 1 ? TH '' : "<TH COLSPAN=$ths></TH>\n" ;
+  }
+
+sub gen_histogram
+  { my $self  = shift ;
+    my $where = shift ;
+    my $conf  = $self -> conf ;
+    my $state = $self -> state ;
+
+    return '' if $where ne $conf -> put_histo ;
+
+    my $MAX_H = $conf -> max_age1 ;
+    my $MAX_h = 1 +
+      ( ( 20 * 3600 <= $MAX_H and $MAX_H <= 36 * 3600 )
+      ? int ( $MAX_H / 3600 )
+      : 25
+      ) ;
+    my $MAX_O = $conf -> max_age2 ;
+    my $MAX_o = int ( $MAX_O / 3600 + 0.5 ) ;
+    my $H = 18 ;
+    my %W   = ( 'old' => 1, 'ded' => 1, 'bad' => 1 ) ;
+    my %Wmx = ( 'old' => 5, 'ded' => 3, 'bad' => 3 ) ;
+    my %tab ;
+    my %hst ;
+    my $res ;
+    for ( my $x = 0 ; $x < $MAX_h ; $x ++ ) { $tab { $x } = 0 ; }
+    $tab { old } = 0 ; $tab { ded } = 0 ; $tab { bad } = 0 ;
+    for my $url ( keys %$state )
+      { my $time = $state -> { $url } -> age ;
+        if ( $time =~ /^\d+$/ )
+          { my $s  = $^T - $time ;
+            my $hr = int ( $s / $MAX_H * ( $MAX_h - 1 ) + 0.5 ) ;
+            if    ( $s <= $MAX_H ) { $tab { $hr  } ++ ; }
+            elsif ( $s <= $MAX_O ) { $tab { old } ++ ; }
+            else                   { $tab { ded } ++ ; }
+          }
+        else
+          { $tab { bad } ++ ; }
+      }
+    my $max = 0 ;
+    for ( grep ! exists $Wmx { $_ }, keys %tab )
+      { $max = $tab { $_ } if $tab { $_ } > $max ; }
+
+    my %bad ;
+
+    for my $aux ( keys %Wmx )
+      { $bad { $aux } = $tab { $aux } ;
+        if ( $bad { $aux } > $max )
+          { $W { $aux } = $Wmx { $aux } ;
+            my $d = int ( $bad { $aux } / $W { $aux } ) ;
+            for ( my $i = 1 ; $i < $W { $aux } ; $i++ )
+              { $tab { $aux . $i } = $d ;
+                if ( $bad { $aux } % $Wmx { $aux } > $i )
+                  { $tab { $aux . $i } ++ ;
+                    $tab { $aux } -- ;
+                  }
+              }
+            $tab { $aux } -= ( $W { $aux } - 1 ) * $d ;
+            $max = $tab { $aux } if $max < $tab { $aux } ;
+          }
+      }
+
+#   if ( $opt{v} )
+#     { for my $hr ( keys %tab )
+#         { printf "tab '%s' = '%s'\n", $hr, $tab { $hr } ; }
+#     }
+
+    return 'nothing yet' unless $max ;
+    $H = $max if 8 <= $max and $max <= 26 ;
+    for ( keys %tab )
+      { $hst { $_ } = int ( $H * $tab { $_ } / $max + 0.5 ) ; }
+    my @keys = sort { $a <=> $b } grep /^\d+$/, keys %hst ;
+    my $tab_hr = 0 ;
+    for my $hr ( @keys ) { $tab_hr += $tab { $hr } ; }
+    push @keys
+      , grep ( m/^old/, sort keys %tab )
+      , grep ( m/^ded/, sort keys %tab )
+      , grep ( m/^bad/, sort keys %tab )
+      ;
+    my $img_bar = sprintf '<IMG SRC="%s/bar.gif" ALT="" BORDER=0>'
+      , $conf -> icons ;
+    my %img = ( bar => $img_bar ) ;
+    for my $col ( qw(s b f z) ) { $img { $col } = $self -> img_sf ( $col ) ; }
+
+    for ( my $h = $H ; $h > 0 ; $h -- )
+      { $res .= "<TR>\n" ;
+        $res .= sprintf "<TH ROWSPAN=3 VALIGN=\"TOP\">&uarr;</TH>\n"
+          if $h == $H ;
+        $res .= sprintf '<TD ROWSPAN=%d ALIGN="CENTER">%s</TD>' . "\n"
+          , $H-6, NSS ( $max ) if $h == $H - 3 ;
+        $res .= sprintf "<TH ROWSPAN=3 VALIGN=\"BOTTOM\">&darr;</TH>\n"
+          if $h == 3 ;
+        my $ths = 0 ;
+        for my $x ( @keys )
+          { my $col =
+              ( ( $hst { $x } >= $h )
+              ? ( $x =~ /^\d+$/
+                ? 's'
+                : ( $x =~ /^old/ ? 'b' : ( $x =~ /^ded/ ? 'f' : 'z' ) )
                 )
+              : ( ( $h == 1 and $hst { $x } == 0 ) ? 'bar' : '' )
+              ) ;
+            if ( $col )
+              { $res .= _ths $ths ; $ths = 0 ; $res .= TH $img { $col } ; }
+            else
+              { $ths ++ ; }
+          }
+        $res .= _ths ( $ths ) . "</TR>\n" ;
+      }
+
+    my $HR = '<HR SIZE=2 WIDTH="95%%" NOSHADE>' ;
+
+    $res .= "<TR>\n" ;
+    $res .= sprintf "<TD COLSPAN=%d>$HR</TD>\n", 1 ;
+    $res .= sprintf "<TD COLSPAN=%d>$HR</TD>\n", $MAX_h ;
+    $res .= sprintf "<TD COLSPAN=%d>$HR</TD>\n", $W { old } ;
+    $res .= sprintf "<TD COLSPAN=%d>$HR</TD>\n", $W { ded } ;
+    $res .= sprintf "<TD COLSPAN=%d>$HR</TD>\n", $W { bad } ;
+    $res .= "</TR>\n" ;
+
+    $res .= "<TR>\n" ;
+    $res .= '<TD ALIGN="CENTER">&nbsp;<B>age</B>&nbsp;&rarr;&nbsp;</TD>' ;
+
+    $res .= "<TH>|</TH>\n" ;
+    $res .= sprintf
+      ( '<TD COLSPAN=%d ALIGN="CENTER">'
+      . '&larr;&nbsp; 0 &le; <B>age</B> &le; %s &nbsp;&rarr;'
+      . "</TD>\n"
+      , $MAX_h - 2, pr_interval ( $MAX_H )
+      )
+      ;
+    $res .= "<TH>|</TH>\n" ;
+    $res .= sprintf
+      ( '<TD ALIGN="CENTER" COLSPAN=%d>'
+      . '&nbsp;%sh&nbsp;&lt;&nbsp;%s&nbsp;&le;&nbsp;%sh&nbsp;'
+      . "</TD>\n"
+      , $W { old }, int($MAX_H/60/60) , BLD ( 'age' ), $MAX_o
+      ) ;
+    $res .= sprintf
+      ( '<TD ALIGN="CENTER" COLSPAN=%d>'
+      . '&nbsp;<FONT COLOR="RED">old</FONT>&nbsp;'
+      . "</TD>\n"
+      , $W { ded }
+      ) ;
+    $res .= sprintf
+      ( '<TD ALIGN="CENTER" COLSPAN=%d>'
+      . '&nbsp;<FONT COLOR="RED">bad</FONT>&nbsp;'
+      . "</TD>\n"
+      , $W { bad }
+      ) ;
+    $res .= "</TR>\n" ;
+
+    my $FRMT = '<TD ALIGN="CENTER" COLSPAN=%d>&nbsp;%s&nbsp;</TD>' ;
+
+    $res .= "<TR>\n" ;
+    $res .= sprintf "$FRMT\n", 1,  NSS scalar keys %$state ;
+    $res .= "<TH>|</TH>\n" ;
+    $res .= sprintf "$FRMT\n", $MAX_h - 2, NSS $tab_hr ;
+    $res .= "<TH>|</TH>\n" ;
+    $res .= sprintf "$FRMT\n", $W { old }, NSS $bad { old } ;
+    $res .= sprintf "$FRMT\n", $W { ded }, NSS $bad { ded } ;
+    $res .= sprintf "$FRMT\n", $W { bad }, NSS $bad { bad } ;
+    $res .= "</TR>\n" ;
+
+    $res = "<TABLE CELLSPACING=0 CELLPADDING=1 BORDER=0>\n$res\n</TABLE>\n" ;
+    $res = sprintf "<TABLE CELLPADDING=5 BORDER=4>%s</TABLE>\n"
+       , "<TR><TH>\n$res\n</TH></TR>" ;
+    my $units = join ' '
+      , $self -> img_sf ( 's' ) , $self -> img_sf ( 'b' )
+      , $self -> img_sf ( 'f' ) , $self -> img_sf ( 'z' )
+      ;
+    if ( $max == $H )
+      { $res .= sprintf "<BR>units %s represent one mirror site.\n"
+          , $units ;
+      }
+    else
+      { $res .= sprintf "<BR>each %s unit represents %s mirror sites.\n"
+          , $units, sprintf ( "%.1f", $max / $H ) ;
+      }
+    return H2 ( 'age histogram' ) . BQ $res ;
+  }
+
+sub gen_page
+  { my $self    = shift ;
+    my $get     = shift ;
+    my $VERSION = shift ;
+    my $conf  = $self -> conf ;
+    my $PPP   = $conf -> web_page ;
+    my $state = $self -> state ;
+    my $CCS   = $self -> regions ;
+    my $TMP = "$PPP.tmp" ;
+    my %tab ;
+    my $refs ;
+
+    for my $url ( keys %$state )
+      { my $mirror = $state -> { $url } ;
+        my $reg = $mirror -> region ;
+        push @{ $tab { $reg } }, $mirror ;
+      }
+
+    my $bad = 0 ; my $old = 0 ; my $unr = 0 ;
+    my %stats ;
+    my @stats ;
+    my $ok = 0 ;
+
+    for my $url ( keys %$state )
+      { my $mirror = $state -> { $url } ;
+        my $time = $mirror -> age ;
+        my $stat = $mirror -> last_status ;
+        my $vrfy = $mirror -> last_ok_probe ;
+        if ( $stat eq 'ok' ) { $ok ++ ; } else { $stats { $stat } ++ ; }
+        if ( $time eq 'undef' )
+          { $bad ++ ; }
+        elsif ( 'f' eq $conf -> age_code ( $time ) )
+          { $old ++ ; }
+        if ( $vrfy eq 'undef' or aprx_lt $vrfy, $^T - $conf -> max_vrfy )
+          { $unr ++ ; }
+      }
+
+    my $STAT = sprintf
+        "%d bad -- %d older than %s -- %s unreachable for more than %s"
+      , $bad
+      , $old
+      , pr_interval ( $conf -> max_age2 )
+      , $unr
+      , pr_interval ( $conf -> max_vrfy )
+      ;
+
+    my $PROB = 'last probes : ' ;
+    push @stats, "$ok were ok" if $ok ;
+    for my $stat ( sort keys %stats )
+      { ( my $txt = $stat ) =~ s/_/ /g ;
+        push @stats, sprintf "%s had %s" , $stats { $stat } , RED $txt ;
+      }
+    $PROB .= join ', ', @stats ;
+
+    my ( $mean, $median, $stddev ) = $self -> age_avg ;
+    my $AVGS = "mean mirror age is " ;
+    unless ( defined $mean )
+       { $AVGS = "<I>undefined</I>" ; }
+    else
+       { $AVGS .= sprintf "%s", pr_interval $mean ;
+         if ( defined $stddev )
+           { $AVGS .= sprintf ", std_dev %s", pr_interval $stddev ; }
+         $AVGS .= sprintf ", median %s", pr_interval $median ;
+       }
+
+    for my $reg ( sort keys %tab )
+      { $refs .= sprintf "&nbsp;%s&nbsp;\n"
+          , URL "#$reg", "<FONT SIZE=\"+1\">$reg</FONT>"
+          ;
+      }
+
+    my $COLS = 5 ;
+    my $NAME = $conf -> project_name ;
+    my $LOGO = $conf -> project_logo
+      ? URL
+          ( $conf -> project_url
+          , sprintf
+              ( '<IMG SRC="%s" ALT="%s" ALIGN="RIGHT" BORDER=0>'
+              , $conf -> project_logo
+              , $conf -> project_name
               )
-            {
-                push @QUE, $url;
-            }
-            elsif ( $CNF{randomize} and 0 == int rand $cnt_LST ) {
-                push @QUE, $url;
-            }
-            else { $RES{$url} = $OLD{$url}; }
-        }
-        else { Error "unknown opt_get '$opt{get}'"; }
-    }
-    while (@QUE) {
-        while ( $GET->count() < $PAR and @QUE ) {
-            my $url = shift @QUE;
-            if ( gethost site $url ) { start_date $url, $CMD; }
-            else                     { err $url, 'site not found'; }
-        }
-        my @can_read = $GET->can_read(0);
-        printf "que %d, get %d, can %d\n", scalar @QUE, $GET->count(),
-          scalar @can_read
-          if $opt{v};
-        for my $can_read (@can_read) { get_date $can_read ; }
-        sleep 1;
-    }
-    my $stop = time + $CNF{timeout} + 10;
-    while ( $GET->count() and time < $stop ) {
-        sleep 1;
-        my @can_read = $GET->can_read(0);
-        printf "wait %2d, get %d, can %d\n", $stop - scalar time, $GET->count(),
-          scalar @can_read
-          if $opt{v};
-        for my $can_read (@can_read) { get_date $can_read ; }
-    }
-    for my $WGT ( $GET->handles() ) {
-        my $url = $URL{$WGT};
-          err $url, 'hangs';
+          )
+      : ''
+      ;
+    my $HEAD = $conf -> htm_head . "\n" ;
+    my $HTOP = $conf -> htm_top  . "\n" ;
+    my $FOOT = $conf -> htm_foot . "\n" ;
+    my $TITL = URL $conf -> project_url, $NAME ;
+    my $EXPD = Base::exp_date ;
+    my $DATE = scalar gmtime $^T ;
+    my $LAST = scalar gmtime ( $get ? $^T : ( stat $conf -> state ) [9] ) ;
+
+    my $histo_top = $self -> gen_histogram ( 'top' ) ;
+    my $histo_bot = $self -> gen_histogram ( 'bottom' ) ;
+
+    open PPP, ">$TMP" or die "can't write $TMP ($!)" ;
+    my $prev_select = select PPP ;
+
+    my $attr1 = "COLSPAN=$COLS BGCOLOR=LIME" ;
+    my $attr2 = 'BGCOLOR=AQUA' ;
+    my $attr3 = "COLSPAN=$COLS BGCOLOR=YELLOW" ;
+
+    my $num_mirrors = scalar keys %$state ;
+    my $num_regions = scalar keys %tab ;
+
+    print <<HEAD ;
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>the status of $NAME mirrors</TITLE>
+<META HTTP-EQUIV="content-type" CONTENT="text/html; charset=utf-8">
+<META HTTP-EQUIV=refresh CONTENT=3600>
+<META HTTP-EQUIV=Expires CONTENT=\"$EXPD\">
+$HEAD
+</HEAD>
+<BODY BGCOLOR=\"#FFFFFF\">
+$LOGO
+<H2>the status of $TITL mirrors</H2>
+<TABLE BORDER=0 CELLPADDING=2>
+<TR><TD>date</TD><TD>:</TD><TD>$DATE (UTC)</TD></TR>
+<TR><TD>last&nbsp;check</TD>
+  <TD>:</TD>
+  <TD>$LAST (UTC)</TD>
+</TR>
+</TABLE>
+$HTOP
+$histo_top
+<H2>regions</H2>
+<BLOCKQUOTE><CENTER>\n$refs\n</CENTER></BLOCKQUOTE>
+<H2>report</H2>
+<BLOCKQUOTE>
+<TABLE BORDER=2 CELLPADDING=5>
+<TR><TH $attr1>$num_mirrors sites in $num_regions regions</TH></TR>
+<TR><TH $attr1>$STAT</TH></TR>
+<TR><TH $attr1>$PROB</TH></TR>
+<TR><TH $attr1>$AVGS</TH></TR>
+<TR>
+  <TH $attr2>$NAME site -- home</TH>
+  <TH $attr2>type</TH>
+  <TH $attr2>mirror age,<BR>daily stats</TH>
+  <TH $attr2>last probe,<BR>probe stats</TH>
+  <TH $attr2>last stat</TH>
+</TR>
+HEAD
+
+    for my $reg
+      ( sort
+       { ( $CCS -> { $a } || $a ) cmp ( $CCS -> { $b } || $b ) ; }
+       keys %tab
+      )
+      { my $mirrors = $tab { $reg } ;
+
+        my $ccs = exists $CCS -> { $reg } ? $CCS -> { $reg } : $reg ;
+        $ccs = NAM $reg,
+          ( scalar @{ $mirrors } > 6
+          ? sprintf "%s&nbsp;&nbsp;-&nbsp;&nbsp;%d sites"
+              , $ccs, scalar @{ $mirrors }
+          : $ccs
+          ) ;
+        printf "<TR><TH $attr3>$ccs</TH></TR>\n" ;
+
+        for my $mirror ( sort { $a -> cmp ( $b ) } @$mirrors )
+          { print "<TR>\n" ;
+            printf "  <TD ALIGN=RIGHT>%s&nbsp;&nbsp;%s</TD>\n  <TD>%s</TD>\n"
+              , $mirror -> site_url
+              , $mirror -> home_url
+              , $mirror -> type
+              ;
+
+            my ( $url, $time, $stat, $vrfy, $hstp, $hsts ) =
+              $mirror -> as_list ;
+            my $pr_time = $time =~ /^\d+$/
+              ? pr_diff $time, $^T - $conf -> max_age2 : '&nbsp;' ;
+            my $pr_last = $vrfy =~ /^\d+$/
+              ? pr_diff $vrfy, $^T - $conf -> max_vrfy : '&nbsp;' ;
+            my $pr_hstp = $self -> show_hist ( $hstp ) ;
+            my $pr_hsts = $self -> show_hist ( $hsts ) ;
+
+            if ( $stat ne 'ok' ) { $stat =~ s/_/ /g ; $stat = RED $stat ; }
+            printf "  <TD ALIGN=RIGHT>%s<BR>%s</TD>\n" , $pr_time, $pr_hsts ;
+            printf "  <TD ALIGN=RIGHT>%s<BR>%s</TD>\n" , $pr_last, $pr_hstp ;
+            printf "  <TD>%s</TD>\n", $stat ;
+            print "</TR>\n" ;
+          }
+      }
+
+    my $legend = $self -> legend ;
+    my $probes = $self -> gen_histogram_probes ;
+    my $mir_img = sprintf
+      '<IMG BORDER=2 ALT=mirmon SRC="%s/mirmon.gif">' , $conf -> icons ;
+
+    print <<TAIL ;
+</TABLE>
+</BLOCKQUOTE>
+$histo_bot
+$legend
+<H3>probe results</H3>
+$probes
+<H3>software</H3>
+<BLOCKQUOTE>
+<TABLE>
+<TR>
+  <TH><A HREF=\"$HOME\">$mir_img</A></TH>
+  <TD>$VERSION</TD>
+</TR>
+</TABLE>
+</BLOCKQUOTE>
+$FOOT
+</BODY>
+</HTML>
+TAIL
+
+    select $prev_select ;
+
+    if ( print PPP "\n" )
+      { close PPP ;
+        if ( -z $TMP )
+          { warn "wrote empty html file; keeping previous version" ; }
+        else
+          { rename $TMP, $PPP or die "can't rename $TMP, $PPP ($!)" ; }
+      }
+    else
+      { die "can't print to $TMP ($!)" ; }
+  }
+
+package Mirmon::Conf ; #############################################
+
+BEGIN { use base 'Base' ; Base -> import () ; }
+
+our %CNF_defaults =
+  ( project_logo => ''
+  , timeout      => $DEF_TIMEOUT
+  , max_probes   => 25
+  , min_poll     => '1h'
+  , max_poll     => '4h'
+  , min_sync     => '1d'
+  , max_sync     => '2d'
+  , list_style   => 'plain'
+  , put_histo    => 'top'
+  , randomize    => 1
+  , add_slash    => 1
+  , htm_top      => ''
+  , htm_foot     => ''
+  , htm_head     => ''
+  ) ;
+
+our @REQ_KEYS =
+  qw( web_page state countries mirror_list probe
+      project_name project_url icons
+    ) ;
+our %CNF_KEYS ;
+for ( @REQ_KEYS, keys %CNF_defaults ) { $CNF_KEYS { $_ } ++ ; }
+
+my @LIST_STYLE = qw(plain apache) ;
+my @PUT_HGRAM  = qw(top bottom nowhere) ;
+
+eval Base -> mk_methods ( keys %CNF_KEYS, qw(root site_url) ) ;
+
+sub new
+  { my $self = shift ;
+    my $FILE = shift ;
+    my $res = bless { %CNF_defaults }, $self ;
+    $res -> root ( $FILE ) ;
+    $res -> site_url ( {} ) ;
+    $res -> get_conf () ;
+  }
+
+sub get_conf
+  { my $self = shift ;
+    my $FILE = ( @_ ? shift : $self -> root ) ;
+
+    if ( grep $_ eq $FILE,  @{ $self -> {_include} } )
+      { die "already included : '$FILE'" ; }
+    else
+      { push @{ $self -> {_include} }, $FILE ; }
+
+    open FILE, $FILE or die "can't open '$FILE' ($!)" ;
+    my $CONF = join "\n", grep /./, <FILE> ;
+    close FILE ;
+
+    $CONF =~ s/\t/ /g ;           # replace tabs
+    $CONF =~ s/^[+ ]+// ;         # delete leading space, plus
+    $CONF =~ s/\n\n\s+/ /g ;      # glue continuation lines
+    $CONF =~ s/\n\n\+\s+//g ;     # glue concatenation lines
+    $CONF =~ s/\n\n\./\n/g ;      # glue concatenation lines
+
+    chop $CONF ;
+    print "--$CONF--\n" if Mirmon::debug ;
+    for ( grep ! /^#/, split /\n\n/, $CONF )
+      { my ($key,$val) = split ' ', $_, 2 ;
+        $val = '' unless defined $val ;
+        print "conf '$FILE' : key '$key', val '$val'\n" if Mirmon::debug ;
+        if ( exists $CNF_KEYS { $key } )
+          { $self -> $key ( $val ) ; }
+        elsif ( $key eq 'site_url' )
+          { my ( $site, $url ) = split ' ' , $val ;
+            $url .= '/' if $self -> add_slash and $url !~ m!/$! ;
+            $self -> site_url -> { $site } = $url ;
+#           printf "config : for site '%s' use instead\n   '%s'\n",
+#             $site, $url if Mirmon::verbose ;
+          }
+        elsif ( $key eq 'no_add_slash' )
+          { $self -> add_slash ( 0 ) ; }
+        elsif ( $key eq 'no_randomize' )
+          { $self -> randomize ( 0 ) ; }
+        elsif ( $key eq 'show' )
+          { $self -> show_conf if Mirmon::verbose ; }
+        elsif ( $key eq 'exit' )
+          { die 'exit per config directive' ; }
+        elsif ( $key eq 'include' )
+          { $self -> get_conf ( $val ) ; }
+        elsif ( $key eq 'env' )
+          { my ( $x, $y ) = split ' ' , $val ;
+            $ENV { $x } = $y ;
+            printf "config : setenv '%s'\n   '%s'\n", $x, $y
+              if Mirmon::verbose ;
+          }
+        else
+          { $self -> show_conf ;
+            die "unknown keyword '$key' (value '$val')\n" ;
+          }
+      }
+    my $err = $self -> check ;
+    die $err if $err ;
+    $self ;
+  }
+
+sub check
+  { my $self = shift ;
+    my $err = '' ;
+    for my $key ( @REQ_KEYS )
+      { unless ( exists $self -> { $key } )
+          { $err .= "error: missing config for '$key'\n" ; }
+      }
+    for my $key ( qw(min_poll max_poll max_sync min_sync) )
+      { my $max = $self -> $key ;
+        unless ( $max =~ /$TIM_PAT/o )
+          { $err .= "error: bad timespec for $key ($max)\n" ; }
+      }
+    unless ( grep $self -> { list_style } eq $_, @LIST_STYLE )
+      { $err .= sprintf "error: unknown 'list_style' '%s'\n",
+          $self -> list_style ;
+      }
+    unless ( grep $self -> put_histo eq $_, @PUT_HGRAM )
+      { $err .= sprintf "%s : error: unknown 'put_histo' '%s'\n",
+          $self -> put_histo ;
+      }
+    $err ;
+  }
+
+sub show_conf
+  { my $self = shift ;
+    print "vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv\n" ;
+    for my $key ( sort keys %$self )
+      { next if $key =~ m/^_/ ;
+        my $val = $self -> { $key } ;
+        print "show_conf : $key = '$val'\n" ;
+      }
+    for my $key ( sort keys %{ $self -> site_url } )
+      { printf "show_conf : for site '%s' use instead\n   '%s'\n"
+          , $key, $self -> site_url -> { $key } if Mirmon::verbose ;
+      }
+    printf "show_conf : included '%s'\n"
+      , join "', '", @{ $self -> {_include} } ;
+    print "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n" ;
+  }
+
+sub max_age1
+  { my $self = shift ;
+    ( s4tim $self -> min_sync ) + ( s4tim $self -> max_poll ) ;
+  }
+
+sub max_age2
+  { my $self = shift ;
+    ( s4tim $self -> max_sync ) + ( s4tim $self -> max_poll ) ;
+  }
+
+sub max_vrfy
+  { my $self = shift ;
+    ( s4tim $self -> min_poll ) + ( s4tim $self -> max_poll ) ;
+  }
+
+sub age_code
+  { my $self = shift ;
+    my $time = shift ;
+    return 'z' unless $time =~ /^\d+$/ ;
+    return
+      ( ( aprx_ge ( $time, $^T - $self -> max_age1 ) )
+      ? 's'
+      : ( aprx_ge ( $time, $^T - $self -> max_age2 ) ? 'b' : 'f' )
+      ) ;
+  }
+
+package Mirmon::Mirror ; ###########################################
+
+BEGIN { use base 'Base' ; Base -> import () ; }
+
+use IO::Pipe ;
+
+my @FIELDS =
+  qw(url age last_status last_ok_probe probe_history state_history last_probe) ;
+
+eval Base -> mk_methods ( @FIELDS, qw(mirmon region mail) ) ;
+
+sub state_history_time
+  { my $self = shift ;
+    my $res = ( split /-/, $self -> state_history ) [ 0 ] ;
+    $res ;
+  }
+
+sub state_history_hist
+  { my $self = shift ;
+    my $res = ( split /-/, $self -> state_history ) [ 1 ] ;
+    $res ;
+  }
+
+sub _parse
+  { my $self = shift ;
+    my $url  = $self -> url ;
+    my ( $type, $site, $home ) ;
+    if ( $url =~ m!^(ftp|https?|rsync)://([^/:]+)(:\d+)?/! )
+      { $type = $1 ; $site = $2 ; $home = $& ; }
+    return $type, $site, $home ;
+  }
+
+sub type { my $self = shift ; ( $self -> _parse ) [ 0 ] ; }
+sub site { my $self = shift ; ( $self -> _parse ) [ 1 ] ; }
+sub home { my $self = shift ; ( $self -> _parse ) [ 2 ] ; }
+
+sub age_in_days
+  { my $self = shift ;
+    my $res = 'undef' ;
+    my $age = $self -> age ;
+    if ( $age eq 'undef' )
+      { $res = length $self -> state_history_hist
+          if $self -> last_probe ne 'undef' ;
+      }
+    else
+      { $res = ( $^T - $age ) / 24 / 60 / 60 ; }
+    $res ;
+  }
+
+sub init
+  { my $self   = shift ;
+    my $mirmon = shift ;
+    my $url    = shift ;
+    my $res = bless { mirmon => $mirmon }, $self ;
+    @{ $res } { @FIELDS } = ( 'undef' ) x scalar @FIELDS ;
+    $res -> url ( $url ) ;
+    $res -> probe_history ( '' ) ;
+    $res -> state_history ( "$^T-z" ) ;
+    $res -> mail ( '' ) ;
+    $res ;
+  }
+
+sub new
+  { my $self   = shift ;
+    my $mirmon = shift ;
+    my $line   = shift ;
+    my $res = bless { mirmon => $mirmon }, $self ;
+    @{ $res } { @FIELDS } = split ' ', $line ;
+    $res -> mail ( '' ) ;
+    $res ;
+  }
+
+sub update
+  { my $self = shift ;
+    my $succ = shift ;
+    my $stat = shift ;
+    my $time = shift ;
+    my $probe_hist = $self -> probe_history ;
+    if ( $succ )
+      { $self -> age ( $time ) ;
+        $self -> last_ok_probe ( $^T ) ;
+        $probe_hist .= 's' ;
+      }
+    else
+      { $probe_hist .= 'f' ;
+        $time = $self -> age ;
+      }
+
+    my $h = $self -> state_history_hist ;
+    my $t = $self -> state_history_time ;
+
+    if ( aprx_ge ( $^T - $t, $HIST_DELTA ) )
+      { my $n = int ( ( $^T - $t ) / $HIST_DELTA ) ;
+        $h .= 'x' x ( $n - 1 ) ;
+        $t = ( $n == 1 ? $t + $HIST_DELTA : $^T ) ;
+      }
+    else
+      { chop $h ; }
+    $h .= $self -> mirmon -> conf -> age_code ( $time ) ;
+    $h = substr $h, - $HIST ;
+    $h =~ s/^x+// ;
+
+    $self -> last_status ( $stat ) ;
+    $self -> probe_history ( substr $probe_hist, - $HIST ) ;
+    $self -> last_probe ( $^T ) ;
+    $self -> state_history ( "$t-$h" ) ;
+  }
+
+sub as_list { my $self = shift ; @{ $self } { @FIELDS } ; }
+sub state { my $self = shift ; join ' ', $self -> as_list ; }
+
+sub start_probe
+  { my $self = shift ;
+    my $conf = $self -> mirmon -> conf ;
+    my $probe = $conf -> probe ;
+    my $timeout = $conf -> timeout ;
+    $probe =~ s/%TIMEOUT%/$timeout/g ;
+    my $url = $self -> url ;
+    my $new = $conf -> site_url -> { $self -> site } ;
+    if ( defined $new )
+      { printf "*** site_url : site %s\n  -> url %s\n"
+          , $self -> site, $new if Mirmon::verbose ;
+        $url = $new ;
+      }
+    $probe =~ s/%URL%/$url/g ;
+    my $pipe = new IO::Pipe ;
+    my $handle = $pipe -> reader ( split ' ', $probe ) ;
+    if ( $handle )
+      { $pipe -> blocking ( 0 ) ; }
+    else
+      { die "start_probe : no pipe for $url" ; }
+    printf "start %s\n", $url if Mirmon::verbose ;
+    printf "  %s\n", $probe if Mirmon::debug ;
+    $handle ;
+  }
+
+sub finish_probe
+  { my $self   = shift ;
+    my $handle = shift ;
+    my $res ;
+    my $succ = 0 ;
+    my $stat ;
+    my $time ;
+
+    $handle -> blocking ( 1 ) ;
+    if ( $handle -> eof () )
+      { printf "finish eof %s\n", $self -> url if Mirmon::verbose ; }
+    else
+      { $res = $handle -> getline () ; }
+    $handle -> flush ;
+    $handle -> close ;
+
+    unless ( defined $res )
+      { $stat = 'no_time' ; }
+    elsif ( $res =~ /^\s*$/ )
+      { $stat = 'empty' ; }
+    else
+      { $res = ( split ' ', $res ) [ 0 ] ;
+
+        if ( $res !~ /^\d+$/ )
+          { $res =~ s/ /_/g ;
+            $res = Base::htmlquote $res ;
+            $res = substr ( $time, 0, 15 ) . '..' if length $res > 15 ;
+            $stat = "'$res'" ;
+          }
+        else
+          { $succ = 1 ; $stat = 'ok' ; $time = $res ; }
+      }
+
+    printf "finish %s\n  succ(%s) stat(%s) time(%s)\n"
+      , $self -> url
+      , $succ
+      , $stat
+      , ( defined $time ? $time : 'undef' )
+        if Mirmon::verbose ;
+
+    $self -> update ( $succ, $stat, $time ) ;
+  }
+
+sub revdom { my $dom = shift ; join '.', reverse split /\./, $dom ; }
+
+sub cmp
+  { my $a = shift ;
+    my $b = shift ;
+    ( revdom $a -> site ) cmp ( revdom $b -> site )
+    or
+    ( $a -> type cmp $b -> type )
+    ;
+  }
+
+sub _url
+  { my $hrf = shift ;
+    my $txt = shift ;
+    $hrf =~ /^rsync/ ? $txt : URL $hrf, $txt ;
+  }
+
+sub site_url { my $self = shift ; _url $self -> url , $self -> site ; }
+sub home_url { my $self = shift ; _url $self -> home, '@' ; }
+
+=pod
+
+=head1 NAME
+
+Mirmon - OO interface for mirmon objects
+
+=head1 SYNOPSIS
+
+  use Mirmon ;
+
+  $m = Mirmon -> new ( [ $path-to-config ] )
+
+  $conf  = $m -> conf  ; # a Mirmon::Conf object
+  $state = $m -> state ; # the mirmon state
+
+  for my $url ( keys %$state )
+    { $mirror = $state -> { $url } ; # a Mirmon::Mirror object
+      $mail = $mirror -> mail ;      # contact address
+      $mirror -> age ( time ) ;      # set mirror age
     }
-}
-get_conf_opt;
-get_ccs $CNF {countries};
-get_state $CNF {state};
-get_list $CNF {mirror_list};
-if ( $opt{get} ) {
-    get_dates $CNF {probe};
-    put_state $CNF {state};
-}
-else { %RES = %OLD }
-gen_page $CNF {web_page};
+
+Many class and object methods can be used to get or set attributes :
+
+  $object -> attribute           # get an atttibute
+  $object -> attribute ( $attr ) # set an atttibute
+
+=head1 Mirmon class methods
+
+=over 4
+
+=item B<new ( [$path] )>
+
+Create a Mirmon object from a config file found in $path,
+or (by default) in the default list of possible config files.
+Related objects (config, state) are created and initialised.
+
+=item verbosity
+
+Mirmon always reports errors. Normally it only reports
+changes (inserts/deletes) found in the mirror_list ;
+in I<quiet> mode, it doesn't. In I<verbose> mode, it
+reports progress: the startup and finishing of probes.
+
+  Mirmon::verbose ( [ $bool ] ) # get/set verbose
+  Mirmon::quiet   ( [ $bool ] ) # get/set quiet
+  Mirmon::debug   ( [ $bool ] ) # get/set debug
+
+=back
+
+=head1 Mirmon object methods
+
+=over 4
+
+=item B<conf>
+
+Returns Mirmon's Mirmon::Conf object.
+
+=item B<state>
+
+Returns a hashref C<< { url => mirror, ... } >>,
+where I<url> is as specified in the mirror list
+and I<mirror> is a Mirmon::Mirror object.
+
+=item B<regions>
+
+Returns a hashref C<< { country_code =E<gt> country_name, ... } >>.
+
+=item B<config_list>
+
+Returns the list of default locations for config files.
+
+=item B<get_dates ( $get )>
+
+Probes all mirrors if $get is C<all> ; or a subset if $get is C<update>.
+
+=back
+
+=head1 Mirmon::Conf object methods
+
+A Mirmon::Conf object represents a mirmon conguration.
+It is normaly created by Mirmon::new().
+A specified (or default) config file is read and interpreted.
+
+=over 4
+
+=item attribute methods
+
+For every config file entry, there is an attribute method :
+B<web_page>, B<state>, B<countries>, B<mirror_list>, B<probe>,
+B<project_name>, B<project_url>, B<icons>, B<project_logo>,
+B<timeout>, B<max_probes>, B<min_poll>, B<max_poll>, B<min_sync>,
+B<max_sync>, B<list_style>, B<put_histo>, B<randomize>, B<add_slash>.
+
+=item B<root>
+
+Returns the file name of (the root of) the configuration file(s).
+
+=item B<site_url>
+
+Returns a hashref C<< { site => url, ... } >>,
+as specified in the mirmon config file.
+
+=back
+
+=head1 Mirmon::Mirror object methods
+
+A Mirmon::Mirror object represents the last known state of a mirror.
+It is normaly created by Mirmon::new() from the state file,
+as specified in the mirmon config file.
+Mirmon::Mirror objects can be used to probe mirrors.
+
+=head2 attribute methods
+
+=over 4
+
+=item B<url>
+
+The url as given in the mirror list.
+
+=item B<age>
+
+The mirror's timestamp found by the last succesful probe,
+or 'undef' if no probe was ever successful.
+
+=item B<last_status>
+
+The status of the last probe, or 'undef' if the mirror was never probed.
+
+=item B<last_ok_probe>
+
+The timestamp of the last succesful probe or 'undef'
+if the mirror was never successfully probed.
+
+=item B<probe_history>
+
+The probe history is a list of 's' (for success) and 'f' (for failure)
+characters indicating the result of the probe. New results are appended
+whenever the mirror is probed.
+
+=item B<state_history>
+
+The state history consists of a timestamp, a '-' char, and a list of
+chars indicating a past status: 's' (fresh), 'b' (oldish), 'f' (old),
+'z' (bad) or 'x' (skip).
+The timestamp indicates when the state history was last updated.
+The current status of the mirror is determined by the mirror's age and
+a few configuration parameters (min_sync, max_sync, max_poll).
+The state history is updated when the mirror is probed.
+If the last update of the history was less than 24 hours ago,
+the last status is replaced by the current status.
+If the last update of the history was more than 24 hours ago,
+the current status is appended to the history.
+One or more 'skip's are inserted, if the timestamp is two or more days old
+(when mirmon hasn't run for more than two days).
+
+=item B<last_probe>
+
+The timestamp of the last probe, or 'undef' if the mirror was never probed.
+
+=back
+
+=head2 object methods
+
+=over 4
+
+=item B<mirmon>
+
+Returns the parent Mirmon object.
+
+=item B<state_history_time>
+
+Returns the I<time> part of the state_history attribute.
+
+=item B<state_history_hist>
+
+Returns the I<history> part of the state_history attribute.
+
+=item B<type>, B<site>, B<home>
+
+For an url like I<ftp://www.some.org/path/to/home>,
+the B<type> is I<ftp>,
+the B<site> is I<www.some.org>,
+and B<home> is I<ftp://www.some.org/>.
+
+=item B<age_in_days>
+
+Returns the mirror's age (in fractional days), based on the mirror's
+timestamp as found by the last successful probe ; or based on the
+length of the state history if no probe was ever successful.
+Returns 'undef' if the mirror was never probed.
+
+=item B<mail>
+
+Returns the mirror's contact address as specified in the mirror list.
+
+=item B<region>
+
+Returns the mirror's country code as specified in the mirror list.
+
+=item B<start_probe>
+
+Start a probe for the mirror in non-blocking mode ;
+returns the associated (IO::Handle) file handle.
+The caller must maintain an association between
+the handles and the mirror objects.
+
+=item B<finish_probe ( $handle )>
+
+Sets the (IO::Handle) B<$handle> to blocking IO ;
+reads a result from the handle,
+and updates the state of the mirror.
+
+=back
+
+=head1 SEE ALSO
+
+=begin html
+
+<A HREF="mirmon.html">mirmon(1)</A>
+
+=end html
+
+=begin man
+
+mirmon(1)
+
+=end man
+
+=head1 AUTHOR
+
+=begin html
+
+  &copy; 2003-2010
+  <A HREF="http://people.cs.uu.nl/henkp/">Henk P. Penning</A>,
+  <A HREF="http://www.cs.uu.nl/">Computer Science Department</A>,
+  <A HREF="http://www.uu.nl/">Utrecht University</A>
+  <BR>
+  mirmon-2.3 - Wed Mar 17 09:29:11 2010 ; henkp
+
+=end html
+
+=begin man
+
+  (c) 2003-2010 Henk P. Penning
+  Computer Science Department, Utrecht University
+  http://people.cs.uu.nl/henkp/ -- penning@cs.uu.nl
+  mirmon-2.3 - Wed Mar 17 09:29:11 2010 ; henkp
+
+=end man
+
+=begin text
+
+  (c) 2003-2010 Henk P. Penning
+  Computer Science Department, Utrecht University
+  http://people.cs.uu.nl/henkp/ -- penning@cs.uu.nl
+  mirmon-2.3 - Wed Mar 17 09:29:11 2010 ; henkp
+
+=end text
+
+=cut
+
+package main ; #####################################################
+
+use IO::Pipe ;
+use IO::Select ;
+use Net::hostent ;
+
+my $VERSION = Base::Version . ' - Wed Mar 17 09:29:11 2010 - henkp' ;
+my $DEF_CNF = join ', ', Mirmon -> config_list ;
+my $TIMEOUT = Base::DEF_TIMEOUT ;
+
+my $prog = substr $0, rindex ( $0, '/' ) + 1 ;
+my $Usage = <<USAGE ;
+Usage: $prog [ -v ] [ -q ] [ -t timeout ] [ -get opt ] [ -c conf ]
+option v   : be verbose
+option q   : be quiet
+option t   : set timeout ; default $TIMEOUT
+option get : 'all'    : probe all sites
+           : 'update' : probe a selection of the sites (see doc)
+option c   : configuration file ; default search :
+             ( $DEF_CNF )
+-------------------------------------------------------------------
+Mirmon normally only reports errors and changes in the mirror list.
+This is $VERSION.
+-------------------------------------------------------------------
+USAGE
+sub Usage { die "$_[0]$Usage" ; }
+sub Error { die "$prog: $_[0]\n" ; }
+sub Warn  { warn "$prog: $_[0]\n" ; }
+
+# usage: &GetOptions(ARG,ARG,..) defines $opt_ID as 1 or user spec'ed value
+# usage: &GetOptions(\%opt,ARG,ARG,..) defines $opt{ID} as 1 or user value
+# ARG = 'ID' | 'ID=SPC' | 'ID:SPC' for no-arg, required-arg or optional-arg
+# ID  = perl identifier
+# SPC = i|f|s for integer, fixedpoint real or string argument
+
+use Getopt::Long ;
+Getopt::Long::config ( 'no_ignore_case' ) ;
+my %opt = () ;
+Usage '' unless GetOptions ( \%opt, qw(v q t=i get=s c=s version) ) ;
+Usage "Arg count\n" unless @ARGV == 0 ;
+
+if ( $opt{version} ) { printf "%s\n", Base::version () ; exit ; }
+
+$opt{v} ||= $opt{d} ;
+
+my $get = $opt{get} ;
+if ( $get and ! Base::is_get_opt ( $get ) )
+  { Error "unknown 'get option' '$get'" ; }
+
+Mirmon::verbose ( $opt{v} ) ;
+Mirmon::debug   ( $opt{d} ) ;
+Mirmon::quiet   ( $opt{q} ) ;
+
+my $M = Mirmon -> new ( $opt{c} ) ;
+$M -> conf -> timeout ( $opt{t} ) if $opt{t} ;
+if ( $get ) { $M -> get_dates ( $get ) ; $M -> put_state ; }
+$M -> gen_page ( $get, $VERSION ) ;
+
 __END__
+
 =pod
+
 =head1 NAME
-  mirmon - monitor the state of mirrors
+
+mirmon - monitor the state of mirrors
+
 =head1 SYNOPSIS
+
   mirmon [ -v ] [ -q ] [ -t timeout ] [ -get opt ] [ -c conf ]
+
 =head1 OPTIONS
+
   option v   : be verbose
   option q   : be quiet
   option t   : set timeout [ default 300 ] ;
@@ -1058,246 +1807,560 @@ __END__
   option c   : configuration file ; default list :
                ./mirmon.conf $HOME/.mirmon.conf /etc/mirmon.conf
   -------------------------------------------------------------------
-  Documentation : the program contains 'pod' style documentation.
-  Extract the doc with 'pod2text mirmon' or 'pod2html mirmon OUT', etc.
+  Mirmon normally only reports errors and changes in the mirror list.
   -------------------------------------------------------------------
+
 =head1 USAGE
-  The program is intended to be run by cron every hour.
-    42 * * * * perl /path/to/mirmon -q -get update
-  It quietly probes a subset of the sites in a given list,
-  writes the results in the 'state' file and generates a web page
-  with the results. The subset contains the sites that are new, bad
-  and/or not probed for a specified time.
-  When no 'get' option is specified, the program just generates a
-  new web page from the last known state.
-  The program checks the mirrors by running a (user specified)
-  program on a pipe. A (user specified) number of probes is
-  run in parallel using nonblocking IO. When something can be
-  read from the pipe, it switches the pipe to blocking IO and
-  reads one line from the pipe. Then it flushes and closes the
-  pipe. No attempt is made to kill the probe.
-  The probe should return something that looks like "1043625600\n",
-  that is, a timestamp followed by a newline. The exit status of
-  the probe is ignored.
+
+The program is intended to be run by cron every hour.
+
+  42 * * * * perl /path/to/mirmon -get update
+
+It quietly probes a subset of the sites in a given list,
+writes the results in the 'state' file and generates a web page
+with the results. The subset contains the sites that are new, bad
+and/or not probed for a specified time.
+
+When no 'get' option is specified, the program just generates a
+new web page from the last known state.
+
+The program checks the mirrors by running a (user specified)
+program on a pipe. A (user specified) number of probes is
+run in parallel using nonblocking IO. When something can be
+read from the pipe, it switches the pipe to blocking IO and
+reads one line from the pipe. Then it flushes and closes the
+pipe. No attempt is made to kill the probe.
+
+The probe should return something that looks like
+
+  1043625600 ...
+
+that is, a line of text starting with a timestamp. The exit status
+of the probe is ignored.
+
 =head1 CONFIG FILE
+
 =head2 location
-  A config file can be specified with the -c option.
-  If -c is not used, the program looks for a config file in
-  -- ./mirmon.conf
-  -- $HOME/.mirmon.conf
-  -- /etc/mirmon.conf
+
+A config file can be specified with the -c option.
+If -c is not used, the program looks for a config file in
+
+=over
+
+=item * B<./mirmon.conf>
+
+=item * B<$HOME/.mirmon.conf>
+
+=item * B</etc/mirmon.conf>
+
+=back
+
 =head2 syntax
-  A config file looks like this :
-    +--------------------------------------------------
-    |# lines that start with '#' are comment
-    |# blank lines are ignored too
-    |# tabs are replaced by a space
-    |
-    |# the config entries are 'key' and 'value' pairs
-    |# a 'key' begins in column 1
-    |# the 'value' is the rest of the line
-    |somekey  A_val B_val ...
-    |otherkey X_val Y_val ...
-    |
-    |# indented lines are glued
-    |# the next three lines mean 'somekey part1 part2 part3'
-    |somekey part1
-    |  part2
-    |  part3
-    |
-    |# lines starting with a '+' are concatenated
-    |# the next three lines mean 'somekey part1part2part3'
-    |somekey part1
-    |+ part2
-    |+ part3
-    |
-    |# lines starting with a '.' are glued too
-    |# don't use a '.' on a line by itself
-    |# 'somekey' gets the value "part1\n part2\n part3"
-    |somekey part1
-    |. part2
-    |. part3
-    +--------------------------------------------------
+
+A config file looks like this :
+
+  +--------------------------------------------------
+  |# lines that start with '#' are comment
+  |# blank lines are ignored too
+  |# tabs are replaced by a space
+  |
+  |# the config entries are 'key' and 'value' pairs
+  |# a 'key' begins in column 1
+  |# the 'value' is the rest of the line
+  |somekey  A_val B_val ...
+  |otherkey X_val Y_val ...
+  |
+  |# indented lines are glued
+  |# the next three lines mean 'somekey part1 part2 part3'
+  |somekey part1
+  |  part2
+  |  part3
+  |
+  |# lines starting with a '+' are concatenated
+  |# the next three lines mean 'somekey part1part2part3'
+  |somekey part1
+  |+ part2
+  |+ part3
+  |
+  |# lines starting with a '.' are glued too
+  |# don't use a '.' on a line by itself
+  |# 'somekey' gets the value "part1\n part2\n part3"
+  |somekey part1
+  |. part2
+  |. part3
+  +--------------------------------------------------
+
 =head1 CONFIG FILE : required entries
-=head2 project_name <name>
-  Specify a short plaintext name for the project.
-    project_name Apache
-    project_name CTAN
-=head2 project_url <url>
-  Specify an url pointing to the 'home' of the project.
-    project_url http://www.apache.org/
-=head2 mirror_list <file name>
-  Specify the file containing the mirrors to probe.
-  Two formats are supported :
-  -- plain : lines like
-       us http://www.tux.org/
-       nl http://apache.cs.uu.nl/dist/
-  -- apache : lines like those in the apache mirrors.list
-       ftp  us ftp://ftp.tux.org/pub/net/apache/dist/ user@tux.org
-       http nl http://apache.cs.uu.nl/dist/ user@cs.uu.nl
-  Specify the required format with 'list_style' (see below).
-  The default style is 'plain'.
-  If the url part of a line doesn't end in a slash ('/'), mirmon
-  adds a slash and issues a warning unless it is in quiet mode.
-=head2 web_page <file name>
-  Specify where the html report page is written.
-=head2 icons <directory name>
-  Specify the directory where the icons can be found.
-=head2 probe <program + arguments>
-  Specify the program+args to probe the mirrors. Example:
-    probe /sw/bin/wget -q -O - -T %TIMEOUT% -t 1 %URL%TIME
-  Before the program is started, %TIMEOUT% and %URL% are
-  substituted with the proper timeout and url values.
-  Here it is assumed that each hour the root server writes
-  a timestamp in /path/to/archive/TIME, for instance with
-  a crontab entry like
-    42 * * * * perl -e 'printf "%s\n", time' > /path/to/archive/TIME
-  Mirmon reads one line of output from the probe and interprets
-  the first word on that line as a timestamp ; for example :
-    1043625600
-    1043625600 Mon Jan 27 00:00:00 2003
-    1043625600 www.apache.org Mon Jan 27 00:00:00 2003
-=head2 state <file name>
-  Specify where the file containing the state is written.
-  The program reads this file on startup and writes the
-  file when mirrors are probed (-get is specified).
-=head2 countries <file name>
-  Specify the file containing the country codes;
-  The file should contain lines like
-    us - united states
-    nl - netherlands
-  The mirmon package contains a recent ISO list.
+
+=head2 project_name I<name>
+
+Specify a short plaintext name for the project.
+
+  project_name Apache
+  project_name CTAN
+
+=head2 project_url I<url>
+
+Specify an url pointing to the 'home' of the project.
+
+  project_url http://www.apache.org/
+
+=head2 mirror_list I<file-name>
+
+Specify the file containing the mirrors to probe.
+
+  mirror_list /path/to/mirror-list
+
+If your mirror list is generated by a program, use
+
+  mirror_list /path/to/program arg1 ... |
+
+Two formats are supported :
+
+=over
+
+=item * plain : lines like
+
+  us http://www.tux.org/ [email] ...
+  nl http://apache.cs.uu.nl/dist/ [email] ...
+  nl rsync://archive.cs.uu.nl/apache-dist/ [email] ...
+
+=item * apache : lines like those in the apache mirrors.list
+
+  ftp  us ftp://ftp.tux.org/pub/net/apache/dist/ user@tux.org ...
+  http nl http://apache.cs.uu.nl/dist/ user@cs.uu.nl ...
+
+=back
+
+Note that in style 'plain' the third item is reserved for an
+optional email address : the site's contact address.
+
+Specify the required format with 'list_style' (see below).
+The default style is 'plain'.
+
+=head2 web_page I<file-name>
+
+Specify where the html report page is written.
+
+=head2 icons I<directory-name>
+
+Specify the directory where the icons can be found,
+relative to the I<web_page>, or relative to the
+DOCUMENTROOT of the web server.
+
+If/when the I<web_page> lives in directory C<.../mirmon/> and
+the icons live in directory C<.../mirmon/icons/>,
+specify
+
+  icons icons
+
+If/when the icons live in C</path/to/DOCUMENTROOT/icons/mirmon/>, specify
+
+  icons /icons/mirmon
+
+=head2 probe I<program + arguments>
+
+Specify the program+args to probe the mirrors. Example:
+
+  probe /usr/bin/wget -q -O - -T %TIMEOUT% -t 1 %URL%TIME
+
+Before the program is started, %TIMEOUT% and %URL% are
+substituted with the proper timeout and url values.
+
+Here it is assumed that each hour the root server writes
+a timestamp in /path/to/archive/TIME, for instance with
+a crontab entry like
+
+  42 * * * * perl -e 'printf "%s\n", time' > /path/to/archive/TIME
+
+Mirmon reads one line of output from the probe and interprets
+the first word on that line as a timestamp ; for example :
+
+  1043625600
+  1043625600 Mon Jan 27 00:00:00 2003
+  1043625600 www.apache.org Mon Jan 27 00:00:00 2003
+
+Mirmon is distributed with a program C<probe> that handles
+ftp, http and rsync urls.
+
+=head2 state I<file-name>
+
+Specify where the file containing the state is written.
+
+The program reads this file on startup and writes the
+file when mirrors are probed (-get is specified).
+
+=head2 countries I<file-name>
+
+Specify the file containing the country codes;
+The file should contain lines like
+
+  us - united states
+  nl - netherlands
+
+The mirmon package contains a recent ISO list.
+
 =head1 CONFIG FILE : optional entries
-=head2 max_probes <number>
-  Optionally specify the number of parallel probes (default 25).
-=head2 timeout <seconds>
-  Optionally specify the timeout for the probes (default 300).
-  After the last probe is started, the program waits for
-  <timeout> + 10 seconds, cleans up and exits.
-=head2 project_logo <logo>
-  Optionally specify (the SRC of the IMG of) a logo to be placed
-  top right on the page.
-    project_logo /icons/apache.gif
-    project_logo http://www.apache.org/icons/...
-=head2 htm_head <html>
-  Optionally specify some HTML to be placed before </HEAD>.
-    htm_head
-      <link REL=StyleSheet HREF="/style.css" TYPE="text/css">
-=head2 htm_top <html>
-  Optionally specify some HTML to be placed near the top of the page.
-  The supplied text is placed between <P> and </P>.
-    htm_top testing 1, 2, 3
-=head2 htm_foot <html>
-  Optionally specify HTML to be placed near the bottom of the page.
-    htm_foot
-      <HR>
-      <A HREF="..."><IMG SRC="..." BORDER=0></A>
-      <HR>
+
+=head2 max_probes I<number>
+
+Optionally specify the number of parallel probes (default 25).
+
+=head2 timeout I<seconds>
+
+Optionally specify the timeout for the probes (default 300).
+
+After the last probe is started, the program waits for
+<timeout> + 10 seconds, cleans up and exits.
+
+=head2 project_logo I<logo>
+
+Optionally specify (the SRC of the IMG of) a logo to be placed
+top right on the page.
+
+  project_logo /icons/apache.gif
+  project_logo http://www.apache.org/icons/...
+
+=head2 htm_head I<html>
+
+Optionally specify some HTML to be placed before </HEAD>.
+
+  htm_head
+    <link REL=StyleSheet HREF="/style.css" TYPE="text/css">
+
+=head2 htm_top I<html>
+
+Optionally specify some HTML to be placed near the top of the page.
+
+  htm_top testing 1, 2, 3
+
+=head2 htm_foot I<html>
+
+Optionally specify HTML to be placed near the bottom of the page.
+
+  htm_foot
+    <HR>
+    <A HREF="..."><IMG SRC="..." BORDER=0></A>
+    <HR>
+
 =head2 put_histo top|bottom|nowhere
-  Optionally specify where the age histogram must be placed.
-  The default is 'top'.
-=head2 min_poll <time spec>
-  For 'min_poll' see next item. A <time spec> is a number followed by
-  a unit 's' (seconds), or 'm' (minutes), or 'h' (hours), or 'd' (days).
-  For example '3d' (three days) or '36h' (36 hours).
-=head2 max_poll <time spec>
-  Optionally specify the maximum probe interval. When the program is
-  called with option '-get update', all sites are probed which are :
-  -- new : the site appears in the list, but there is no known state
-  -- bad : the last probe of the site was unsuccessful
-  -- old : the last probe was more than 'max_poll' ago.
-  Sites are not probed if the last probe was less than 'min_poll' ago.
-  So, if you specify
-    min_poll 4h
-    max_poll 12h
-  the 'reachable' sites are probed twice daily and the 'unreachable'
-  sites are probed at most six times a day.
-  The default 'min_poll' is '1h' (1 hour).
-  The default 'max_poll' is '4h' (4 hours).
-=head2 min_sync <time spec>
-  Optionally specify how often the mirrors are required to
-  make an update. The default 'min_sync' is '1d' (1 day).
-=head2 max_sync <time spec>
-  Optionally specify the maximum allowable sync interval.
-  Sites exceeding the limit will be considered 'old'.
-  The default 'max_sync' is '2d' (2 days).
+
+Optionally specify where the age histogram must be placed.
+The default is 'top'.
+
+=head2 min_poll I<time-spec>
+
+For 'min_poll' see next item. A I<time-spec> is a number followed by
+a unit 's' (seconds), or 'm' (minutes), or 'h' (hours), or 'd' (days).
+For example '3d' (three days) or '36h' (36 hours).
+
+=head2 max_poll I<time-spec>
+
+Optionally specify the maximum probe interval. When the program is
+called with option '-get update', all sites are probed which are :
+
+=over 4
+
+=item * new
+
+the site appears in the list, but there is no known state
+
+=item * bad
+
+the last probe of the site was unsuccessful
+
+=item * old
+
+the last probe was more than 'max_poll' ago.
+
+=back
+
+Sites are not probed if the last probe was less than 'min_poll' ago.
+So, if you specify
+
+  min_poll 4h
+  max_poll 12h
+
+the 'reachable' sites are probed twice daily and the 'unreachable'
+sites are probed at most six times a day.
+
+The default 'min_poll' is '1h' (1 hour).
+The default 'max_poll' is '4h' (4 hours).
+
+=head2 min_sync I<time-spec>
+
+Optionally specify how often the mirrors are required to make an update.
+
+The default 'min_sync' is '1d' (1 day).
+
+=head2 max_sync I<time-spec>
+
+Optionally specify the maximum allowable sync interval.
+
+Sites exceeding the limit will be considered 'old'.
+The default 'max_sync' is '2d' (2 days).
+
 =head2 no_randomize
-  With a low probablility, mirmon probes mirrors that would
-  otherwise not be probed. In the long run, this balances
-  the number of mirror probes over the hourly mirmon runs.
-  Specifically, if there are N mirrors in the list and some
-  mirmon run would probe K sites, on average (N-K)/N extra
-  sites will be probed.
-  If you don't want this behaviour, use 'no_randomize'.
+
+To balance the probe load over the hourly mirmon runs,
+mirmon may probe a few extra randomly choosen mirrors :
+
+=over 4
+
+=item * only if the the number of mirrors to probe is below average,
+
+=item * at most 2% of the mirrors
+
+=back
+
+If you don't want this behaviour, use B<no_randomize>.
+
+=head2 no_add_slash
+
+If the url part of a line in the mirror_list doesn't end
+in a slash ('/'), mirmon adds a slash and issues a warning
+unless it is in quiet mode.
+
+If you don't want this behaviour, use B<no_add_slash>.
+
 =head2 list_style plain|apache
-  Optionally specify the format ('plain' or 'apache') of the
-  mirror-list. See the description of 'mirror_list' above.
-  The default list_style is 'plain'.
-=head2 site_url <site> <url>
-  Optionally specify a substitute url for a site. When access to
-  a site is restricted (in Australia, for instance), another
-  (sometimes secret) url can be used to probe the site. The <site>
-  of an url is the part between '://' and the first '/'.
-=head2 env <key> <value>
-  Optionally specify an environment variable.
-=head2 include <file name>
-  Optionally specify a file to include. The specified file is processed
-  'in situ'. After the specified file is read and processed, config
-  processing is resumed in the file where the 'include' was encountered.
-  The 'include' depth is unlimited. However, it is a fatal error to
-  include a file twice under the same name.
+
+Optionally specify the format ('plain' or 'apache') of the mirror-list.
+
+See the description of 'mirror_list' above.
+The default list_style is 'plain'.
+
+=head2 site_url I<site> I<url>
+
+Optionally specify a substitute url for a site.
+
+When access to a site is restricted (in Australia, for instance),
+another (sometimes secret) url can be used to probe the site.
+The <site> of an url is the part between '://' and the first '/'.
+
+=head2 env I<key> I<value>
+
+Optionally specify an environment variable.
+
+=head2 include I<file-name>
+
+Optionally specify a file to include.
+
+The specified file is processed 'in situ'. After the specified file is
+read and processed, config processing is resumed in the file where the
+C<include> was encountered.
+The include depth is unlimited. However, it is a fatal error to
+include a file twice under the same name.
+
 =head2 show
-  When the config processor encounters the 'show' command, it
-  dumps the content of the current config to standout, if option
-  -v is specified. This is intented for debugging.
+
+When the config processor encounters the 'show' command, it
+dumps the content of the current config to standout, if option
+C<-v> is specified. This is intented for debugging.
+
 =head2 exit
-  When the config processor encounters the 'exit' command, it
-  terminates the program. This is intented for debugging.
+
+When the config processor encounters the 'exit' command, it
+terminates the program. This is intented for debugging.
+
 =head1 STATE FILE FORMAT
-  The state file consists of lines; one line per site.
-  Each line consists of white space separated fields.
-  The seven fields are :
-=head2 field 1 : url
-  The url as given in the mirror list.
-=head2 field 2 : age
-  The age of the site, or 'undef' if no probe was ever successful.
-=head2 field 3 : status last probe
-  The status of the last probe.
-=head2 field 4 : time last succesful probe
-  The timestamp of the last succesful probe or 'undef'
-  if the site was never successfully probed.
-=head2 field 5 : probe history
-  The probe history is a list of 's' (for success) and 'f' (for failure)
-  characters indicating the result of the probe. New results are appended
-  whenever the site is probed.
-=head2 field 6 : state history
-  The state history consists of a timestamp, a '-' char, and a list of
-  chars indicating a past status: 's' (fresh), 'b' (oldish), 'f' (old)
-  or 'z' (bad). The timestamp indicates when the state history was last
-  updated. The state history is updated when the state file is updated
-  and the last update of the history state was 24 (or more) hours ago.
-  The status is determined by the site's age and a few configuration
-  parameters. The details are explained in the legend of the report page.
-=head2 field 7 : last probe
-  The timestamp of the last probe.
+
+The state file consists of lines; one line per site.
+Each line consists of white space separated fields.
+The seven fields are :
+
+=over 4
+
+=item * field 1 : url
+
+The url as given in the mirror list.
+
+=item * field 2 : age
+
+The mirror's timestamp found by the last succesful probe,
+or 'undef' if no probe was ever successful.
+
+=item * field 3 : status last probe
+
+The status of the last probe, or 'undef' if the mirror was never probed.
+
+=item * field 4 : time last succesful probe
+
+The timestamp of the last succesful probe or 'undef'
+if the mirror was never successfully probed.
+
+=item * field 5 : probe history
+
+The probe history is a list of 's' (for success) and 'f' (for failure)
+characters indicating the result of the probe. New results are appended
+whenever the mirror is probed.
+
+=item * field 6 : state history
+
+The state history consists of a timestamp, a '-' char, and a list of
+chars indicating a past status: 's' (fresh), 'b' (oldish), 'f' (old),
+'z' (bad) or 'x' (skip).
+The timestamp indicates when the state history was last updated.
+The current status of the mirror is determined by the mirror's age and
+a few configuration parameters (min_sync, max_sync, max_poll).
+The state history is updated when the mirror is probed.
+If the last update of the history was less than 24 hours ago,
+the last status is replaced by the current status.
+If the last update of the history was more than 24 hours ago,
+the current status is appended to the history.
+One or more 'skip's is inserted, if the timestamp is two or more days old
+(when mirmon hasn't run for more than two days).
+
+=item * field 7 : last probe
+
+The timestamp of the last probe, or 'undef' if the mirror was never probed.
+
+=back
+
 =head1 INSTALLATION
-=over
-=item *
-  The '#!' path for perl is probably wrong.
+
+=head2 general
+
+=over 4
+
+=item * Note: The (empty) state file must exist before mirmon runs.
+
+=item * The mirmon repository is here :
+
+  https://subversion.cs.uu.nl/repos/staff.henkp.mirmon/trunk/
+
+=item * The mirmon tarball is here :
+
+  http://people.cs.uu.nl/henkp/mirmon/mirmon.tar.gz
+
 =back
+
+=head2 installation suggestions
+
+To install and configure mirmon, take the following steps :
+
+=over 2
+
+=item * First, make the webdir :
+
+  cd DOCUMENTROOT
+  mkdir mirmon
+
+For I<DOCUMENTROOT>, substitute the full pathname
+of the document root of your webserver.
+
+=item * Check out the mirmon repository :
+
+  cd /usr/local/src
+  svn checkout REPO mirmon
+
+where
+
+  REPO = https://subversion.cs.uu.nl/repos/staff.henkp.mirmon/trunk/
+
+or download the package and unpack it.
+
+=item * Chdir to directory mirmon :
+
+  cd mirmon
+
+=item * Create the (empty) state file :
+
+  touch state.txt
+
+=item * Install the icons in the webdir :
+
+  mkdir DOCUMENTROOT/mirmon/icons
+  cp icons/* DOCUMENTROOT/mirmon/icons
+
+=item * Create a mirror list C<mirror_list> ;
+
+Use your favorite editor, or genererate the list from an
+existing database.
+
+  nl http://archive.cs.uu.nl/your-project/ contact@cs.uu.nl
+  uk http://mirrors.this.org/your-project/ mirrors@this.org
+  us http://mirrors.that.org/your-project/ mirrors@that.org
+
+The email addresses are optional.
+
+=item * Create a mirmon config file C<mirmon.conf> with your favorite editor.
+
+  # lines must start in the first column ; no leading white space
+  project_name ....
+  project_url  ....
+  mirror_list mirror_list
+  state state.txt
+  countries countries.list
+  web_page DOCUMENTROOT/mirmon/index.html
+  icons /mirmon/icons
+  probe /usr/bin/wget -q -O - -T %TIMEOUT% -t 1 %URL%TIME
+
+This assumes the project's timestamp is in file C<TIME>.
+
+=item * If you have rsync urls, change the probe line to :
+
+  probe perl /usr/local/src/mirmon/probe -t %TIMEOUT% %URL%TIME
+
+=item * Run mirmon :
+
+  perl mirmon -v -get all
+
+The mirmon report should now be in 'DOCUMENTROOT/mirmon/index.html'
+
+  http://www.your.project.org/mirmon/
+
+=item * If/when, at a later date, you want to upgrade mirmon :
+
+  cd /usr/local/src/mirmon
+  svn status -u
+  svn up
+
+=back
+
+=head1 SEE ALSO
+
+=begin html
+
+<A HREF="mirmon.pm.html">mirmon.pm(3)</A>
+
+=end html
+
+=begin man
+
+mirmon.pm(3)
+
+=end man
+
 =head1 AUTHOR
+
 =begin html
-<BLOCKQUOTE>
-  &copy; 2003
-  <A HREF="http://www.cs.uu.nl/staff/henkp.html">Henk P. Penning</A>,
+
+  &copy; 2003-2010
+  <A HREF="http://people.cs.uu.nl/henkp/">Henk P. Penning</A>,
   <A HREF="http://www.cs.uu.nl/">Computer Science Department</A>,
   <A HREF="http://www.uu.nl/">Utrecht University</A>
   <BR>
-  $Id: mirmon,v 1.37 2006/12/04 15:16:11 henkp Exp henkp $
-</BLOCKQUOTE>
+  mirmon-2.3 - Wed Mar 17 09:29:11 2010 ; henkp
+
 =end html
+
+=begin man
+
+  (c) 2003-2010 Henk P. Penning
+  Computer Science Department, Utrecht University
+  http://people.cs.uu.nl/henkp/ -- penning@cs.uu.nl
+  mirmon-2.3 - Wed Mar 17 09:29:11 2010 ; henkp
+
+=end man
+
 =begin text
-  (c) 2003 Henk P. Penning, Computer Science Department, Utrecht University
-  http://www.cs.uu.nl/staff/henkp.html -- penning@cs.uu.nl
+
+  (c) 2003-2010 Henk P. Penning
+  Computer Science Department, Utrecht University
+  http://people.cs.uu.nl/henkp/ -- penning@cs.uu.nl
+  mirmon-2.3 - Wed Mar 17 09:29:11 2010 ; henkp
+
 =end text
-=cut
\ No newline at end of file
+
+=cut