Updated mirmon to version 2.10

diff --git a/mirmon/countries.list b/mirmon/countries.list
index 988bea9547b6996571b75c7db70c1543137431f1..831fc6ef0754d638657e144fafcff484f4cfa29a 100644 (file)
--- a/mirmon/countries.list
+++ b/mirmon/countries.list
@@ -1,244 +1,250 @@
 # based on : http://www.iso.org/iso/list-en1-semic-3.txt
 # based on : http://www.iso.org/iso/list-en1-semic-3.txt

-ad - andorra
-ae - united arab emirates
-af - afghanistan
-ag - antigua and barbuda
-ai - anguilla
-al - albania
-am - armenia
-an - netherlands antilles
-ao - angola
-aq - antarctica
-ar - argentina
-as - american samoa
-at - austria
-au - australia
-aw - aruba
-az - azerbaijan
-ba - bosnia and herzegovina
-bb - barbados
-bd - bangladesh
-be - belgium
-bf - burkina faso
-bg - bulgaria
-bh - bahrain
-bi - burundi
-bj - benin
-bm - bermuda
-bn - brunei darussalam
-bo - bolivia, plurinational state of
-br - brazil
-bs - bahamas
-bt - bhutan
-bv - bouvet island
-bw - botswana
-by - belarus
-bz - belize
-ca - canada
-cc - cocos (keeling) islands
-cd - congo, the democratic republic of the
-cf - central african republic
-cg - congo
-ch - switzerland
-ck - cook islands
-cl - chile
-cm - cameroon
-cn - china
-co - colombia
-cr - costa rica
-cu - cuba
-cv - cape verde
-cx - christmas island
-cy - cyprus
-cz - czech republic
-de - germany
-dj - djibouti
-dk - denmark
-dm - dominica
-do - dominican republic
-dz - algeria
-ec - ecuador
-ee - estonia
-eg - egypt
-eh - western sahara
-er - eritrea
-es - spain
-et - ethiopia
-fi - finland
-fj - fiji
-fk - falkland islands (malvinas)
-fm - micronesia, federated states of
-fo - faroe islands
-fr - france
-ga - gabon
-gb - united kingdom
-gd - grenada
-ge - georgia
-gf - french guiana
-gg - guernsey
-gh - ghana
-gi - gibraltar
-gl - greenland
-gm - gambia
-gn - guinea
-gp - guadeloupe
-gq - equatorial guinea
-gr - greece
-gs - south georgia and the south sandwich islands
-gt - guatemala
-gu - guam
-gw - guinea-bissau
-gy - guyana
-hk - hong kong
-hm - heard island and mcdonald islands
-hn - honduras
-hr - croatia
-ht - haiti
-hu - hungary
-id - indonesia
-ie - ireland
-il - israel
-im - isle of man
-in - india
-io - british indian ocean territory
-iq - iraq
-ir - iran, islamic republic of
-is - iceland
-it - italy
-je - jersey
-jm - jamaica
-jo - jordan
-jp - japan
-ke - kenya
-kg - kyrgyzstan
-kh - cambodia
-ki - kiribati
-km - comoros
-kn - saint kitts and nevis
-kp - korea, democratic people's republic of
-kr - korea, republic of
-kw - kuwait
-ky - cayman islands
-kz - kazakhstan
-la - lao people's democratic republic
-lb - lebanon
-lc - saint lucia
-li - liechtenstein
-lk - sri lanka
-lr - liberia
-ls - lesotho
-lt - lithuania
-lu - luxembourg
-lv - latvia
-ly - libyan arab jamahiriya
-ma - morocco
-mc - monaco
-md - moldova, republic of
-me - montenegro
-mf - saint martin
-mg - madagascar
-mh - marshall islands
-mk - macedonia, the former yugoslav republic of
-ml - mali
-mm - myanmar
-mn - mongolia
-mo - macao
-mp - northern mariana islands
-mq - martinique
-mr - mauritania
-ms - montserrat
-mt - malta
-mu - mauritius
-mv - maldives
-mw - malawi
-mx - mexico
-my - malaysia
-mz - mozambique
-na - namibia
-nc - new caledonia
-ne - niger
-nf - norfolk island
-ng - nigeria
-ni - nicaragua
-nl - netherlands
-no - norway
-np - nepal
-nr - nauru
-nu - niue
-nz - new zealand
-om - oman
-pa - panama
-pe - peru
-pf - french polynesia
-pg - papua new guinea
-ph - philippines
-pk - pakistan
-pl - poland
-pm - saint pierre and miquelon
-pn - pitcairn
-pr - puerto rico
-ps - palestinian territory, occupied
-pt - portugal
-pw - palau
-py - paraguay
-qa - qatar
-ro - romania
-rs - serbia
-ru - russian federation
-rw - rwanda
-sa - saudi arabia
-sb - solomon islands
-sc - seychelles
-sd - sudan
-se - sweden
-sg - singapore
-sh - saint helena, ascension and tristan da cunha
-si - slovenia
-sj - svalbard and jan mayen
-sk - slovakia
-sl - sierra leone
-sm - san marino
-sn - senegal
-so - somalia
-sr - suriname
-st - sao tome and principe
-sv - el salvador
-sy - syrian arab republic
-sz - swaziland
-tc - turks and caicos islands
-td - chad
-tf - french southern territories
-tg - togo
-th - thailand
-tj - tajikistan
-tk - tokelau
-tl - timor-leste
-tm - turkmenistan
-tn - tunisia
-to - tonga
-tr - turkey
-tt - trinidad and tobago
-tv - tuvalu
-tw - taiwan, province of china
-tz - tanzania, united republic of
-ua - ukraine
-ug - uganda
-uk - united kingdom
-um - united states minor outlying islands
-us - united states
-uy - uruguay
-uz - uzbekistan
-va - holy see (vatican city state)
-vc - saint vincent and the grenadines
-ve - venezuela, bolivarian republic of
-vg - virgin islands, british
-vi - virgin islands, u.s.
-vn - viet nam
-vu - vanuatu
-wf - wallis and futuna
-ws - samoa
-ye - yemen
-yt - mayotte
-za - south africa
-zm - zambia
-zw - zimbabwe
+ad - Andorra
+ae - United Arab Emirates
+af - Afghanistan
+ag - Antigua and Barbuda
+ai - Anguilla
+al - Albania
+am - Armenia
+ao - Angola
+aq - Antarctica
+ar - Argentina
+as - American Samoa
+at - Austria
+au - Australia
+aw - Aruba
+ax - Åland Islands
+az - Azerbaijan
+ba - Bosnia and Herzegovina
+bb - Barbados
+bd - Bangladesh
+be - Belgium
+bf - Burkina Faso
+bg - Bulgaria
+bh - Bahrain
+bi - Burundi
+bj - Benin
+bl - Saint Barthélemy
+bm - Bermuda
+bn - Brunei Darussalam
+bo - Bolivia
+bq - Bonaire, Sint Eustatius and Saba
+br - Brazil
+bs - Bahamas
+bt - Bhutan
+bv - Bouvet Island
+bw - Botswana
+by - Belarus
+bz - Belize
+ca - Canada
+cc - Cocos (Keeling) Islands
+cd - Congo
+cf - Central African Republic
+cg - Congo
+ch - Switzerland
+ci - Côte d'Ivoire
+ck - Cook Islands
+cl - Chile
+cm - Cameroon
+cn - China
+co - Colombia
+cr - Costa Rica
+cu - Cuba
+cv - Cabo Verde
+cw - Curaçao
+cx - Christmas Island
+cy - Cyprus
+cz - Czech Republic
+de - Germany
+dj - Djibouti
+dk - Denmark
+dm - Dominica
+do - Dominican Republic
+dz - Algeria
+ec - Ecuador
+ee - Estonia
+eg - Egypt
+eh - Western Sahara
+er - Eritrea
+es - Spain
+et - Ethiopia
+fi - Finland
+fj - Fiji
+fk - Falkland Islands (Malvinas)
+fm - Micronesia, Federated States of
+fo - Faroe Islands
+fr - France
+ga - Gabon
+gd - Grenada
+ge - Georgia
+gf - French Guiana
+gg - Guernsey
+gh - Ghana
+gi - Gibraltar
+gl - Greenland
+gm - Gambia
+gn - Guinea
+gp - Guadeloupe
+gq - Equatorial Guinea
+gr - Greece
+gs - South Georgia and the South Sandwich Islands
+gt - Guatemala
+gu - Guam
+gw - Guinea-Bissau
+gy - Guyana
+hk - Hong Kong
+hm - Heard Island and Mcdonald Islands
+hn - Honduras
+hr - Croatia
+ht - Haiti
+hu - Hungary
+id - Indonesia
+ie - Ireland
+il - Israel
+im - Isle of Man
+in - India
+io - British Indian Ocean Territory
+iq - Iraq
+ir - Iran
+is - Iceland
+it - Italy
+je - Jersey
+jm - Jamaica
+jo - Jordan
+jp - Japan
+ke - Kenya
+kg - Kyrgyzstan
+kh - Cambodia
+ki - Kiribati
+km - Comoros
+kn - Saint Kitts and Nevis
+kp - Korea, Democratic People's Republic of
+kr - Korea, Republic of
+kw - Kuwait
+ky - Cayman Islands
+kz - Kazakhstan
+la - Lao People's Democratic Republic
+lb - Lebanon
+lc - Saint Lucia
+li - Liechtenstein
+lk - Sri Lanka
+lr - Liberia
+ls - Lesotho
+lt - Lithuania
+lu - Luxembourg
+lv - Latvia
+ly - Libya
+ma - Morocco
+mc - Monaco
+md - Moldova
+me - Montenegro
+mf - Saint Martin (French Part)
+mg - Madagascar
+mh - Marshall Islands
+mk - Macedonia
+ml - Mali
+mm - Myanmar
+mn - Mongolia
+mo - Macao
+mp - Northern Mariana Islands
+mq - Martinique
+mr - Mauritania
+ms - Montserrat
+mt - Malta
+mu - Mauritius
+mv - Maldives
+mw - Malawi
+mx - Mexico
+my - Malaysia
+mz - Mozambique
+na - Namibia
+nc - New Caledonia
+ne - Niger
+nf - Norfolk Island
+ng - Nigeria
+ni - Nicaragua
+nl - Netherlands
+no - Norway
+np - Nepal
+nr - Nauru
+nu - Niue
+nz - New Zealand
+om - Oman
+pa - Panama
+pe - Peru
+pf - French Polynesia
+pg - Papua New Guinea
+ph - Philippines
+pk - Pakistan
+pl - Poland
+pm - Saint Pierre and Miquelon
+pn - Pitcairn
+pr - Puerto Rico
+ps - Palestine
+pt - Portugal
+pw - Palau
+py - Paraguay
+qa - Qatar
+re - Réunion
+ro - Romania
+rs - Serbia
+ru - Russian Federation
+rw - Rwanda
+sa - Saudi Arabia
+sb - Solomon Islands
+sc - Seychelles
+sd - Sudan
+se - Sweden
+sg - Singapore
+sh - Saint Helena, Ascension and Tristan da Cunha
+si - Slovenia
+sj - Svalbard and Jan Mayen
+sk - Slovakia
+sl - Sierra Leone
+sm - San Marino
+sn - Senegal
+so - Somalia
+sr - Suriname
+ss - South Sudan
+st - Sao Tome and Principe
+sv - El Salvador
+sx - Sint Maarten (Dutch Part)
+sy - Syrian Arab Republic
+sz - Swaziland
+tc - Turks and Caicos Islands
+td - Chad
+tf - French Southern Territories
+tg - Togo
+th - Thailand
+tj - Tajikistan
+tk - Tokelau
+tl - Timor-Leste
+tm - Turkmenistan
+tn - Tunisia
+to - Tonga
+tr - Turkey
+tt - Trinidad and Tobago
+tv - Tuvalu
+tw - Taiwan
+tz - Tanzania
+ua - Ukraine
+ug - Uganda
+uk - United Kingdom
+um - United States Minor Outlying Islands
+us - United States
+uy - Uruguay
+uz - Uzbekistan
+va - Holy See (Vatican City State)
+vc - Saint Vincent and the Grenadines
+ve - Venezuela
+vg - Virgin Islands, British
+vi - Virgin Islands, U.S.
+vn - Viet Nam
+vu - Vanuatu
+wf - Wallis and Futuna
+ws - Samoa
+ye - Yemen
+yt - Mayotte
+za - South Africa
+zm - Zambia
+zw - Zimbabwe

