Updated mirmon to version 2.10
authorNigel Metheringham <nigel@exim.org>
Thu, 19 Feb 2015 20:38:28 +0000 (20:38 +0000)
committerNigel Metheringham <nigel@exim.org>
Thu, 19 Feb 2015 20:38:28 +0000 (20:38 +0000)
mirmon/countries.list
mirmon/mirmon
mirmon/probe

index 988bea9547b6996571b75c7db70c1543137431f1..831fc6ef0754d638657e144fafcff484f4cfa29a 100644 (file)
 # 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
index 27175e3d33b3820d720476bc6968b0e0e854421c..392d51021e5344a3bfbbf927aba965c991c52c91 100755 (executable)
@@ -1,8 +1,9 @@
 #! /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.
+#
 # 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
 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 %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 $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 ; #####################################################
 
@@ -211,7 +212,7 @@ 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 ; }
+    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 ;
   }
 
@@ -225,6 +226,7 @@ sub get_config
 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 ($!)" ;
@@ -238,6 +240,7 @@ sub get_state
     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 ;
@@ -264,7 +267,7 @@ sub get_state
         $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 } ;
@@ -276,10 +279,12 @@ sub get_state
     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 } ;
           }
       }
+    printf "changes in mirror-list for '%s':\n%s", $name, $changes
+      if $changes ;
     $self -> state ( $res ) ;
   }
 
@@ -309,73 +314,175 @@ sub get_regions
       { chop ;
         next if /^#/ ;
         my ( $code, $dash, $reg ) = split ' ', $_, 3 ;
-        $self -> { regions } { lc $code } = lc $reg ;
+        $self -> { regions } { lc $code } = $reg ;
       }
     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 ;
+    my $URL   = 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 $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 ;
-            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 ;
@@ -871,7 +978,8 @@ sub gen_histogram
       { $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
@@ -1020,10 +1128,11 @@ $histo_top
 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 ;
@@ -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"
-              , $mirror -> site_url
-              , $mirror -> home_url
+              , $mirror -> url_site
+              , $mirror -> url_home
               , $mirror -> type
               ;
 
@@ -1118,6 +1227,7 @@ our %CNF_defaults =
   , htm_top      => ''
   , htm_foot     => ''
   , htm_head     => ''
+  , always_get   => ''
   ) ;
 
 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) ) ;
 
+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 ;
@@ -1293,15 +1409,18 @@ sub state_history_hist
 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+)?/! )
-      { $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 path { my $self = shift ; ( $self -> _parse ) [ 3 ] ; }
 
 sub age_in_days
   { my $self = shift ;
@@ -1429,7 +1548,7 @@ sub finish_probe
         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
@@ -1463,8 +1582,26 @@ sub _url
     $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
 
@@ -1537,9 +1674,10 @@ Returns a hashref C<< { country_code =E<gt> country_name, ... } >>.
 
 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
 
@@ -1587,7 +1725,7 @@ The url as given in the mirror list.
 
 =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>
@@ -1596,7 +1734,7 @@ 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'
+The timestamp of the last successful probe or 'undef'
 if the mirror was never successfully probed.
 
 =item B<probe_history>
@@ -1684,7 +1822,9 @@ and updates the state of the mirror.
 
 =begin html
 
-<A HREF="mirmon.html">mirmon(1)</A>
+<p>
+<a href="mirmon.html">mirmon(1)</a>
+</p>
 
 =end html
 
@@ -1698,30 +1838,33 @@ mirmon(1)
 
 =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
 
-  (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
 
-  (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
 
@@ -1733,18 +1876,19 @@ use IO::Pipe ;
 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 ;
-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 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 )
 -------------------------------------------------------------------
@@ -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) ) ;
-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} ;
 
+my $URL = shift ;
+
+my $M = Mirmon -> new ( $opt{c} ) ;
+$M -> conf -> timeout ( $opt{t} ) if $opt{t} ;
+
 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} ) ;
 
-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__
@@ -1795,20 +1946,38 @@ mirmon - monitor the state of mirrors
 
 =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
 
-  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
 
@@ -1890,22 +2059,24 @@ A config file looks like this :
   |. 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
 
-=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/
 
-=head2 mirror_list I<file-name>
+=item mirror_list I<file-name>
 
 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.
 
-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'.
 
-=head2 web_page I<file-name>
+=item web_page I<file-name>
 
 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
@@ -1958,20 +2129,20 @@ If/when the icons live in C</path/to/DOCUMENTROOT/icons/mirmon/>, specify
 
   icons /icons/mirmon
 
-=head2 probe I<program + arguments>
+=item 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
+  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
-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
 
-  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 :
@@ -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.
 
-=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).
 
-=head2 countries I<file-name>
+=item countries I<file-name>
 
 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.
 
-=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).
 
-=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.
 
-=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.
@@ -2021,20 +2200,20 @@ top right on the page.
   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">
 
-=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
 
-=head2 htm_foot I<html>
+=item htm_foot I<html>
 
 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>
 
-=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'.
 
-=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).
 
-=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 :
@@ -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).
 
-=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).
 
-=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).
 
-=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>.
 
-=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
@@ -2123,14 +2304,14 @@ unless it is in quiet mode.
 
 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'.
 
-=head2 site_url I<site> I<url>
+=item site_url I<site> I<url>
 
 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 '/'.
 
-=head2 env I<key> I<value>
+=item env I<key> I<value>
 
 Optionally specify an environment variable.
 
-=head2 include I<file-name>
+=item include I<file-name>
 
 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.
 
-=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.
 
-=head2 exit
+=item exit
 
 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.
@@ -2177,16 +2360,16 @@ The url as given in the mirror list.
 
 =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.
 
-=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
@@ -2227,11 +2410,11 @@ The timestamp of the last probe, or 'undef' if the mirror was never probed.
 
 =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 :
 
-  http://people.cs.uu.nl/henkp/mirmon/mirmon.tar.gz
+  http://www.staff.science.uu.nl/~penni101/mirmon/mirmon.tar.gz
 
 =back
 
@@ -2256,7 +2439,7 @@ of the document root of your webserver.
 
 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.
 
@@ -2294,13 +2477,13 @@ The email addresses are optional.
   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 :
 
-  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 :
 
@@ -2322,7 +2505,9 @@ The mirmon report should now be in 'DOCUMENTROOT/mirmon/index.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
 
@@ -2336,30 +2521,33 @@ mirmon.pm(3)
 
 =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
 
-  (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
 
-  (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
 
index fd6a5f860108206218f5ff4b90bc67e970c6ea6e..811c39a79cccbe4c78a2bf119c888d853653fdda 100755 (executable)
@@ -16,7 +16,7 @@ option q : be quiet
 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
@@ -52,11 +52,13 @@ my $opt_q = '' ; $opt_q = '-q' if $opt{q} ;
 # 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" ;
+    $src =~ s!/!::! ;
     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 )