From: Nigel Metheringham Date: Thu, 19 Feb 2015 20:38:28 +0000 (+0000) Subject: Updated mirmon to version 2.10 X-Git-Url: https://git.exim.org/mirror-monitor.git/commitdiff_plain/aeb98720d5db15de492cc2411b96c06108108654 Updated mirmon to version 2.10 --- diff --git a/mirmon/countries.list b/mirmon/countries.list index 988bea9..831fc6e 100644 --- a/mirmon/countries.list +++ b/mirmon/countries.list @@ -1,244 +1,250 @@ # 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 27175e3..392d510 100755 --- a/mirmon/mirmon +++ b/mirmon/mirmon @@ -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 @@ -28,16 +29,16 @@ 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 ( ) { 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 "
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 "\n" ; printf " %s  %s\n %s\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 country_name, ... } >>. Returns the list of default locations for config files. -=item B +=item B -Probes all mirrors if $get is C ; or a subset if $get is C. +Probes all mirrors if $get is C ; or a subset if $get is C ; +or only I<$URL> if $get is C. =back @@ -1587,7 +1725,7 @@ The url as given in the mirror list. =item B -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 @@ -1596,7 +1734,7 @@ The status of the last probe, or 'undef' if the mirror was never probed. =item B -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 @@ -1684,7 +1822,9 @@ and updates the state of the mirror. =begin html -mirmon(1) +

+mirmon(1) +

=end html @@ -1698,30 +1838,33 @@ mirmon(1) =begin html - © 2003-2010 - Henk P. Penning, - Computer Science Department, - Utrecht University -
- mirmon-2.3 - Wed Mar 17 09:29:11 2010 ; henkp +

+ © 2003-2014 + Henk P. Penning, + Faculty of Science, + Utrecht University +
+ mirmon-2.10 - Fri Aug 15 12:26:55 2014 ; henkp ; + verify html +

=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 = <] 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 : probe some (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 normally only reports +errors and changes in the mirror list. + +=item B<-q> + +Be quiet. + +=item B<-t> I + +Set the timeout ; the default is I<300>. + +=item B<-get> all | update | url + +With B, probe all sites. +With B, probe a selection of the sites ; see option C below. +With B, probe only the given I, which must appear in the mirror-list. + +=item B<-c> I + +Use config file I. 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 +=over 4 + +=item project_name I Specify a short plaintext name for the project. project_name Apache project_name CTAN -=head2 project_url I +=item project_url I Specify an url pointing to the 'home' of the project. project_url http://www.apache.org/ -=head2 mirror_list I +=item mirror_list I 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 (see below). The default style is 'plain'. -=head2 web_page I +=item web_page I Specify where the html report page is written. -=head2 icons I +=item icons I Specify the directory where the icons can be found, relative to the I, or relative to the @@ -1958,20 +2129,20 @@ If/when the icons live in C, specify icons /icons/mirmon -=head2 probe I +=item probe I 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 that handles ftp, http and rsync urls. -=head2 state I +=item state I 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 +=item countries I 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 domains like I, I are allowed, +and are listed first in the report ; lowercase-first +fake domains (like I) are listed last. + +=back + +=head2 optional entries -=head2 max_probes I +=over 4 + +=item max_probes I Optionally specify the number of parallel probes (default 25). -=head2 timeout I +=item timeout I Optionally specify the timeout for the probes (default 300). After the last probe is started, the program waits for + 10 seconds, cleans up and exits. -=head2 project_logo I +=item project_logo I 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 +=item htm_head I Optionally specify some HTML to be placed before . htm_head -=head2 htm_top I +=item htm_top I Optionally specify some HTML to be placed near the top of the page. htm_top testing 1, 2, 3 -=head2 htm_foot I +=item htm_foot I 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.
-=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 +=item min_poll I For 'min_poll' see next item. A I 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 +=item max_poll I 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 +=item min_sync I Optionally specify how often the mirrors are required to make an update. The default 'min_sync' is '1d' (1 day). -=head2 max_sync I +=item max_sync I 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 -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 like I 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. -=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. -=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 I +=item site_url I I 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 of an url is the part between '://' and the first '/'. -=head2 env I I +=item env I I Optionally specify an environment variable. -=head2 include I +=item include I Optionally specify a file to include. @@ -2152,17 +2333,19 @@ C 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