diff --git a/mirmon/mirmon b/mirmon/mirmon
index 27175e3d33b3820d720476bc6968b0e0e854421c..392d51021e5344a3bfbbf927aba965c991c52c91 100755 (executable)
--- a/mirmon/mirmon
+++ b/mirmon/mirmon
@@ -1,8 +1,9 @@
 #! /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
+# Copyright (c) 2003-2014 Henk Penning, all rights reserved.
+# penning@uu.nl, http://www.staff.science.uu.nl/~penni101/

 # Version 1.1 was donated to the Apache Software Foundation 2003 Jan 28.
 # 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
 # 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


@@ -28,16 +29,16 @@
 use strict ;
 
 our $PRG = 'mirmon' ;
 use strict ;
 
 our $PRG = 'mirmon' ;

-our $VER = "2.3" ;
+our $VER = "2.10" ;

 
 our $DEF_TIMEOUT = 300 ;
 our $HIST        = 14 ;
 our $TIM_PAT     = '^(\d+)([smhd])$' ;
 
 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 %APA_TYPES   = () ; $APA_TYPES { $_ } ++ for qw(backup ftp http rsync) ;
+our %GET_OPTS    = () ; $GET_OPTS  { $_ } ++ for qw(all update url) ;

 our $HIST_DELTA  = 24 * 60 * 60 ;
 our $HIST_DELTA  = 24 * 60 * 60 ;

-our $APRX_DELTA  = 60 ;
-our $HOME        = 'http://www.cs.uu.nl/people/henkp/mirmon/' ;
+our $APRX_DELTA  = 300 ;
+our $HOME        = 'http://www.staff.science.uu.nl/~penni101/mirmon/' ;

 
 package Base ; #####################################################
 
 
 package Base ; #####################################################
 


@@ -211,7 +212,7 @@ sub find_config
   { my $self = shift ;
     my $arg = shift ;
     my @LIST = $arg ? ( $arg ) : Mirmon -> config_list ;
   { my $self = shift ;
     my $arg = shift ;
     my @LIST = $arg ? ( $arg ) : Mirmon -> config_list ;

-    for my $conf ( @LIST ) { return $conf if -f $conf ; }
+    for my $conf ( @LIST ) { return $conf if -r $conf and ! -d $conf ; }

     die sprintf "can't find a config file :\n  %s\n" , join "\n  ", @LIST ;
   }
 
     die sprintf "can't find a config file :\n  %s\n" , join "\n  ", @LIST ;
   }
 


@@ -225,6 +226,7 @@ sub get_config
 sub get_state
   { my $self = shift ;
     my $conf = $self -> conf ;
 sub get_state
   { my $self = shift ;
     my $conf = $self -> conf ;

+    my $name = $conf -> project_name ;

     my $state = $conf -> state ;
     my $res = {} ;
     open STATE, $state or die "can't open $state ($!)" ;
     my $state = $conf -> state ;
     my $res = {} ;
     open STATE, $state or die "can't open $state ($!)" ;


@@ -238,6 +240,7 @@ sub get_state
     my $mlist = $conf -> mirror_list ;
     my $style = $conf -> list_style ;
     my %in_list = () ;
     my $mlist = $conf -> mirror_list ;
     my $style = $conf -> list_style ;
     my %in_list = () ;

+    my $changes = '' ;

     open MLIST, $mlist or die "can't open $mlist ($!)" ;
     for my $line ( <MLIST> )
       { chop $line ;
     open MLIST, $mlist or die "can't open $mlist ($!)" ;
     for my $line ( <MLIST> )
       { chop $line ;


@@ -264,7 +267,7 @@ sub get_state
         $in_list { $url } ++ ;
 
         unless ( exists $res -> { $url } )
         $in_list { $url } ++ ;
 
         unless ( exists $res -> { $url } )

-          { printf "*** added to list %s\n", $url unless Mirmon::quiet ;
+          { $changes .= sprintf "added %s\n", $url unless Mirmon::quiet ;

             $res -> { $url } = Mirmon::Mirror -> init ( $self, $url ) ;
           }
         my $mirror = $res -> { $url } ;
             $res -> { $url } = Mirmon::Mirror -> init ( $self, $url ) ;
           }
         my $mirror = $res -> { $url } ;


@@ -276,10 +279,12 @@ sub get_state
     for my $url ( sort keys %$res )
       { # printf "%s\n", $res -> { $url } -> state ;
         unless ( exists $in_list { $url } )
     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 ;
+          { $changes .= sprintf "removed %s\n", $url unless Mirmon::quiet ;

             delete $res -> { $url } ;
           }
       }
             delete $res -> { $url } ;
           }
       }

+    printf "changes in mirror-list for '%s':\n%s", $name, $changes
+      if $changes ;

     $self -> state ( $res ) ;
   }
 
     $self -> state ( $res ) ;
   }
 


@@ -309,73 +314,175 @@ sub get_regions
       { chop ;
         next if /^#/ ;
         my ( $code, $dash, $reg ) = split ' ', $_, 3 ;
       { chop ;
         next if /^#/ ;
         my ( $code, $dash, $reg ) = split ' ', $_, 3 ;

-        $self -> { regions } { lc $code } = lc $reg ;
+        $self -> { regions } { lc $code } = $reg ;

       }
     close REGS ;
   }
 
       }
     close REGS ;
   }
 

+sub _cmp_ccs
+  { my $ccs = shift ;
+    my $x  = shift ;
+    my $y  = shift ;
+    my $xx = $ccs -> { $x } ;
+    my $yy = $ccs -> { $y } ;
+    if ( ! defined $xx and ! defined $yy )
+      { $x cmp $y ; }
+    elsif ( ! defined $xx )
+      { -1 ; }
+    elsif ( ! defined $yy )
+      { +1 ; }
+    else
+      { $xx cmp $yy ; }
+  }
+
+sub _pr_round
+  { my $x = shift ;
+    my $i = int $x ;
+    my $f = $x - $i ;
+    $i + ( rand 1 < $f ? 1 : 0 ) ;
+  }
+
+sub _diag_qs
+  { my $qs = shift ;
+    join ', ', map { sprintf "%s %s" , $_, scalar @{ $qs -> { $_ } } ; }
+      sort keys %$qs ;
+  }
+
+sub _rpick
+  { my $row = shift ;
+    die "_rpick : row empty" unless @$row ;
+    my $idx = int rand @$row ;
+    my $res = $row -> [ $idx ] ;
+    $row -> [ $idx ] = $row -> [ $#{$row} ] ;
+    pop @$row ;
+    $res ;
+  }
+
+sub _buck_split
+  { my $que = shift ;
+    my $tmp = [] ;
+    for my $mirr ( @$que )
+      { my $lp = $mirr -> last_probe ;
+        my $hr = int ( ( $^T - $lp ) / 60 / 60 + 0.5 ) ;
+        push @{ $tmp -> [ $hr ] }, $mirr ;
+      }
+    [ grep defined $_, @$tmp ] ;
+  }
+
+sub _buck_join
+  { my $bucks = shift ;
+    my $res = [] ;
+    push @$res, @$_ for @$bucks ;
+    $res ;
+  }
+
+sub _buck_pick
+  { my $bucks = shift ;
+    die "buck_pick : bucks empty" unless @$bucks ;
+    my $buck = ( sort { @$b <=> @$a } @$bucks ) [ 0 ] ;
+    _rpick $buck ;
+  }
+
+sub _randomize
+  { my $ques = shift ;
+    my $poll = shift ;
+    my $hrs  = int ( $poll / 60 / 60 + 0.5 ) ;
+
+    my $diag1 = _diag_qs $ques ;
+
+    my $todos = $ques -> { todo } ;
+    my $dones = $ques -> { done } ;
+    my $cnt   = @$todos + @$dones ;
+    my $avg   = $hrs ? $cnt / $hrs : 0 ;
+    my $iavg  = _pr_round $avg ;
+    my $pick  = 0 ;
+    my $bucks = _buck_split $dones ;
+
+    while ( @$todos < $iavg and $pick < @$dones )
+      { push @$todos, _buck_pick $bucks ;
+        $pick ++ ;
+      }
+
+    $ques -> { done } = _buck_join $bucks ;
+
+    sprintf ''
+      . "  hrs %s, %s\n"
+      . "  avg %.2f -> %d , picked %d ; queued %s\n"
+      . "  hrs %s, %s\n"
+      , $hrs, $diag1
+      , $avg, $iavg, $pick, scalar @$todos
+      , $hrs, _diag_qs ( $ques )
+      ;
+  }
+

 sub get_dates
   { my $self  = shift ;
     my $get   = shift ;
 sub get_dates
   { my $self  = shift ;
     my $get   = shift ;

+    my $URL   = shift ;

     my $state = $self -> state ;
     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 $conf  = $self -> conf ;
+    my $CMD   = $conf -> probe ;
+    my $PAR   = $conf -> max_probes ;
+    my %m4h   = () ;
+    my @QUE   = () ;
+    my $GET   = IO::Select -> new () ;
+    my $ques  = {} ;
+    for my $col ( qw(new red grn xtr) )
+      { $ques -> { $col } { $_ } = [] for qw(done todo) ; }
+    my $max_poll = s4tim $conf -> max_poll ;
+    my $min_poll = s4tim $conf -> min_poll ;
+
+    if ( Mirmon::verbose ) { printf "mirrors %d\n", scalar keys %$state ; }
+
+    if ( $get eq 'all' )
+      { @QUE = sort { $a -> url cmp $b -> url } values %$state ; }
+    elsif ( $get eq 'url' )
+      { @QUE = ( $state -> { $URL } ) ; }
+    elsif ( $get eq 'update' )
+      { my $maxp = $^T - $max_poll ;
+        my $minp = $^T - $min_poll ;
+
+if ( Mirmon::verbose )
+  { printf "max_poll %s\n", scalar localtime $maxp ;
+    printf "min_poll %s\n", scalar localtime $minp ;
+  }
+        for my $url ( sort keys %$state )
+          { my $mirror = $state -> { $url } ;
+            my $stat = $mirror -> last_status ;

             my $vrfy = $mirror -> last_ok_probe ;
             my $lprb = $mirror -> last_probe ;
             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 ; }
+            my $col ;
+            my $que ;
+            if ( $stat eq 'undef' ) # never probed ; new mirror ; todo
+              { $col = 'new' ; $que = 'todo' ; }
+            elsif ( $conf -> get_xtr ( $mirror -> region ) )
+              { $col = 'xtr' ; $que = 'todo' ; }
+            else
+              { my $poll = $stat eq 'ok' ? $maxp : $minp ;
+                $col     = $stat eq 'ok' ? 'grn' : 'red' ;
+                $que     = ( aprx_le $lprb, $poll ) ? 'todo' : 'done' ;

               }
               }

+            push @{ $ques -> { $col } { $que } }, $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 ++ ;
+        if ( $conf -> randomize )
+          { my $msg = "randomize green\n" ;
+            $msg .= _randomize $ques -> { grn }, $max_poll ;
+            $msg .= "randomize red\n" ;
+            $msg .= _randomize $ques -> { red }, $min_poll ;
+            print $msg if Mirmon::verbose ;

           }
           }

-
-        printf "avg mirrors/hr %d, max extras %d, picked %d ; queued %s\n"
-          , $avg, $extras, $picked, scalar @QUE if Mirmon::verbose ;
+        @QUE =
+          ( @{ $ques -> { new } { todo } }
+          , @{ $ques -> { red } { todo } }
+          , @{ $ques -> { grn } { todo } }
+          , @{ $ques -> { xtr } { todo } }
+          ) ;

       }
       }

+    else
+      { die "unknown opt_get '$get'" ; }
+
+    if ( Mirmon::verbose ) { printf "queued %d\n\n", scalar @QUE ; }

 
     while ( @QUE )
       { my $started = 0 ;
 
     while ( @QUE )
       { my $started = 0 ;


@@ -871,7 +978,8 @@ sub gen_histogram
       { $res .= sprintf "<BR>each %s unit represents %s mirror sites.\n"
           , $units, sprintf ( "%.1f", $max / $H ) ;
       }
       { $res .= sprintf "<BR>each %s unit represents %s mirror sites.\n"
           , $units, sprintf ( "%.1f", $max / $H ) ;
       }

-    return H2 ( 'age histogram' ) . BQ $res ;
+    return H2 ( NAM 'age-histogram', 'age histogram' )
+      . BQ $res ;

   }
 
 sub gen_page
   }
 
 sub gen_page


@@ -1020,10 +1128,11 @@ $histo_top
 HEAD
 
     for my $reg
 HEAD
 
     for my $reg

-      ( sort
-       { ( $CCS -> { $a } || $a ) cmp ( $CCS -> { $b } || $b ) ; }
-       keys %tab
-      )
+      ( sort { _cmp_ccs $CCS, $a, $b } keys %tab )
+#      { ( $CCS -> { $a } ? lc ( $CCS -> { $a } ) : $a )
+#    cmp ( $CCS -> { $b } ? lc ( $CCS -> { $b } ) : $b )
+#      } keys %tab
+#     )

       { my $mirrors = $tab { $reg } ;
 
         my $ccs = exists $CCS -> { $reg } ? $CCS -> { $reg } : $reg ;
       { my $mirrors = $tab { $reg } ;
 
         my $ccs = exists $CCS -> { $reg } ? $CCS -> { $reg } : $reg ;


@@ -1038,8 +1147,8 @@ HEAD
         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"
         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 -> url_site
+              , $mirror -> url_home

               , $mirror -> type
               ;
 
               , $mirror -> type
               ;
 


@@ -1118,6 +1227,7 @@ our %CNF_defaults =
   , htm_top      => ''
   , htm_foot     => ''
   , htm_head     => ''
   , htm_top      => ''
   , htm_foot     => ''
   , htm_head     => ''

+  , always_get   => ''

   ) ;
 
 our @REQ_KEYS =
   ) ;
 
 our @REQ_KEYS =


@@ -1132,6 +1242,12 @@ my @PUT_HGRAM  = qw(top bottom nowhere) ;
 
 eval Base -> mk_methods ( keys %CNF_KEYS, qw(root site_url) ) ;
 
 
 eval Base -> mk_methods ( keys %CNF_KEYS, qw(root site_url) ) ;
 

+sub get_xtr
+  { my $self = shift ;
+    my $reg  = shift ;
+    scalar grep { $_ eq $reg } split ' ', $self -> always_get ;
+  }
+

 sub new
   { my $self = shift ;
     my $FILE = shift ;
 sub new
   { my $self = shift ;
     my $FILE = shift ;


@@ -1293,15 +1409,18 @@ sub state_history_hist
 sub _parse
   { my $self = shift ;
     my $url  = $self -> url ;
 sub _parse
   { my $self = shift ;
     my $url  = $self -> url ;

-    my ( $type, $site, $home ) ;
+    my ( $type, $site, $home, $path ) ;

     if ( $url =~ m!^(ftp|https?|rsync)://([^/:]+)(:\d+)?/! )
     if ( $url =~ m!^(ftp|https?|rsync)://([^/:]+)(:\d+)?/! )

-      { $type = $1 ; $site = $2 ; $home = $& ; }
-    return $type, $site, $home ;
+      { $type = $1 ; $site = $2 ; $home = $& ; $path = $' ; }
+    else
+      { warn "can't parse url ($url)" ; }
+    return $type, $site, $home, $path ;

   }
 
 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 type { my $self = shift ; ( $self -> _parse ) [ 0 ] ; }
 sub site { my $self = shift ; ( $self -> _parse ) [ 1 ] ; }
 sub home { my $self = shift ; ( $self -> _parse ) [ 2 ] ; }

+sub path { my $self = shift ; ( $self -> _parse ) [ 3 ] ; }

 
 sub age_in_days
   { my $self = shift ;
 
 sub age_in_days
   { my $self = shift ;


@@ -1429,7 +1548,7 @@ sub finish_probe
         if ( $res !~ /^\d+$/ )
           { $res =~ s/ /_/g ;
             $res = Base::htmlquote $res ;
         if ( $res !~ /^\d+$/ )
           { $res =~ s/ /_/g ;
             $res = Base::htmlquote $res ;

-            $res = substr ( $time, 0, 15 ) . '..' if length $res > 15 ;
+            $res = substr ( $res, 0, 15 ) . '..' if length $res > 15 ;

             $stat = "'$res'" ;
           }
         else
             $stat = "'$res'" ;
           }
         else


@@ -1463,8 +1582,26 @@ sub _url
     $hrf =~ /^rsync/ ? $txt : URL $hrf, $txt ;
   }
 
     $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, '@' ; }
+sub url_site
+  { my $self = shift ;
+    my $type = $self -> type ;
+    if ( $type eq 'rsync' )
+      { my $path = $self -> path ;
+        chop $path if $path =~ m!/$! ;
+        sprintf '%s::%s', $self -> site , $path ;
+      }
+    else
+      { URL $self -> url , $self -> site ; }
+  }
+
+sub url_home
+  { my $self = shift ;
+    my $type = $self -> type ;
+    if ( $type eq 'rsync' )
+      { '@' ; }
+    else
+      { URL $self -> home, '@' ; }
+  }

 
 =pod
 
 
 =pod
 


@@ -1537,9 +1674,10 @@ Returns a hashref C<< { country_code =E<gt> country_name, ... } >>.
 
 Returns the list of default locations for config files.
 
 
 Returns the list of default locations for config files.
 

-=item B<get_dates ( $get )>
+=item B<get_dates ( $get [, $URL] )>

 
 

-Probes all mirrors if $get is C<all> ; or a subset if $get is C<update>.
+Probes all mirrors if $get is C<all> ; or a subset if $get is C<update> ;
+or only I<$URL> if $get is C<url>.

 
 =back
 
 
 =back
 


@@ -1587,7 +1725,7 @@ The url as given in the mirror list.
 
 =item B<age>
 
 
 =item B<age>
 

-The mirror's timestamp found by the last succesful probe,
+The mirror's timestamp found by the last successful probe,

 or 'undef' if no probe was ever successful.
 
 =item B<last_status>
 or 'undef' if no probe was ever successful.
 
 =item B<last_status>


@@ -1596,7 +1734,7 @@ The status of the last probe, or 'undef' if the mirror was never probed.
 
 =item B<last_ok_probe>
 
 
 =item B<last_ok_probe>
 

-The timestamp of the last succesful probe or 'undef'
+The timestamp of the last successful probe or 'undef'

 if the mirror was never successfully probed.
 
 =item B<probe_history>
 if the mirror was never successfully probed.
 
 =item B<probe_history>


@@ -1684,7 +1822,9 @@ and updates the state of the mirror.
 
 =begin html
 
 
 =begin html
 

-<A HREF="mirmon.html">mirmon(1)</A>
+<p>
+<a href="mirmon.html">mirmon(1)</a>
+</p>

 
 =end html
 
 
 =end html
 


@@ -1698,30 +1838,33 @@ mirmon(1)
 
 =begin html
 
 
 =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
+  <p>
+  &copy; 2003-2014
+  <a href="http://www.staff.science.uu.nl/~penni101/">Henk P. Penning</a>,
+  <a href="http://www.uu.nl/faculty/science/EN/">Faculty of Science</a>,
+  <a href="http://www.uu.nl/">Utrecht University</a>
+  <br />
+  mirmon-2.10 - Fri Aug 15 12:26:55 2014 ; henkp ;
+  <a href="http://validator.w3.org/check?uri=referer">verify html</a>
+  </p>

 
 =end html
 
 =begin man
 
 
 =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
+  (c) 2003-2014 Henk P. Penning
+  Faculty of Science, Utrecht University
+  http://www.staff.science.uu.nl/~penni101/ -- penning@uu.nl
+  mirmon-2.10 - Fri Aug 15 12:26:55 2014 ; henkp

 
 =end man
 
 =begin text
 
 
 =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
+  (c) 2003-2014 Henk P. Penning
+  Faculty of Science, Utrecht University
+  http://www.staff.science.uu.nl/~penni101/ -- penning@uu.nl
+  mirmon-2.10 - Fri Aug 15 12:26:55 2014 ; henkp

 
 =end text
 
 
 =end text
 


@@ -1733,18 +1876,19 @@ use IO::Pipe ;
 use IO::Select ;
 use Net::hostent ;
 
 use IO::Select ;
 use Net::hostent ;
 

-my $VERSION = Base::Version . ' - Wed Mar 17 09:29:11 2010 - henkp' ;
+my $VERSION = Base::Version . ' - Fri Aug 15 12:26:55 2014 - henkp' ;

 my $DEF_CNF = join ', ', Mirmon -> config_list ;
 my $TIMEOUT = Base::DEF_TIMEOUT ;
 
 my $prog = substr $0, rindex ( $0, '/' ) + 1 ;
 my $Usage = <<USAGE ;
 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 ]
+Usage: $prog [-v] [-q] [-t timeout] [-c conf] [-get all|update|url <url>]

 option v   : be verbose
 option q   : be quiet
 option t   : set timeout ; default $TIMEOUT
 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 get : get all       : probe all sites
+           : get update    : probe a selection of the sites (see doc)
+           : get url <url> : probe some <url> (in the mirror-list).

 option c   : configuration file ; default search :
              ( $DEF_CNF )
 -------------------------------------------------------------------
 option c   : configuration file ; default search :
              ( $DEF_CNF )
 -------------------------------------------------------------------


@@ -1766,23 +1910,30 @@ 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) ) ;
 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 ;
+Usage "Arg count\n" if @ARGV > 1 ;
+Usage "Arg count\n" if $opt{get} and $opt{get} eq 'url' and ! @ARGV ;

 
 if ( $opt{version} ) { printf "%s\n", Base::version () ; exit ; }
 
 $opt{v} ||= $opt{d} ;
 
 
 if ( $opt{version} ) { printf "%s\n", Base::version () ; exit ; }
 
 $opt{v} ||= $opt{d} ;
 

+my $URL = shift ;
+
+my $M = Mirmon -> new ( $opt{c} ) ;
+$M -> conf -> timeout ( $opt{t} ) if $opt{t} ;
+

 my $get = $opt{get} ;
 my $get = $opt{get} ;

-if ( $get and ! Base::is_get_opt ( $get ) )
-  { Error "unknown 'get option' '$get'" ; }
+if ( $get )
+  { Error "url $URL not in list"
+      if $get eq 'url' and ! $M -> state -> { $URL } ;
+    Error "unknown 'get option' '$get'" unless Base::is_get_opt ( $get ) ;
+  }

 
 Mirmon::verbose ( $opt{v} ) ;
 Mirmon::debug   ( $opt{d} ) ;
 Mirmon::quiet   ( $opt{q} ) ;
 
 
 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 ; }
+if ( $get ) { $M -> get_dates ( $get, $URL ) ; $M -> put_state ; }

 $M -> gen_page ( $get, $VERSION ) ;
 
 __END__
 $M -> gen_page ( $get, $VERSION ) ;
 
 __END__


@@ -1795,20 +1946,38 @@ mirmon - monitor the state of mirrors
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

-  mirmon [ -v ] [ -q ] [ -t timeout ] [ -get opt ] [ -c conf ]
+  mirmon [-v] [-q] [-t timeout] [-c conf] [-get all|update|url url]

 
 =head1 OPTIONS
 
 
 =head1 OPTIONS
 

-  option v   : be verbose
-  option q   : be quiet
-  option t   : set timeout [ default 300 ] ;
-  option get : 'all'    : probe all sites
-             : 'update' : probe a selection of the sites (see doc)
-  option c   : configuration file ; default list :
-               ./mirmon.conf $HOME/.mirmon.conf /etc/mirmon.conf
-  -------------------------------------------------------------------
-  Mirmon normally only reports errors and changes in the mirror list.
-  -------------------------------------------------------------------
+=over 4
+
+=item B<-v>
+
+Be verbose ; B<mirmon> normally only reports
+errors and changes in the mirror list.
+
+=item B<-q>
+
+Be quiet.
+
+=item B<-t> I<timeout>
+
+Set the timeout ; the default is I<300>.
+
+=item B<-get> all | update | url <url>
+
+With B<all>, probe all sites.
+With B<update>, probe a selection of the sites ; see option C<max_poll> below.
+With B<url>, probe only the given I<url>, which must appear in the mirror-list.
+
+=item B<-c> I<name>
+
+Use config file I<name>. The default list is
+
+  ./mirmon.conf $HOME/.mirmon.conf /etc/mirmon.conf
+
+=back

 
 =head1 USAGE
 
 
 =head1 USAGE
 


@@ -1890,22 +2059,24 @@ A config file looks like this :
   |. part3
   +--------------------------------------------------
 
   |. part3
   +--------------------------------------------------
 

-=head1 CONFIG FILE : required entries
+=head2 required entries

 
 

-=head2 project_name I<name>
+=over 4
+
+=item project_name I<name>

 
 Specify a short plaintext name for the project.
 
   project_name Apache
   project_name CTAN
 
 
 Specify a short plaintext name for the project.
 
   project_name Apache
   project_name CTAN
 

-=head2 project_url I<url>
+=item project_url I<url>

 
 Specify an url pointing to the 'home' of the project.
 
   project_url http://www.apache.org/
 
 
 Specify an url pointing to the 'home' of the project.
 
   project_url http://www.apache.org/
 

-=head2 mirror_list I<file-name>
+=item mirror_list I<file-name>

 
 Specify the file containing the mirrors to probe.
 
 
 Specify the file containing the mirrors to probe.
 


@@ -1935,14 +2106,14 @@ Two formats are supported :
 Note that in style 'plain' the third item is reserved for an
 optional email address : the site's contact address.
 
 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).
+Specify the required format with option C<list_style> (see below).

 The default style is 'plain'.
 
 The default style is 'plain'.
 

-=head2 web_page I<file-name>
+=item web_page I<file-name>

 
 Specify where the html report page is written.
 
 
 Specify where the html report page is written.
 

-=head2 icons I<directory-name>
+=item icons I<directory-name>

 
 Specify the directory where the icons can be found,
 relative to the I<web_page>, or relative to the
 
 Specify the directory where the icons can be found,
 relative to the I<web_page>, or relative to the


@@ -1958,20 +2129,20 @@ If/when the icons live in C</path/to/DOCUMENTROOT/icons/mirmon/>, specify
 
   icons /icons/mirmon
 
 
   icons /icons/mirmon
 

-=head2 probe I<program + arguments>
+=item probe I<program + arguments>

 
 Specify the program+args to probe the mirrors. Example:
 
 
 Specify the program+args to probe the mirrors. Example:
 

-  probe /usr/bin/wget -q -O - -T %TIMEOUT% -t 1 %URL%TIME
+  probe /usr/bin/wget -q -O - -T %TIMEOUT% -t 1 %URL%TIME.txt

 
 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
 
 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 timestamp in /path/to/archive/TIME.txt, for instance with

 a crontab entry like
 
 a crontab entry like
 

-  42 * * * * perl -e 'printf "%s\n", time' > /path/to/archive/TIME
+  42 * * * * perl -e 'print time, "\n"' > /path/to/archive/TIME.txt

 
 Mirmon reads one line of output from the probe and interprets
 the first word on that line as a timestamp ; for example :
 
 Mirmon reads one line of output from the probe and interprets
 the first word on that line as a timestamp ; for example :


@@ -1983,37 +2154,45 @@ the first word on that line as a timestamp ; for example :
 Mirmon is distributed with a program C<probe> that handles
 ftp, http and rsync urls.
 
 Mirmon is distributed with a program C<probe> that handles
 ftp, http and rsync urls.
 

-=head2 state I<file-name>
+=item 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).
 
 
 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>
+=item countries I<file-name>

 
 Specify the file containing the country codes;
 The file should contain lines like
 
 
 Specify the file containing the country codes;
 The file should contain lines like
 

-  us - united states
-  nl - netherlands
+  us - United States
+  nl - Netherlands

 
 The mirmon package contains a recent ISO list.
 
 
 The mirmon package contains a recent ISO list.
 

-=head1 CONFIG FILE : optional entries
+I<Fake> domains like I<Backup>, I<Master> are allowed,
+and are listed first in the report ; lowercase-first
+fake domains (like I<backup>) are listed last.
+
+=back
+
+=head2 optional entries

 
 

-=head2 max_probes I<number>
+=over 4
+
+=item max_probes I<number>

 
 Optionally specify the number of parallel probes (default 25).
 
 
 Optionally specify the number of parallel probes (default 25).
 

-=head2 timeout I<seconds>
+=item 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.
 
 
 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>
+=item project_logo I<logo>

 
 Optionally specify (the SRC of the IMG of) a logo to be placed
 top right on the page.
 
 Optionally specify (the SRC of the IMG of) a logo to be placed
 top right on the page.


@@ -2021,20 +2200,20 @@ top right on the page.
   project_logo /icons/apache.gif
   project_logo http://www.apache.org/icons/...
 
   project_logo /icons/apache.gif
   project_logo http://www.apache.org/icons/...
 

-=head2 htm_head I<html>
+=item htm_head I<html>

 
 Optionally specify some HTML to be placed before </HEAD>.
 
   htm_head
     <link REL=StyleSheet HREF="/style.css" TYPE="text/css">
 
 
 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>
+=item htm_top I<html>

 
 Optionally specify some HTML to be placed near the top of the page.
 
   htm_top testing 1, 2, 3
 
 
 Optionally specify some HTML to be placed near the top of the page.
 
   htm_top testing 1, 2, 3
 

-=head2 htm_foot I<html>
+=item htm_foot I<html>

 
 Optionally specify HTML to be placed near the bottom of the page.
 
 
 Optionally specify HTML to be placed near the bottom of the page.
 


@@ -2043,18 +2222,18 @@ Optionally specify HTML to be placed near the bottom of the page.
     <A HREF="..."><IMG SRC="..." BORDER=0></A>
     <HR>
 
     <A HREF="..."><IMG SRC="..." BORDER=0></A>
     <HR>
 

-=head2 put_histo top|bottom|nowhere
+=item put_histo top|bottom|nowhere

 
 Optionally specify where the age histogram must be placed.
 The default is 'top'.
 
 
 Optionally specify where the age histogram must be placed.
 The default is 'top'.
 

-=head2 min_poll I<time-spec>
+=item 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).
 
 
 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>
+=item 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 :
 
 Optionally specify the maximum probe interval. When the program is
 called with option '-get update', all sites are probed which are :


@@ -2087,35 +2266,37 @@ 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).
 
 The default 'min_poll' is '1h' (1 hour).
 The default 'max_poll' is '4h' (4 hours).
 

-=head2 min_sync I<time-spec>
+=item 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).
 
 
 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>
+=item 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).
 
 
 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
+=item always_get I<region ...>

 
 

-To balance the probe load over the hourly mirmon runs,
-mirmon may probe a few extra randomly choosen mirrors :
+Optionally specify a list of regions that must be probed always.

 
 

-=over 4
+  always_get Master Tier1

 
 

-=item * only if the the number of mirrors to probe is below average,
+This is intended for I<fake regions> like I<Master> etc.

 
 

-=item * at most 2% of the mirrors
+=item no_randomize

 
 

-=back
+Mirmon tries to balance the probe load over the hourly mirmon runs.
+If the current run has a below average number of mirrors to probe,
+mirmon probes a few extra, randomly chosen mirrors, picked from the
+runs that have the highest load.

 
 If you don't want this behaviour, use B<no_randomize>.
 
 
 If you don't want this behaviour, use B<no_randomize>.
 

-=head2 no_add_slash
+=item 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
 
 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


@@ -2123,14 +2304,14 @@ unless it is in quiet mode.
 
 If you don't want this behaviour, use B<no_add_slash>.
 
 
 If you don't want this behaviour, use B<no_add_slash>.
 

-=head2 list_style plain|apache
+=item 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'.
 
 
 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>
+=item site_url I<site> I<url>

 
 Optionally specify a substitute url for a site.
 
 
 Optionally specify a substitute url for a site.
 


@@ -2138,11 +2319,11 @@ 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 '/'.
 
 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>
+=item env I<key> I<value>

 
 Optionally specify an environment variable.
 
 
 Optionally specify an environment variable.
 

-=head2 include I<file-name>
+=item include I<file-name>

 
 Optionally specify a file to include.
 
 
 Optionally specify a file to include.
 


@@ -2152,17 +2333,19 @@ C<include> was encountered.
 The include depth is unlimited. However, it is a fatal error to
 include a file twice under the same name.
 
 The include depth is unlimited. However, it is a fatal error to
 include a file twice under the same name.
 

-=head2 show
+=item show

 
 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.
 
 
 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
+=item 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.
 

+=back
+

 =head1 STATE FILE FORMAT
 
 The state file consists of lines; one line per site.
 =head1 STATE FILE FORMAT
 
 The state file consists of lines; one line per site.


@@ -2177,16 +2360,16 @@ The url as given in the mirror list.
 
 =item * field 2 : age
 
 
 =item * field 2 : age
 

-The mirror's timestamp found by the last succesful probe,
+The mirror's timestamp found by the last successful 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.
 
 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
+=item * field 4 : time last successful probe

 
 

-The timestamp of the last succesful probe or 'undef'
+The timestamp of the last successful probe or 'undef'

 if the mirror was never successfully probed.
 
 =item * field 5 : probe history
 if the mirror was never successfully probed.
 
 =item * field 5 : probe history


@@ -2227,11 +2410,11 @@ The timestamp of the last probe, or 'undef' if the mirror was never probed.
 
 =item * The mirmon repository is here :
 
 
 =item * The mirmon repository is here :
 

-  https://subversion.cs.uu.nl/repos/staff.henkp.mirmon/trunk/
+  https://svn.science.uu.nl/repos/project.mirmon/trunk/

 
 =item * The mirmon tarball is here :
 
 
 =item * The mirmon tarball is here :
 

-  http://people.cs.uu.nl/henkp/mirmon/mirmon.tar.gz
+  http://www.staff.science.uu.nl/~penni101/mirmon/mirmon.tar.gz

 
 =back
 
 
 =back
 


@@ -2256,7 +2439,7 @@ of the document root of your webserver.
 
 where
 
 
 where
 

-  REPO = https://subversion.cs.uu.nl/repos/staff.henkp.mirmon/trunk/
+  REPO = https://svn.science.uu.nl/repos/project.mirmon/trunk/

 
 or download the package and unpack it.
 
 
 or download the package and unpack it.
 


@@ -2294,13 +2477,13 @@ The email addresses are optional.
   countries countries.list
   web_page DOCUMENTROOT/mirmon/index.html
   icons /mirmon/icons
   countries countries.list
   web_page DOCUMENTROOT/mirmon/index.html
   icons /mirmon/icons

-  probe /usr/bin/wget -q -O - -T %TIMEOUT% -t 1 %URL%TIME
+  probe /usr/bin/wget -q -O - -T %TIMEOUT% -t 1 %URL%TIME.txt

 
 

-This assumes the project's timestamp is in file C<TIME>.
+This assumes the project's timestamp is in file C<TIME.txt>.

 
 =item * If you have rsync urls, change the probe line to :
 
 
 =item * If you have rsync urls, change the probe line to :
 

-  probe perl /usr/local/src/mirmon/probe -t %TIMEOUT% %URL%TIME
+  probe perl /usr/local/src/mirmon/probe -t %TIMEOUT% %URL%TIME.txt

 
 =item * Run mirmon :
 
 
 =item * Run mirmon :
 


@@ -2322,7 +2505,9 @@ The mirmon report should now be in 'DOCUMENTROOT/mirmon/index.html'
 
 =begin html
 
 
 =begin html
 

-<A HREF="mirmon.pm.html">mirmon.pm(3)</A>
+<p>
+<a href="mirmon.pm.html">mirmon.pm(3)</a>
+</p>

 
 =end html
 
 
 =end html
 


@@ -2336,30 +2521,33 @@ mirmon.pm(3)
 
 =begin html
 
 
 =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
+  <p>
+  &copy; 2003-2014
+  <a href="http://www.staff.science.uu.nl/~penni101/">Henk P. Penning</a>,
+  <a href="http://www.uu.nl/faculty/science/EN/">Faculty of Science</a>,
+  <a href="http://www.uu.nl/">Utrecht University</a>
+  <br />
+  mirmon-2.10 - Fri Aug 15 12:26:55 2014 ; henkp ;
+  <a href="http://validator.w3.org/check?uri=referer">verify html</a>
+  </p>

 
 =end html
 
 =begin man
 
 
 =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
+  (c) 2003-2014 Henk P. Penning
+  Faculty of Science, Utrecht University
+  http://www.staff.science.uu.nl/~penni101/ -- penning@uu.nl
+  mirmon-2.10 - Fri Aug 15 12:26:55 2014 ; henkp

 
 =end man
 
 =begin text
 
 
 =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
+  (c) 2003-2014 Henk P. Penning
+  Faculty of Science, Utrecht University
+  http://www.staff.science.uu.nl/~penni101/ -- penning@uu.nl
+  mirmon-2.10 - Fri Aug 15 12:26:55 2014 ; henkp

 
 =end text
 
 
 =end text
 

diff --git a/mirmon/probe b/mirmon/probe
index fd6a5f860108206218f5ff4b90bc67e970c6ea6e..811c39a79cccbe4c78a2bf119c888d853653fdda 100755 (executable)
--- a/mirmon/probe
+++ b/mirmon/probe
@@ -16,7 +16,7 @@ option q : be quiet
 option d : show debug info
 option t : timeout in seconds (default $timeout)
 argument url :
 option d : show debug info
 option t : timeout in seconds (default $timeout)
 argument url :

-  rysnc://host.dom.com/module/file
+  rsync://host.dom.com/module/file

    http://host.dom.com/some/file
     ftp://host.dom.com/some/file
 USAGE
    http://host.dom.com/some/file
     ftp://host.dom.com/some/file
 USAGE


@@ -52,11 +52,13 @@ my $opt_q = '' ; $opt_q = '-q' if $opt{q} ;
 # handle ftp/http urls with wget
 
 if ( $url =~ m!^rsync://(.*)$! )
 # handle ftp/http urls with wget
 
 if ( $url =~ m!^rsync://(.*)$! )

-  { my $dst = $1 ;
+  { my $src = $1 ;
+    my $dst = $src ;

     $dst =~ s![/\s]!_!g ;
     my $TMP = "$tmp_dir/$dst" ;
     $dst =~ s![/\s]!_!g ;
     my $TMP = "$tmp_dir/$dst" ;

+    $src =~ s!/!::! ;

     unlink $TMP ; # ignore status
     unlink $TMP ; # ignore status

-    my $cmd = "$RSYNC $opt_v $opt_q --no-motd --timeout $timeout $url $TMP" ;
+    my $cmd = "$RSYNC $opt_v $opt_q --no-motd --timeout $timeout $src $TMP" ;

     Warn sprintf "'%s'\n", $cmd if $opt{d} ;
     system $cmd ;
     if ( open TMP, $TMP )
     Warn sprintf "'%s'\n", $cmd if $opt{d} ;
     system $cmd ;
     if ( open TMP, $TMP )