From b160b0f6d05f420828cf5dbd7ee32874626b134b Mon Sep 17 00:00:00 2001 From: Joerg Jaspert Date: Thu, 27 Nov 2008 18:21:30 +0100 Subject: Very initial checkin of dmc stuff from mirror.d.o, just to get started --- mirrorcheck/bin/dmc-archive.pl | 1371 ++++++++++++++++++++++++++++++++++++++++ mirrorcheck/bin/dmc.pl | 1371 ++++++++++++++++++++++++++++++++++++++++ mirrorcheck/www/.dummy | 0 3 files changed, 2742 insertions(+) create mode 100755 mirrorcheck/bin/dmc-archive.pl create mode 100755 mirrorcheck/bin/dmc.pl create mode 100644 mirrorcheck/www/.dummy (limited to 'mirrorcheck') diff --git a/mirrorcheck/bin/dmc-archive.pl b/mirrorcheck/bin/dmc-archive.pl new file mode 100755 index 0000000..f98d57d --- /dev/null +++ b/mirrorcheck/bin/dmc-archive.pl @@ -0,0 +1,1371 @@ +#! /usr/bin/perl -w + +# this copy forked off the original fork by Joy +# just to get the two archive thingies monitored, quick'n'dirty +# 2007-10-14 + +# Copyright (C) 2001-2002 Adam Lackorzynski +# +# This file contains free software, you can redistribute it and/or modify +# it under the terms of the GNU General Public License, Version 2 as +# published by the Free Software Foundation (see the file COPYING). +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# Adam Lackorzynski + +# todo +# - time of query (maybe, will consume too much space) +# - maybe some bars marking time all the servers are behind the +# the most recent server +# - rewrite and do it better this time... + +use strict; +use LWP::UserAgent; +use Data::Dumper; +use Getopt::Long; +use File::Listing; +use Carp (); + +#local $SIG{__WARN__} = \&Carp::confess; #cluck; +#local $SIG{__DIE__} = \&Carp::confess; +#$SIG{INT} = \&Carp::confess; + +my $hostpattern = +#'([wp]\.de\.debian\.org$|den\.de$|erlangen|(se|uk|fi)\.debian)'; +#'(\.debian\.org$|\.de$)'; +#'([pw]\.de\.debian\.|dresden|claus)'; +#'dresden'; +#'(claus)'; +#'((www|ftp).de.debian.org$)'; +#'www\..+\.debian.org'; +#'(\.de$)'; +#'(ftp|www)\.(se|de|at|es|fr|uk|it|pl|nl|tr).debian.org$|\.de$'; +#'ftp.wa.au'; +#'www.mirror.ac.uk|dresden|claus|\.de.debian.org|erlan|berlin'; +#'www.mirror.ac.uk'; +#'www2'; +#'ftp.(at|si).debian.org'; +#'ftp.si.debian.org'; +'.'; +#'.debian.org'; + +my $tracedir_std_main = "project/trace"; +my $masterfile_stdmain = "ftp-master.debian.org"; +my $tracedir_std_cd = "project/trace"; +my $masterfile_stdcd = "cdimage.debian.org"; +my $tracedir_std_www = "mirror/timestamps"; +my $masterfile_stdwww = "www-master.debian.org"; + +my $tracedir_std_old = "project/trace"; +my $masterfile_stdold = "saens.debian.org"; # FIXME :) +my $tracedir_std_nonus = "project/trace"; +my $masterfile_stdnonus = "non-us.debian.org"; + +my $archivUpdatePattern = "Archive-Update-in-Progress-"; + +my $masterlistURL = 'http://cvs.debian.org/*checkout*/webwml/english/mirror/Mirrors.masterlist?cvsroot=webwml'; + +my @sections = qw/old nonus/; + +# order of protocols is important -> ftp is easier to parse for the upstream +# mirror list, so do this one first... +my %protocols = + ( + old => [qw/ftp http rsync/], + nonus => [qw/ftp http rsync/], + ); + +my %addrs = + ( +# 'debian.inf.tu-dresden.de' => +# { +# main => +# { path => '/debian', +# tracedir => $tracedir_std_main, mastertracefile => $masterfile_stdmain, }, +# cd => +# { path_http => '/debian-cd', path_ftp => '/debian-cd', patch_rsync => 'debian-cd', }, +# }, +# 'os.inf.tu-dresden.de' => +# { +# main => +# { path => '/debian', +# tracedir => $tracedir_std_main, mastertracefile => $masterfile_stdmain, }, +# checkProtocol => [ 'http', ], +# cd => +# { path_http => '/debian-cd'}, +# }, + ); + +my $debug = 1; +my $DisplayNonCheckedHosts = 0; + +my $HtmlDir = "../www/archive"; +my $HtmlFile = "status.html"; +my $MasterFile = "master.list"; +my $DataFile = "mirror.data"; +my $DataFileIP = "mirror.data.ip"; + +my @arg_options = ("masterfile|m=s", \$MasterFile, + "datafile|d=s", \$DataFile, + "datafileip|i=s", \$DataFileIP, + "htmlfile|o=s", \$HtmlFile, + "displaynonchecked!", \$DisplayNonCheckedHosts, + ); + +# some mirrors have authenticated rsync access only although they're in +# the mirror list... +# do not let rsync pop up with a password prompt +$ENV{'RSYNC_PASSWORD'} = ''; + +umask 022; +my $MasterListRefreshTime = 24*3600; # 1 day +my $IPListRefreshTime = 2*24*2600; # 2 days +my $OutOfDateTime = 3600*24*2; # 2 days +my $connectionTimeout = 10; # secs +my $prog_rsync = "rsync --timeout=$connectionTimeout"; +my %timestamps = + ( + data_capture_start => 0, + data_capture_end => 0, + ); +my $IPDataCaptureTime = 0; + +my $ERRORMSGCUTBYTES = 200; + +my %data; +my %IPs; +my (@errors_full, @errors_filt); +my %openedfile = (); + +sub DBG { + print join("", @_) if $debug; +} + +sub getTempFile { + $_ = `/bin/mktemp /tmp/mirstat.temp.XXXXXX`; + chomp; + $_; +} + +sub getHtmlFullErrorFileName { + my $r; + if ($HtmlFile =~ /\.html$/) { + ($r = $HtmlFile) =~ s/html$/full-errors.$&/i; + } else { + $r = $HtmlFile."full-errors.html"; + } + $r; +} + +sub rsyncErrorFilter { + my ($text) = @_; + # In rsync error messages normally only the last line is significant + (reverse split(/\n/, $text))[0]; +} + +sub getErrorNrFull { + my ($text) = @_; + my $i = 0; + for (; $i <= $#errors_full; $i++) { + return $i if ($errors_full[$i] eq $text); + } + $errors_full[$i] = $text; + $i; +} + +sub getErrorNr { + my ($text, $protocol) = @_; + my $i = getErrorNrFull($text); + if ($protocol =~ /rsync/) { + $text = rsyncErrorFilter($text); + } + # trim text also in case it's too long + $errors_filt[$i] = substr($text, 0, $ERRORMSGCUTBYTES); + $i; +} + +sub parseMasterData { + my ($host, $key, $val) = @_; + + # print "$host $key $val\n"; + $val =~ s,(.)/$,$1,; + + if ($key =~ /Archive-/) { + $addrs{$host}{main}{mastertracefile} = $masterfile_stdmain; + $addrs{$host}{main}{tracedir} = $tracedir_std_main; + } elsif ($key =~ /CDImage-/) { + $addrs{$host}{cd}{mastertracefile} = $masterfile_stdcd; + $addrs{$host}{cd}{tracedir} = $tracedir_std_cd; + } elsif ($key =~ /WWW-/) { + $addrs{$host}{www}{mastertracefile} = $masterfile_stdwww; + $addrs{$host}{www}{tracedir} = $tracedir_std_www; + } elsif ($key =~ /Old-/) { + $addrs{$host}{old}{mastertracefile} = $masterfile_stdold; + $addrs{$host}{old}{tracedir} = $tracedir_std_old; + } elsif ($key =~ /NonUS-/) { + $addrs{$host}{nonus}{mastertracefile} = $masterfile_stdnonus; + $addrs{$host}{nonus}{tracedir} = $tracedir_std_nonus; + } + + if ($key =~ /Archive-http/i) { + $addrs{$host}{main}{path_http} = $val; + } elsif ($key =~ /Archive-ftp/i) { + $addrs{$host}{main}{path_ftp} = $val; + } elsif ($key =~ /Archive-rsync/i) { + $addrs{$host}{main}{path_rsync} = $val; + } elsif ($key =~ /CDImage-http/i) { + $addrs{$host}{cd}{path_http} = $val; + } elsif ($key =~ /CDImage-ftp/i) { + $addrs{$host}{cd}{path_ftp} = $val; + } elsif ($key =~ /CDImage-rsync/i) { + $addrs{$host}{cd}{path_rsync} = $val; + } elsif ($key =~ /WWW-http/i) { + $addrs{$host}{www}{path_http} = $val; + } elsif ($key =~ /Old-http/i) { + $addrs{$host}{old}{path_http} = $val; + } elsif ($key =~ /Old-ftp/i) { + $addrs{$host}{old}{path_ftp} = $val; + } elsif ($key =~ /Old-rsync/i) { + $addrs{$host}{old}{path_rsync} = $val; + } elsif ($key =~ /NonUS-http/i) { + $addrs{$host}{nonus}{path_http} = $val; + } elsif ($key =~ /NonUS-ftp/i) { + $addrs{$host}{nonus}{path_ftp} = $val; + } elsif ($key =~ /NonUS-rsync/i) { + $addrs{$host}{nonus}{path_rsync} = $val; + } + # save all other info + $addrs{$host}{info}{$key} = $val; +} + +sub parseMirrorsMasterList { + my $ctime = 0; + $ctime = (stat($MasterFile))[9] if -f $MasterFile; + if ($ctime + $MasterListRefreshTime < time) { + DBG("Getting new master mirror list\n"); + open(F, "wget -q -O - '$masterlistURL' | tee $MasterFile |") or die $!; + } else { + open(F, $MasterFile) or die $!; + } + my $s = 0; + my ($host, $entryval, $entrykey) = (undef, undef, undef); + while (defined ($_=)) { + chomp; + s/\s*$//; + if ($s == 0) { # looking for site + next if /^$/; + next if /^X-/; + next if /^\s\S/; + die "format error ($_)" unless /^Site:\s*(\S+)/; + $host = $1; + $s = 1; + } else { + if (/^$/) { # end of description + $s = 0; + parseMasterData($host, $entrykey, $entryval) + if (defined $entrykey); + $entrykey = undef; + } else { + if (/^\s+/) { # continued line (starting with \s's) + s/^\s*/ /; + $entryval .= $_; + } else { + parseMasterData($host, $entrykey, $entryval) + if (defined $entrykey); + + ($entrykey, $entryval) = split(/: */, $_, 2); + die "format error($_)" unless $entrykey && $entryval; + } + } + } + } + close F; +} + +sub getSecondsOfDatestring { + my ($datestring) = @_; + $datestring = (split(/\n/, $datestring))[0]; + $_ = `date -d "$datestring" +%s 2>&1`; + chomp; + return "ERROR: $_" if $?; + $_; +} + +# get output from http/ftp request +sub getData_ftp_http { + my ($url) = @_; + my $ua = LWP::UserAgent->new; + $ua->agent(" "); + $ua->timeout($connectionTimeout); + my $res = $ua->request(HTTP::Request->new(GET => $url)); + return 'ERROR: ' . $res->status_line if $res->is_error; + my $d = $res->content; + chomp $d; + return $d; +} + +# get file via rsync +sub getData_rsync_file { + my ($url) = @_; + my $tmpf = getTempFile(); + my $d = `$prog_rsync $url $tmpf 2>&1`; + + # check for error messages - yes, can return with $?==0 although + # we've got an error (@ERROR: access denied...) + if ($d =~ /^\@ERROR: /m) { + $d = 'ERROR: '.$d; + } elsif (!$?) { + # request succesful + $d = ''; + open(D, $tmpf) || die $!; + while (defined ($_=)) { + chomp; + $d .= $_; + } + close D; + } # fall through otherwise... + + unlink $tmpf; + $d; +} + +# get output from rsync request +sub getData_rsync_output { + my ($url) = @_; + my $d = `$prog_rsync '$url' 2>&1`; + $d = 'ERROR: '.$d if $?; + $d; +} + +sub getFile { + my ($url) = @_; + if ($url =~ /^(ht|f)tp:/) { + return getData_ftp_http($url); + } elsif ($url =~ /^rsync:/) { + return getData_rsync_file($url); + } else { + die "INTERNAL ERROR: unknown protocol type!"; + } +} + +sub getDirListing { + my ($url) = @_; + if ($url =~ /^rsync:/) { + $url .= '/*' if ($url =~ /[^*]$/); + return getData_rsync_output($url); + } else { + $url .= '/' if $url !~ /\/$/; + return getData_ftp_http($url); + } +} + +sub removeHTMLTags { + $_ = shift; + s/<.*?>//sg; + $_; +} + +sub getPathForProtocol { + my ($host, $section, $protocol) = @_; + my $path = (defined $addrs{$host}{$section}{"path_$protocol"})? + $addrs{$host}{$section}{"path_$protocol"}: + $addrs{$host}{$section}{path}; + $path = '/'.$path if (defined $path && $path !~ m,^/,); + $path; +} + +sub checkUpdateInProgress { + my ($section) = @_; + ($section eq 'www')?0:1; +} + +sub checkIfUpdateIsInProgress { + my ($protocol, $host, $path, $section) = @_; + + # we check if an archiv update is in progress + # (by simply getting the directory listing of the topmost dir) + my $r = getDirListing("$protocol://$host$path"); + DBG($r, "\n"); + $data{$host}{$section}{updateInProgess} = + ($r =~ /$archivUpdatePattern/im)?1:0; + $data{$host}{$section}{$protocol} = + ($r !~ /^ERROR: /m)?-1:getErrorNr($r, $protocol); +} + +sub extractFileLinksFromDirHTMLListing { + my ($listing) = @_; + + my @files; + while ($listing =~ s/href\s*=\s*"?(.*?)[^\/\w.\d-](.*)/$2/i) { + my $a = $1; + #$a = (reverse split(/\//, $a))[0] if $a =~ /\//; + next if $a =~ m,/,; # don't take directories + next if (!defined $a || $a eq '' || $a =~ /^(http|ftp|mailto|trace)$/i); + if ($a !~ /\/$/) { + push @files, $a + if ($a !~ /^\.$/ && $a !~ /^\.\.$/ && $a !~ /^\./ && $a !~ /\.$/); + } + } + @files; +} + +sub extractFileLinksFromDirRsyncListing { + my ($listing) = @_; + my @files; + + for my $l (split(/\n/, $listing)) { + next unless ($l =~ /^.[rwxsSXt-]{9}\s/); + (my $name = $l) =~ s/.*\s([^\s]+)$/$1/; + push @files, $name; + } + + @files; +} + +sub extractFileLinksFromDirFTPListing { + my ($listing) = @_; + my @files; + + for (parse_dir($listing)) { + my ($name) = @$_; + push @files, $name; + } + @files; +} + +sub getLinkFilesOutOfListing { + my ($protocol, $listing) = @_; + my @files; + if ($protocol eq 'rsync') { + return extractFileLinksFromDirRsyncListing($listing); + } elsif ($protocol eq 'http') { + return extractFileLinksFromDirHTMLListing($listing); + } elsif ($protocol eq 'ftp') { + return extractFileLinksFromDirFTPListing($listing); + } else { + print STDERR "not impl\n"; + } + return (); +} + +sub cleanOutNonMirrorTraceFiles { + my (@list) = @_; + + my @nl; + for (@list) { + next if (/\.(html?|css)$/); + push @nl, $_; + } + @nl; +} + +sub uniqueList { + my (@list) = @_; + + my @nl; + my $d = ''; + for (sort @list) { + push @nl, $_ if $d ne $_; + $d = $_; + } + @nl; +} + +sub masterSet__ { + my ($t, $failret, $host, $section, $val) = @_; + return $failret unless defined $addrs{$host}{$section}{mastertracefile}; + $data{$host}{$section}{$t}{$addrs{$host}{$section}{mastertracefile}} + = $val if defined $val; + $data{$host}{$section}{$t}{$addrs{$host}{$section}{mastertracefile}}; +} +sub masterTimeString { return masterSet__('timestamps_str', '', @_); } +sub masterSeconds { return masterSet__('timestamps_sec', 0, @_); } + +sub getUndefinedTimestampFile { + my ($host, $section) = @_; + foreach my $m (keys %{$data{$host}{$section}{timestamps_str}}) { + return $m unless defined $data{$host}{$section}{timestamps_str}{$m}; + } + undef; +} + +sub getWorkingProtocol { + my ($host, $section) = @_; + + foreach my $p (@{$protocols{$section}}) { + next unless defined $data{$host}{$section}{$p}; + return $p; + } + undef; +} + +sub isProtocolHTTPWorking { + my ($host, $section) = @_; + + return defined $data{$host}{$section}{'http'}; +} + +sub getHostInfo { + my ($hostname) = @_; + + return 0 if defined $IPs{$hostname}; + + $? = 0; # huh, why is that needed? + my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($hostname); + + #print "HUUUU: $hostname $?\n"; + return 0 if ($?); + + foreach my $h ($hostname, $name, split(/\s+/, $aliases)) { + next if $h eq '' || defined $IPs{$h}; + $IPs{$h} = [map { join(".", unpack('C4', $_)) } @addrs]; + print "IP: $h: ", join(", ", map { join(".", unpack('C4', $_)) } @addrs), "\n"; + } + 1; +} + +sub areHostsEqual { + my ($host1, $host2) = @_; + + return 0 unless defined $IPs{$host1} && defined $IPs{$host2}; + my @h1 = @{$IPs{$host1}}; + my @h2 = @{$IPs{$host2}}; + for (my $i = 0; $i <= $#h1; $i++) { + for (my $j = 0; $j <= $#h2; $j++) { + return 1 if $h1[$i] eq $h2[$j]; + } + } + 0; +} + +sub getOfficialHostname { + my ($h, $section) = @_; + + return $h if (grep(/^$h$/, keys %addrs)); + return $h unless defined $IPs{$h}; + for my $a (keys %addrs) { + next unless defined $IPs{$a}; + foreach my $i (@{$IPs{$a}}) { + return $a if (grep(/^$i$/, @{$IPs{$h}}) && + @{$IPs{$a}} == 1 && # NO DNS round robin entries... + defined $addrs{$a}{$section}{tracedir}); + } + } + return $h; +} + +sub doStep { + my ($host, $section, $protocol) = @_; + + # get path since we can have protocol specific paths + my $path = getPathForProtocol($host, $section, $protocol); + return unless defined $path; + + DBG(">>>> $host - $section - $protocol - $path\n"); + + unless (defined $data{$host}{$section}{timestamps_sec}) { + next unless (defined $addrs{$host}{$section}{tracedir}); + my $pa = $path; + $pa .= '/' if ($pa !~ /\/$/); + $pa .= $addrs{$host}{$section}{tracedir}; + my $listing = getDirListing("$protocol://$host$pa"); + if ($listing !~ /^ERROR: /m) { + my @files = getLinkFilesOutOfListing($protocol, $listing); + @files = cleanOutNonMirrorTraceFiles(uniqueList(@files)); + DBG("Got upstream mirrors (via $protocol): ".join(", ", @files), "\n"); + + #print STDERR "TODO: check for ", scalar @files, " == 1 --> client failure!\n"; + + # some badly configured servers return HTTP 200 codes even + # if they should return 404... + next unless (defined $addrs{$host}{$section}{mastertracefile}); + if (grep(/^$addrs{$host}{$section}{mastertracefile}$/, @files)) { + $data{$host}{$section}{$protocol} = -1; + foreach my $h (@files) { + $data{$host}{$section}{timestamps_str}{$h} = undef; + $data{$host}{$section}{timestamps_sec}{$h} = undef; + } + } else { +# warn "Missing master file $addrs{$host}{$section}{mastertracefile} on $host\n"; + if ($listing =~ //i) { + $listing = "ERROR: ".$listing if ($listing !~ /^ERROR: /); + $listing = removeHTMLTags($listing); + } + $data{$host}{$section}{$protocol} = getErrorNr($listing, $protocol); + } + + } else { + $data{$host}{$section}{$protocol} = getErrorNr($listing, $protocol); + } + + } elsif ((my $file = getUndefinedTimestampFile($host, $section)) && + (!defined $data{$host}{$section}{$protocol} || + $data{$host}{$section}{$protocol} == -1)) { + my $pa = $path; + $pa .= '/' if ($pa !~ /\/$/); + $pa .= $addrs{$host}{$section}{tracedir}.'/'.$file; + DBG("getting tracefile via $protocol://$host$pa\n"); + my $d = getFile("$protocol://$host$pa"); + DBG("output: $d\n"); + + # some badly configured servers return a HTTP code 200 even + # if they could not find a file and present a nicely formated + # error message + if (length($d) > 60) { + $d = "ERROR: ".$d if ($d !~ /^ERROR: /); + $d = removeHTMLTags($d); + } + if ($d !~ /^ERROR: /m) { + $data{$host}{$section}{$protocol} = -1; + $data{$host}{$section}{timestamps_str}{$file} = $d; + $data{$host}{$section}{timestamps_sec}{$file} = getSecondsOfDatestring($d); + if ($data{$host}{$section}{timestamps_sec}{$file} =~ /^ERROR: /) { + $data{$host}{$section}{timestamps_sec}{$file} = 0; + } + } else { + $data{$host}{$section}{$protocol} = getErrorNr($d, $protocol); + } + + } elsif (!defined $data{$host}{$section}{updateInProgess} && + checkUpdateInProgress($section)) { + DBG("Checking if update in progress\n"); + checkIfUpdateIsInProgress($protocol, $host, $path, $section); + + } else { + # done + DBG("done\n"); + return 0; + } + 1; +} + + +###################################################################### + +Getopt::Long::config("pass_through"); +my $optret = GetOptions(@arg_options); + +if (defined $ARGV[0] && $ARGV[0] eq 'get') { + + parseMirrorsMasterList(); + + $timestamps{data_capture_start} = time(); + + foreach my $host (keys %addrs) { + next if ($host !~ /$hostpattern/); + + foreach my $section (@sections) { + + foreach my $protocol (@{$protocols{$section}}) { + next if (defined $addrs{$host}{checkProtocol} && + !grep(/^$protocol$/, @{$addrs{$host}{checkProtocol}})); + + # following steps: + # - get directory listing + # - if master-files not in dir-listing -> error + # - get all timestamp files from dir-listing + # - check if update in progress... + + doStep($host, $section, $protocol); + + + } # foreach protocol + + if (defined $data{$host}{$section}{timestamps_sec}) { + # ok, we've got at least one protocol that works + my $protocol = undef; + # find it + foreach (@{$protocols{$section}}) { + $protocol = $_, last + if (defined $data{$host}{$section}{$_} && + $data{$host}{$section}{$_} == -1); + } + if (defined $protocol) { + while (doStep($host, $section, $protocol)) {} + } else { + print STDERR "BIG INTERNAL ERROR!\n"; + } + } + + } # foreach section (main, cd, www) + + } # foreach host + + # get the IPs of all hostnames to find hosts with more than one name + # (e.g. real name and debian.org alias) + + + if (open(I, $DataFileIP)) { + my $dat; + while () { + $dat .= $_; + } + close I; + eval $dat; + } + + print "$IPDataCaptureTime + $IPListRefreshTime\n"; + if ($IPDataCaptureTime + $IPListRefreshTime < time) { + print "IPs:\n"; + foreach my $host (keys %addrs) { + print "$host\n"; + getHostInfo($host); + } + foreach my $host (keys %data) { + print "$host\n"; + getHostInfo($host); + foreach my $section (keys %{$data{$host}}) { + print " $section\n"; + if (defined $data{$host}{$section}{timestamps_str}) { + foreach my $tsh (keys %{$data{$host}{$section}{timestamps_str}}) { + print " $tsh\n"; + getHostInfo($tsh); + } + } + } + } + + open(I, ">$DataFileIP") || die $!; + $Data::Dumper::Indent = 1; + $IPDataCaptureTime = time; + print I Data::Dumper->Dump + ([$IPDataCaptureTime, \%IPs], [qw/IPDataCaptureTime *IPs/]); + close I; + } + + open(A, ">$DataFile") || die $!; + $Data::Dumper::Indent = 1; + $timestamps{data_capture_end} = time(); + print A Data::Dumper->Dump + ([\%timestamps, \%addrs, \%data, \@errors_filt, \@errors_full], + [qw/*timestamps *addrs *data *errors_filt *errors_full/]); + close A; + +} else { + + open(A, "$DataFile") || die $!; + my $dat; + while () { + $dat .= $_; + } + close A; + eval $dat; + + open(I, $DataFileIP) || die $!; + $dat = ''; + while () { + $dat .= $_; + } + close I; + eval $dat; + + DBG("Using data created between ", + scalar localtime $timestamps{data_capture_start}, " and ", + scalar localtime $timestamps{data_capture_end}, "\n"); +} + + + + + + + + +####### create HTML file out of the generated data... ###### + +DBG("Creating HTML files ($HtmlDir/$HtmlFile)\n\n"); + +open(H, ">$HtmlDir/$HtmlFile") || die $!; + +my $dts_s = (scalar gmtime $timestamps{data_capture_start})." UTC"; +my $dts_e = (scalar gmtime $timestamps{data_capture_end})." UTC"; +my $now_utc = (scalar gmtime time)." UTC"; +print H <Debian Mirror Checker + + + + + + + +
+ + + Debian Project + + Data capturing time window:
$dts_s
- $dts_e
+ HTML-file creation time: $now_utc +
+

Debian Mirror Checker

+EOF + +sub validSection { + my ($host, $sect) = @_; + return 1 if (defined $addrs{$host}{$sect}{path}); + foreach (@{$protocols{$sect}}) { + return 1 if (defined $addrs{$host}{$sect}{"path_$_"}); + } + 0; +} + +use constant TRACE_NO_MASTERFILE => 1; +use constant TRACE_TIMESTAMPS_BEFORE_MASTER => 2; +use constant TRACE_INVALID_DATES => 3; +use constant TRACE_NOT_DOWNLOADABLE => 4; +use constant TRACE_NO_PRIMARY => 5; +use constant TRACE_NO_SECONDARY => 6; +use constant TRACE_NO_TRACEFILE_FOR_OWN_MIRROR => 7; +use constant TRACE_NO_TRACEFILES_AT_ALL => 8; + +my %TraceTypeText = +( + &TRACE_NO_MASTERFILE => + 'No master file found', + &TRACE_TIMESTAMPS_BEFORE_MASTER => + 'Older (non-valid) timestamp files found', + &TRACE_INVALID_DATES => + 'Timestamp files contain invalid dates', + &TRACE_NOT_DOWNLOADABLE => + 'Trace files are not downloadable', + &TRACE_NO_PRIMARY => + 'Mirror lacks trace files from their upstream, it is not a primary', + &TRACE_NO_SECONDARY => + 'Mirror lacks trace files from their upstream, it is not a secondary', + &TRACE_NO_TRACEFILE_FOR_OWN_MIRROR => + 'The local trace file is missing', + &TRACE_NO_TRACEFILES_AT_ALL => + 'There are no trace files at all', +); + +use constant MIRROR_PRIMARY => 1; +use constant MIRROR_SECONDARY => 2; +use constant MIRROR_LEAF => 3; +use constant MIRROR_UNKNOWN => 4; + +my %mirrorHTMLIDs = +( + &MIRROR_PRIMARY => 'P', + &MIRROR_SECONDARY => 'S', + &MIRROR_LEAF => 'L', + &MIRROR_UNKNOWN => '?', +); +my %mirrorTypes = +( + 'Push-Primary' => MIRROR_PRIMARY, + 'Push-Secondary' => MIRROR_SECONDARY, + 'leaf' => MIRROR_LEAF, +); + +sub getMirrorType { + my ($host) = @_; + return $mirrorTypes{$addrs{$host}{info}{Type}} + if defined $addrs{$host}{info}{Type} and + defined $mirrorTypes{$addrs{$host}{info}{Type}}; + # return $addrs{$host}{info}{Type} + # if defined $addrs{$host}{info}{Type}; + return MIRROR_UNKNOWN; +} + +sub getMirrorHTMLIDs { + my ($host) = @_; + return $mirrorHTMLIDs{getMirrorType($host)}; +} + + +sub addTraceEntry { + my ($host, $section, $entry) = @_; + push @{$data{$host}{$section}{tracestat}}, $entry; +} + +sub getTraceEntries { + my ($host, $section) = @_; + return () unless defined $data{$host}{$section}{tracestat}; + @{$data{$host}{$section}{tracestat}}; +} + +sub isTraceEntry { + my ($host, $section, $nr) = @_; + + return 0 unless defined $data{$host}{$section}{tracestat}; + foreach my $t (@{$data{$host}{$section}{tracestat}}) { + return 1 if $nr == $t; + } + return 0; +} + +sub computeTraceStates { + + foreach my $section (@sections) { + foreach my $host (keys %data) { + next unless defined $data{$host}{$section}; + + # TRACE_NO_TRACEFILES_AT_ALL + addTraceEntry($host, $section, TRACE_NO_TRACEFILES_AT_ALL) + unless defined $data{$host}{$section}{timestamps_str}; + + # TRACE_NO_MASTERFILE + # TRACE_TIMESTAMPS_BEFORE_MASTER + my $ms = masterSeconds($host, $section); + if (!defined $ms || $ms == 0) { + addTraceEntry($host, $section, TRACE_NO_MASTERFILE); + } else { + foreach my $k (keys %{$data{$host}{$section}{timestamps_sec}}) { + if (defined $data{$host}{$section}{timestamps_sec}{$k} && + $data{$host}{$section}{timestamps_sec}{$k} != 0 && + $data{$host}{$section}{timestamps_sec}{$k} < $ms) { + addTraceEntry($host, $section, TRACE_TIMESTAMPS_BEFORE_MASTER); + last; + } + } + } + + # TRACE_INVALID_DATES + foreach my $k (keys %{$data{$host}{$section}{timestamps_sec}}) { + if (defined $data{$host}{$section}{timestamps_sec}{$k} && + $data{$host}{$section}{timestamps_sec}{$k} == 0) { + addTraceEntry($host, $section, TRACE_INVALID_DATES); + last; + } + } + + # TRACE_NOT_DOWNLOADABLE + # not implemented yet... + + my $mirror_type = getMirrorType($host); + my $credit; + # TRACE_NO_PRIMARY + if ($mirror_type != MIRROR_PRIMARY) { + $credit = 1; + $credit++ if (defined $ms && $ms != 0); + $credit++ + if (defined $data{$host}{$section}{timestamps_str}{$host}); + addTraceEntry($host, $section, TRACE_NO_PRIMARY) + if (scalar keys %{$data{$host}{$section}{timestamps_str}} < + $credit); + } + + + # TRACE_NO_SECONDARY + if ($mirror_type == MIRROR_SECONDARY) { + $credit = 1; + $credit++ if (defined $ms && $ms != 0); + $credit++ + if (defined $data{$host}{$section}{timestamps_str}{$host}); + addTraceEntry($host, $section, TRACE_NO_SECONDARY) + if (scalar keys %{$data{$host}{$section}{timestamps_str}} < + $credit); + } + + # TRACE_NO_TRACEFILE_FOR_OWN_MIRROR + my $bo = defined $data{$host}{$section}{timestamps_str}{$host}; + foreach my $h (keys %{$data{$host}{$section}{timestamps_str}}) { + last if $bo; + $bo = 1 if getOfficialHostname($h, $section) eq $host; + } + addTraceEntry($host, $section, TRACE_NO_TRACEFILE_FOR_OWN_MIRROR) + unless $bo; + } + + } + +} + +sub printSectionInfo { + my $sect = shift; + my $i = 1; + my $master_type = ($sect eq 'www')?'www':'ftp'; + + print H "

Archive: $sect

\n\n\n"; +} + +sub printHierarchyList { + my ($section, $pad, $z) = @_; + + print H " "x$pad, "
    \n"; + foreach (keys %$z) { + next if $_ eq '__count__'; + my $rs = ''; + $rs .= " class=\"misplaced\"" + if (isTraceEntry($_, $section, TRACE_NO_PRIMARY) || + isTraceEntry($_, $section, TRACE_NO_SECONDARY)); + print H " "x($pad+1), "$_", + ($$z{$_}{__count__} > 1)?" ($$z{$_}{__count__})":'', "\n"; + + printHierarchyList($section, $pad+1, $$z{$_}) if keys %{$$z{$_}} > 1; + } + print H " "x$pad, "
\n"; +} + +sub constructMatrix { + my ($y, $x, $matrix, $hosts, %z) = @_; + my $ysum=0; + foreach my $z (keys %z) { + next if $z eq '__count__'; + #print "II (",$y+$ysum,", $x): ", " "x$x, $z{$z}{'__count__'}, " $z\n"; + $matrix->[$y+$ysum][$x] = { "__count__" => $z{$z}{'__count__'}, host => $z}; + $hosts->[$y+$ysum] = $z; + my $i = 1; + for ($i = 1; $i < $z{$z}{'__count__'}; $i++) { + $matrix->[$y+$ysum+$i][$x] = { "__count__" => 0}; + } + my $childsum = constructMatrix($y+$ysum, $x+1, $matrix, $hosts, %{$z{$z}}); + + if ($childsum) { + foreach my $pad (($childsum)..($z{$z}{'__count__'}-1)) { + unless (defined $matrix->[$y+$ysum+$pad][$x+1]) { + $matrix->[$y+$ysum+$pad][$x+1] = { "__count__" => 0, host => '' }; + #print "PP (",$y+$ysum+$pad,", ", $x+1, "): ", " "x$x, $z{$z}{'__count__'}, "\n"; + $hosts->[$y+$ysum+$pad] = $z; + } + } + } + $ysum += $z{$z}{__count__}; + } + #print "SUM: $ysum\n"; + $ysum; +} + +sub printHierarchies { + my ($section) = @_; + + my %a; + my $longest = 0; + my $pa; + foreach my $host (keys %data) { + my $mts = masterTimeString($host, $section); + next if !defined $mts || $mts eq ''; + if (defined $data{$host}{$section}{timestamps_sec} ) { + my @tmp = + sort { ($data{$host}{$section}{timestamps_sec}{$a} || 0xffffffff) + <=> ($data{$host}{$section}{timestamps_sec}{$b} || 0xffffffff) } + keys %{$data{$host}{$section}{timestamps_sec}}; + my $ms = masterSeconds($host, $section); + $ms = 0 unless defined $ms; + + #print STDERR "Unoff: ", join(", ", @tmp), "\n"; + my @tmpoff = map { getOfficialHostname($_, $section) } @tmp; + #print STDERR "Off: ", join(", ", @tmpoff), "\n"; + $longest = @tmp if $longest < @tmp; + $pa = \%a; + push @tmp, $host; + push @tmpoff, $host; + for (my $t = 0; $t <= $#tmp; $t++) { + next + if (defined $data{$host}{$section}{timestamps_sec}{$tmp[$t]} && + $data{$host}{$section}{timestamps_sec}{$tmp[$t]} < $ms); + next if ($t < $#tmp && areHostsEqual($tmp[$t], $tmp[$t+1])); + + #print "$tmpoff[$t] "; + $pa->{$tmpoff[$t]} = {} unless defined $pa->{$tmpoff[$t]}; + $pa->{$tmpoff[$t]}{__count__}++; + $pa = $pa->{$tmpoff[$t]}; + } + #print "\n"; + } + } + + #$Data::Dumper::Indent = 1; + #print Data::Dumper->Dump([\%a], ['*a']), "\n"; + + my @matrix = (); + my @hosts = (); + constructMatrix(0, 0, \@matrix, \@hosts, %a); + + #$Data::Dumper::Indent = 1; + #print Data::Dumper->Dump([\@matrix], ['*matrix']), "\n"; + + #print join("_", map { (defined)?$_:'U' }@hosts), "\n"; + + my $maxwidth = 0; + for (my $y=0; $y <= $#matrix; $y++ ) { + $maxwidth = @{$matrix[$y]} if @{$matrix[$y]} > $maxwidth; + } + print H "\n"; + print H ""; + my @headertitles = qw(Host Master Primary Secondary/Leaf Leaf...); + $maxwidth = @headertitles-1 if @headertitles <= $maxwidth; + for (0..$maxwidth) { + print H ""; + } + print H "\n"; + + for (my $y=0; $y <= $#matrix; $y++ ){ + # we prefer HTTP for links + my $p = 'http'; + $p = getWorkingProtocol($hosts[$y], $section) + if (!isProtocolHTTPWorking($hosts[$y], $section)); + next unless defined $p; + + print H " \n \n"; + + for (my $x=0; $x < @{$matrix[$y]}; $x++) { + if (defined $matrix[$y][$x]) { + if ($matrix[$y][$x]{__count__}) { + my $host = $matrix[$y][$x]{host}; + my $count = $matrix[$y][$x]{__count__}; + my $td; + if (defined ($p = getWorkingProtocol($host, $section))) { + $p = 'http' if isProtocolHTTPWorking($host, $section); + $td = $addrs{$host}{$section}{tracedir}; + $url = "$p://".$host.getPathForProtocol($host, $section, $p).'/'.$td; + $url .= '/' if $url !~ /\/$/; + } + my $rs = ''; + my $as = ''; + $rs .= " rowspan=\"$count\"" if $count > 1; + if (isTraceEntry($host, $section, TRACE_NO_PRIMARY) || + isTraceEntry($host, $section, TRACE_NO_SECONDARY)) { + $as = ' class="misplaced"'; + $rs .= $as if !defined $td; + } else { + $as .= ' class="inv"'; + } + print H + " ", (defined $td)?"":'', + ($count > 1)?($count.'-'):'', $host, + (defined $td)?'':'', "\n" + + } elsif (defined $matrix[$y][$x]{host}) { + print H " \n"; + } + } + } + print H " \n"; + } + print H "
$headertitles[$_]
"; + my $url = "$p://".$hosts[$y].getPathForProtocol($hosts[$y], $section, $p); + $url .= '/' if $url !~ /\/$/; + print H "", + ((defined $hosts[$y])?$hosts[$y]:' '), ""; + print H " <-----
\n"; + + print H "

 

\n"; + print H "
\n"; + printHierarchyList($section, 0, \%a); + print H "
\n"; +} + +## ####### ####### ###### # ##### + +print H "

".join(", ", map {"$_" } @sections); + +computeTraceStates(); + +foreach my $sect (@sections) { + print H "

see legend

"; + printSectionInfo($sect); + print H '

 

'; +# printHierarchies($sect); +} + +# legend +print H <Legend + + + + + + + + + +
UIP!Archive_update_in_progress file found
TType: +
    +
  • P: Push-Primary +
  • S: Push-Secondary +
  • L: Leaf +
  • ?: not in DB (will be leaf, of course) +
+
+EOF + +print H "

Trace errors:\n\n"; +foreach my $k (keys %TraceTypeText) { + print H "\n"; +} +print H "
$k: $TraceTypeText{$k}

\n"; + +print H < +HostPattern: $hostpattern + + + +EOF +close H; diff --git a/mirrorcheck/bin/dmc.pl b/mirrorcheck/bin/dmc.pl new file mode 100755 index 0000000..a141fda --- /dev/null +++ b/mirrorcheck/bin/dmc.pl @@ -0,0 +1,1371 @@ +#! /usr/bin/perl -w + +# Copyright (C) 2001-2002 Adam Lackorzynski +# +# This file contains free software, you can redistribute it and/or modify +# it under the terms of the GNU General Public License, Version 2 as +# published by the Free Software Foundation (see the file COPYING). +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# Adam Lackorzynski + +# todo +# - time of query (maybe, will consume too much space) +# - maybe some bars marking time all the servers are behind the +# the most recent server +# - rewrite and do it better this time... + +use strict; +use LWP::UserAgent; +use Data::Dumper; +use Getopt::Long; +use File::Listing; +use Carp (); + +#local $SIG{__WARN__} = \&Carp::confess; #cluck; +#local $SIG{__DIE__} = \&Carp::confess; +#$SIG{INT} = \&Carp::confess; + +my $hostpattern = +#'([wp]\.de\.debian\.org$|den\.de$|erlangen|(se|uk|fi)\.debian)'; +#'(\.debian\.org$|\.de$)'; +#'([pw]\.de\.debian\.|dresden|claus)'; +#'dresden'; +#'(claus)'; +#'((www|ftp).de.debian.org$)'; +#'www\..+\.debian.org'; +#'(\.de$)'; +#'(ftp|www)\.(se|de|at|es|fr|uk|it|pl|nl|tr).debian.org$|\.de$'; +#'ftp.wa.au'; +#'www.mirror.ac.uk|dresden|claus|\.de.debian.org|erlan|berlin'; +#'www.mirror.ac.uk'; +#'www2'; +#'ftp.(at|si).debian.org'; +#'ftp.si.debian.org'; +'.'; +#'.debian.org'; + +my $tracedir_std_main = "project/trace"; +my $masterfile_stdmain = "ftp-master.debian.org"; +my $tracedir_std_cd = "project/trace"; +my $masterfile_stdcd = "cdimage.debian.org"; +my $tracedir_std_www = "mirror/timestamps"; +my $masterfile_stdwww = "www-master.debian.org"; +my $tracedir_std_sec = "project/trace"; +my $masterfile_stdsec = "security-master.debian.org"; +my $tracedir_std_vol = "project/trace"; +my $masterfile_stdvol = "volatile-master.debian.net"; + +my $archivUpdatePattern = "Archive-Update-in-Progress-"; + +my $masterlistURL = 'http://cvs.debian.org/*checkout*/webwml/english/mirror/Mirrors.masterlist?cvsroot=webwml'; + +my @sections = qw/main cd security volatile www/; + +# order of protocols is important -> ftp is easier to parse for the upstream +# mirror list, so do this one first... +my %protocols = + ( + main => [qw/ftp http rsync/], + cd => [qw/ftp http rsync/], + security => [qw/ftp http rsync/], + volatile => [qw/ftp http rsync/], + www => [qw/http/], + ); + +my %addrs = + ( +# 'debian.inf.tu-dresden.de' => +# { +# main => +# { path => '/debian', +# tracedir => $tracedir_std_main, mastertracefile => $masterfile_stdmain, }, +# cd => +# { path_http => '/debian-cd', path_ftp => '/debian-cd', patch_rsync => 'debian-cd', }, +# }, +# 'os.inf.tu-dresden.de' => +# { +# main => +# { path => '/debian', +# tracedir => $tracedir_std_main, mastertracefile => $masterfile_stdmain, }, +# checkProtocol => [ 'http', ], +# cd => +# { path_http => '/debian-cd'}, +# }, + ); + +my $debug = 1; +my $DisplayNonCheckedHosts = 0; + +my $HtmlFile = "www/status.html"; +my $MasterFile = "master.list"; +my $DataFile = "mirror.data"; +my $DataFileIP = "mirror.data.ip"; + +my @arg_options = ("masterfile|m=s", \$MasterFile, + "datafile|d=s", \$DataFile, + "datafileip|i=s", \$DataFileIP, + "htmlfile|o=s", \$HtmlFile, + "displaynonchecked!", \$DisplayNonCheckedHosts, + ); + +# some mirrors have authenticated rsync access only although they're in +# the mirror list... +# do not let rsync pop up with a password prompt +$ENV{'RSYNC_PASSWORD'} = ''; + +umask 022; +my $MasterListRefreshTime = 24*3600; # 1 day +my $IPListRefreshTime = 2*24*2600; # 2 days +my $OutOfDateTime = 3600*24*2; # 2 days +my $connectionTimeout = 10; # secs +my $prog_rsync = "rsync --timeout=$connectionTimeout"; +my %timestamps = + ( + data_capture_start => 0, + data_capture_end => 0, + ); +my $IPDataCaptureTime = 0; + +my $ERRORMSGCUTBYTES = 200; + +my %data; +my %IPs; +my (@errors_full, @errors_filt); +my %openedfile = (); + +sub DBG { + print join("", @_) if $debug; +} + +sub getTempFile { + $_ = `/bin/mktemp /tmp/mirstat.temp.XXXXXX`; + chomp; + $_; +} + +sub getHtmlFullErrorFileName { + my $r; + if ($HtmlFile =~ /\.html$/) { + ($r = $HtmlFile) =~ s/html$/full-errors.$&/i; + } else { + $r = $HtmlFile."full-errors.html"; + } + $r; +} + +sub rsyncErrorFilter { + my ($text) = @_; + # In rsync error messages normally only the last line is significant + (reverse split(/\n/, $text))[0]; +} + +sub getErrorNrFull { + my ($text) = @_; + my $i = 0; + for (; $i <= $#errors_full; $i++) { + return $i if ($errors_full[$i] eq $text); + } + $errors_full[$i] = $text; + $i; +} + +sub getErrorNr { + my ($text, $protocol) = @_; + my $i = getErrorNrFull($text); + if ($protocol =~ /rsync/) { + $text = rsyncErrorFilter($text); + } + # trim text also in case it's too long + $errors_filt[$i] = substr($text, 0, $ERRORMSGCUTBYTES); + $i; +} + +sub parseMasterData { + my ($host, $key, $val) = @_; + + # print "$host $key $val\n"; + $val =~ s,(.)/$,$1,; + + if ($key =~ /Archive-/) { + $addrs{$host}{main}{mastertracefile} = $masterfile_stdmain; + $addrs{$host}{main}{tracedir} = $tracedir_std_main; + } elsif ($key =~ /CDImage-/) { + $addrs{$host}{cd}{mastertracefile} = $masterfile_stdcd; + $addrs{$host}{cd}{tracedir} = $tracedir_std_cd; + } elsif ($key =~ /Security-/) { + $addrs{$host}{security}{mastertracefile} = $masterfile_stdsec; + $addrs{$host}{security}{tracedir} = $tracedir_std_sec; + } elsif ($key =~ /Volatile-/) { + $addrs{$host}{volatile}{mastertracefile} = $masterfile_stdvol; + $addrs{$host}{volatile}{tracedir} = $tracedir_std_vol; + } elsif ($key =~ /WWW-/) { + $addrs{$host}{www}{mastertracefile} = $masterfile_stdwww; + $addrs{$host}{www}{tracedir} = $tracedir_std_www; + } + + if ($key =~ /Archive-http/i) { + $addrs{$host}{main}{path_http} = $val; + } elsif ($key =~ /Archive-ftp/i) { + $addrs{$host}{main}{path_ftp} = $val; + } elsif ($key =~ /Archive-rsync/i) { + $addrs{$host}{main}{path_rsync} = $val; + } elsif ($key =~ /CDImage-http/i) { + $addrs{$host}{cd}{path_http} = $val; + } elsif ($key =~ /CDImage-ftp/i) { + $addrs{$host}{cd}{path_ftp} = $val; + } elsif ($key =~ /CDImage-rsync/i) { + $addrs{$host}{cd}{path_rsync} = $val; + } elsif ($key =~ /Security-http/i) { + $addrs{$host}{security}{path_http} = $val; + } elsif ($key =~ /Security-ftp/i) { + $addrs{$host}{security}{path_ftp} = $val; + } elsif ($key =~ /Security-rsync/i) { + $addrs{$host}{security}{path_rsync} = $val; + } elsif ($key =~ /Volatile-http/i) { + $addrs{$host}{volatile}{path_http} = $val; + } elsif ($key =~ /Volatile-ftp/i) { + $addrs{$host}{volatile}{path_ftp} = $val; + } elsif ($key =~ /Volatile-rsync/i) { + $addrs{$host}{volatile}{path_rsync} = $val; + } elsif ($key =~ /WWW-http/i) { + $addrs{$host}{www}{path_http} = $val; + } + # save all other info + $addrs{$host}{info}{$key} = $val; +} + +sub parseMirrorsMasterList { + my $ctime = 0; + $ctime = (stat($MasterFile))[9] if -f $MasterFile; + if ($ctime + $MasterListRefreshTime < time) { + DBG("Getting new master mirror list\n"); + open(F, "wget -q -O - '$masterlistURL' | tee $MasterFile |") or die $!; + } else { + open(F, $MasterFile) or die $!; + } + my $s = 0; + my ($host, $entryval, $entrykey) = (undef, undef, undef); + while (defined ($_=)) { + chomp; + s/\s*$//; + if ($s == 0) { # looking for site + next if /^$/; + next if /^X-/; + next if /^\s\S/; + die "format error ($_)" unless /^Site:\s*(\S+)/; + $host = $1; + $s = 1; + } else { + if (/^$/) { # end of description + $s = 0; + parseMasterData($host, $entrykey, $entryval) + if (defined $entrykey); + $entrykey = undef; + } else { + if (/^\s+/) { # continued line (starting with \s's) + s/^\s*/ /; + $entryval .= $_; + } else { + parseMasterData($host, $entrykey, $entryval) + if (defined $entrykey); + + ($entrykey, $entryval) = split(/: */, $_, 2); + die "format error($_)" unless $entrykey && $entryval; + } + } + } + } + close F; +} + +sub getSecondsOfDatestring { + my ($datestring) = @_; + $datestring = (split(/\n/, $datestring))[0]; + $_ = `date -d "$datestring" +%s 2>&1`; + chomp; + return "ERROR: $_" if $?; + $_; +} + +# get output from http/ftp request +sub getData_ftp_http { + my ($url) = @_; + my $ua = LWP::UserAgent->new; + $ua->agent(" "); + $ua->timeout($connectionTimeout); + my $res = $ua->request(HTTP::Request->new(GET => $url)); + return 'ERROR: ' . $res->status_line if $res->is_error; + my $d = $res->content; + chomp $d; + return $d; +} + +# get file via rsync +sub getData_rsync_file { + my ($url) = @_; + my $tmpf = getTempFile(); + my $d = `$prog_rsync $url $tmpf 2>&1`; + + # check for error messages - yes, can return with $?==0 although + # we've got an error (@ERROR: access denied...) + if ($d =~ /^\@ERROR: /m) { + $d = 'ERROR: '.$d; + } elsif (!$?) { + # request succesful + $d = ''; + open(D, $tmpf) || die $!; + while (defined ($_=)) { + chomp; + $d .= $_; + } + close D; + } # fall through otherwise... + + unlink $tmpf; + $d; +} + +# get output from rsync request +sub getData_rsync_output { + my ($url) = @_; + my $d = `$prog_rsync '$url' 2>&1`; + $d = 'ERROR: '.$d if $?; + $d; +} + +sub getFile { + my ($url) = @_; + if ($url =~ /^(ht|f)tp:/) { + return getData_ftp_http($url); + } elsif ($url =~ /^rsync:/) { + return getData_rsync_file($url); + } else { + die "INTERNAL ERROR: unknown protocol type!"; + } +} + +sub getDirListing { + my ($url) = @_; + if ($url =~ /^rsync:/) { + $url .= '/*' if ($url =~ /[^*]$/); + return getData_rsync_output($url); + } else { + $url .= '/' if $url !~ /\/$/; + return getData_ftp_http($url); + } +} + +sub removeHTMLTags { + $_ = shift; + s/<.*?>//sg; + $_; +} + +sub getPathForProtocol { + my ($host, $section, $protocol) = @_; + my $path = (defined $addrs{$host}{$section}{"path_$protocol"})? + $addrs{$host}{$section}{"path_$protocol"}: + $addrs{$host}{$section}{path}; + $path = '/'.$path if (defined $path && $path !~ m,^/,); + $path; +} + +sub checkUpdateInProgress { + my ($section) = @_; + ($section eq 'www')?0:1; +} + +sub checkIfUpdateIsInProgress { + my ($protocol, $host, $path, $section) = @_; + + # we check if an archiv update is in progress + # (by simply getting the directory listing of the topmost dir) + my $r = getDirListing("$protocol://$host$path"); + DBG($r, "\n"); + $data{$host}{$section}{updateInProgess} = + ($r =~ /$archivUpdatePattern/im)?1:0; + $data{$host}{$section}{$protocol} = + ($r !~ /^ERROR: /m)?-1:getErrorNr($r, $protocol); +} + +sub extractFileLinksFromDirHTMLListing { + my ($listing) = @_; + + my @files; + while ($listing =~ s/href\s*=\s*"?(.*?)[^\/\w.\d-](.*)/$2/i) { + my $a = $1; + #$a = (reverse split(/\//, $a))[0] if $a =~ /\//; + next if $a =~ m,/,; # don't take directories + next if (!defined $a || $a eq '' || $a =~ /^(http|ftp|mailto|trace)$/i); + if ($a !~ /\/$/) { + push @files, $a + if ($a !~ /^\.$/ && $a !~ /^\.\.$/ && $a !~ /^\./ && $a !~ /\.$/); + } + } + @files; +} + +sub extractFileLinksFromDirRsyncListing { + my ($listing) = @_; + my @files; + + for my $l (split(/\n/, $listing)) { + next unless ($l =~ /^.[rwxsSXt-]{9}\s/); + (my $name = $l) =~ s/.*\s([^\s]+)$/$1/; + push @files, $name; + } + + @files; +} + +sub extractFileLinksFromDirFTPListing { + my ($listing) = @_; + my @files; + + for (parse_dir($listing)) { + my ($name) = @$_; + push @files, $name; + } + @files; +} + +sub getLinkFilesOutOfListing { + my ($protocol, $listing) = @_; + my @files; + if ($protocol eq 'rsync') { + return extractFileLinksFromDirRsyncListing($listing); + } elsif ($protocol eq 'http') { + return extractFileLinksFromDirHTMLListing($listing); + } elsif ($protocol eq 'ftp') { + return extractFileLinksFromDirFTPListing($listing); + } else { + print STDERR "not impl\n"; + } + return (); +} + +sub cleanOutNonMirrorTraceFiles { + my (@list) = @_; + + my @nl; + for (@list) { + next if (/\.(html?|css)$/); + push @nl, $_; + } + @nl; +} + +sub uniqueList { + my (@list) = @_; + + my @nl; + my $d = ''; + for (sort @list) { + push @nl, $_ if $d ne $_; + $d = $_; + } + @nl; +} + +sub masterSet__ { + my ($t, $failret, $host, $section, $val) = @_; + return $failret unless defined $addrs{$host}{$section}{mastertracefile}; + $data{$host}{$section}{$t}{$addrs{$host}{$section}{mastertracefile}} + = $val if defined $val; + $data{$host}{$section}{$t}{$addrs{$host}{$section}{mastertracefile}}; +} +sub masterTimeString { return masterSet__('timestamps_str', '', @_); } +sub masterSeconds { return masterSet__('timestamps_sec', 0, @_); } + +sub getUndefinedTimestampFile { + my ($host, $section) = @_; + foreach my $m (keys %{$data{$host}{$section}{timestamps_str}}) { + return $m unless defined $data{$host}{$section}{timestamps_str}{$m}; + } + undef; +} + +sub getWorkingProtocol { + my ($host, $section) = @_; + + foreach my $p (@{$protocols{$section}}) { + next unless defined $data{$host}{$section}{$p}; + return $p; + } + undef; +} + +sub isProtocolHTTPWorking { + my ($host, $section) = @_; + + return defined $data{$host}{$section}{'http'}; +} + +sub getHostInfo { + my ($hostname) = @_; + + return 0 if defined $IPs{$hostname}; + + $? = 0; # huh, why is that needed? + my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($hostname); + + #print "HUUUU: $hostname $?\n"; + return 0 if ($?); + + foreach my $h ($hostname, $name, split(/\s+/, $aliases)) { + next if $h eq '' || defined $IPs{$h}; + $IPs{$h} = [map { join(".", unpack('C4', $_)) } @addrs]; + print "IP: $h: ", join(", ", map { join(".", unpack('C4', $_)) } @addrs), "\n"; + } + 1; +} + +sub areHostsEqual { + my ($host1, $host2) = @_; + + return 0 unless defined $IPs{$host1} && defined $IPs{$host2}; + my @h1 = @{$IPs{$host1}}; + my @h2 = @{$IPs{$host2}}; + for (my $i = 0; $i <= $#h1; $i++) { + for (my $j = 0; $j <= $#h2; $j++) { + return 1 if $h1[$i] eq $h2[$j]; + } + } + 0; +} + +sub getOfficialHostname { + my ($h, $section) = @_; + + return $h if (grep(/^$h$/, keys %addrs)); + return $h unless defined $IPs{$h}; + for my $a (keys %addrs) { + next unless defined $IPs{$a}; + foreach my $i (@{$IPs{$a}}) { + return $a if (grep(/^$i$/, @{$IPs{$h}}) && + @{$IPs{$a}} == 1 && # NO DNS round robin entries... + defined $addrs{$a}{$section}{tracedir}); + } + } + return $h; +} + +sub doStep { + my ($host, $section, $protocol) = @_; + + # get path since we can have protocol specific paths + my $path = getPathForProtocol($host, $section, $protocol); + return unless defined $path; + + DBG(">>>> $host - $section - $protocol - $path\n"); + + unless (defined $data{$host}{$section}{timestamps_sec}) { + next unless (defined $addrs{$host}{$section}{tracedir}); + my $pa = $path; + $pa .= '/' if ($pa !~ /\/$/); + $pa .= $addrs{$host}{$section}{tracedir}; + my $listing = getDirListing("$protocol://$host$pa"); + if ($listing !~ /^ERROR: /m) { + my @files = getLinkFilesOutOfListing($protocol, $listing); + @files = cleanOutNonMirrorTraceFiles(uniqueList(@files)); + DBG("Got upstream mirrors (via $protocol): ".join(", ", @files), "\n"); + + #print STDERR "TODO: check for ", scalar @files, " == 1 --> client failure!\n"; + + # some badly configured servers return HTTP 200 codes even + # if they should return 404... + next unless (defined $addrs{$host}{$section}{mastertracefile}); + if (grep(/^$addrs{$host}{$section}{mastertracefile}$/, @files)) { + $data{$host}{$section}{$protocol} = -1; + foreach my $h (@files) { + $data{$host}{$section}{timestamps_str}{$h} = undef; + $data{$host}{$section}{timestamps_sec}{$h} = undef; + } + } else { +# warn "Missing master file $addrs{$host}{$section}{mastertracefile} on $host\n"; + if ($listing =~ //i) { + $listing = "ERROR: ".$listing if ($listing !~ /^ERROR: /); + $listing = removeHTMLTags($listing); + } + $data{$host}{$section}{$protocol} = getErrorNr($listing, $protocol); + } + + } else { + $data{$host}{$section}{$protocol} = getErrorNr($listing, $protocol); + } + + } elsif ((my $file = getUndefinedTimestampFile($host, $section)) && + (!defined $data{$host}{$section}{$protocol} || + $data{$host}{$section}{$protocol} == -1)) { + my $pa = $path; + $pa .= '/' if ($pa !~ /\/$/); + $pa .= $addrs{$host}{$section}{tracedir}.'/'.$file; + DBG("getting tracefile via $protocol://$host$pa\n"); + my $d = getFile("$protocol://$host$pa"); + DBG("output: $d\n"); + + # some badly configured servers return a HTTP code 200 even + # if they could not find a file and present a nicely formated + # error message + if (length($d) > 60) { + $d = "ERROR: ".$d if ($d !~ /^ERROR: /); + $d = removeHTMLTags($d); + } + if ($d !~ /^ERROR: /m) { + $data{$host}{$section}{$protocol} = -1; + $data{$host}{$section}{timestamps_str}{$file} = $d; + $data{$host}{$section}{timestamps_sec}{$file} = getSecondsOfDatestring($d); + if ($data{$host}{$section}{timestamps_sec}{$file} =~ /^ERROR: /) { + $data{$host}{$section}{timestamps_sec}{$file} = 0; + } + } else { + $data{$host}{$section}{$protocol} = getErrorNr($d, $protocol); + } + + } elsif (!defined $data{$host}{$section}{updateInProgess} && + checkUpdateInProgress($section)) { + DBG("Checking if update in progress\n"); + checkIfUpdateIsInProgress($protocol, $host, $path, $section); + + } else { + # done + DBG("done\n"); + return 0; + } + 1; +} + + +###################################################################### + +Getopt::Long::config("pass_through"); +my $optret = GetOptions(@arg_options); + +if (defined $ARGV[0] && $ARGV[0] eq 'get') { + + parseMirrorsMasterList(); + + $timestamps{data_capture_start} = time(); + + foreach my $host (keys %addrs) { + next if ($host !~ /$hostpattern/); + + foreach my $section (@sections) { + + foreach my $protocol (@{$protocols{$section}}) { + next if (defined $addrs{$host}{checkProtocol} && + !grep(/^$protocol$/, @{$addrs{$host}{checkProtocol}})); + + # following steps: + # - get directory listing + # - if master-files not in dir-listing -> error + # - get all timestamp files from dir-listing + # - check if update in progress... + + doStep($host, $section, $protocol); + + + } # foreach protocol + + if (defined $data{$host}{$section}{timestamps_sec}) { + # ok, we've got at least one protocol that works + my $protocol = undef; + # find it + foreach (@{$protocols{$section}}) { + $protocol = $_, last + if (defined $data{$host}{$section}{$_} && + $data{$host}{$section}{$_} == -1); + } + if (defined $protocol) { + while (doStep($host, $section, $protocol)) {} + } else { + print STDERR "BIG INTERNAL ERROR!\n"; + } + } + + } # foreach section (main, ...) + + } # foreach host + + # get the IPs of all hostnames to find hosts with more than one name + # (e.g. real name and debian.org alias) + + + if (open(I, $DataFileIP)) { + my $dat; + while () { + $dat .= $_; + } + close I; + eval $dat; + } + + print "$IPDataCaptureTime + $IPListRefreshTime\n"; + if ($IPDataCaptureTime + $IPListRefreshTime < time) { + print "IPs:\n"; + foreach my $host (keys %addrs) { + print "$host\n"; + getHostInfo($host); + } + foreach my $host (keys %data) { + print "$host\n"; + getHostInfo($host); + foreach my $section (keys %{$data{$host}}) { + print " $section\n"; + if (defined $data{$host}{$section}{timestamps_str}) { + foreach my $tsh (keys %{$data{$host}{$section}{timestamps_str}}) { + print " $tsh\n"; + getHostInfo($tsh); + } + } + } + } + + open(I, ">$DataFileIP") || die $!; + $Data::Dumper::Indent = 1; + $IPDataCaptureTime = time; + print I Data::Dumper->Dump + ([$IPDataCaptureTime, \%IPs], [qw/IPDataCaptureTime *IPs/]); + close I; + } + + open(A, ">$DataFile") || die $!; + $Data::Dumper::Indent = 1; + $timestamps{data_capture_end} = time(); + print A Data::Dumper->Dump + ([\%timestamps, \%addrs, \%data, \@errors_filt, \@errors_full], + [qw/*timestamps *addrs *data *errors_filt *errors_full/]); + close A; + +} else { + + open(A, "$DataFile") || die $!; + my $dat; + while () { + $dat .= $_; + } + close A; + eval $dat; + + open(I, $DataFileIP) || die $!; + $dat = ''; + while () { + $dat .= $_; + } + close I; + eval $dat; + + DBG("Using data created between ", + scalar localtime $timestamps{data_capture_start}, " and ", + scalar localtime $timestamps{data_capture_end}, "\n"); +} + + + + + + + + +####### create HTML file out of the generated data... ###### + +DBG("Creating HTML files ($HtmlFile)\n\n"); + +open(H, ">$HtmlFile") || die $!; + +my $dts_s = (scalar gmtime $timestamps{data_capture_start})." UTC"; +my $dts_e = (scalar gmtime $timestamps{data_capture_end})." UTC"; +my $now_utc = (scalar gmtime time)." UTC"; +print H <Debian Mirror Checker + + + + + + + +
+ + + Debian Project + + Data capturing time window:
$dts_s
- $dts_e
+ HTML-file creation time: $now_utc +
+

Debian Mirror Checker

+EOF + +sub validSection { + my ($host, $sect) = @_; + return 1 if (defined $addrs{$host}{$sect}{path}); + foreach (@{$protocols{$sect}}) { + return 1 if (defined $addrs{$host}{$sect}{"path_$_"}); + } + 0; +} + +use constant TRACE_NO_MASTERFILE => 1; +use constant TRACE_TIMESTAMPS_BEFORE_MASTER => 2; +use constant TRACE_INVALID_DATES => 3; +use constant TRACE_NOT_DOWNLOADABLE => 4; +use constant TRACE_NO_PRIMARY => 5; +use constant TRACE_NO_SECONDARY => 6; +use constant TRACE_NO_TRACEFILE_FOR_OWN_MIRROR => 7; +use constant TRACE_NO_TRACEFILES_AT_ALL => 8; + +my %TraceTypeText = +( + &TRACE_NO_MASTERFILE => + 'No master file found', + &TRACE_TIMESTAMPS_BEFORE_MASTER => + 'Older (non-valid) timestamp files found', + &TRACE_INVALID_DATES => + 'Timestamp files contain invalid dates', + &TRACE_NOT_DOWNLOADABLE => + 'Trace files are not downloadable', + &TRACE_NO_PRIMARY => + 'Mirror lacks trace files from their upstream, it is not a primary', + &TRACE_NO_SECONDARY => + 'Mirror lacks trace files from their upstream, it is not a secondary', + &TRACE_NO_TRACEFILE_FOR_OWN_MIRROR => + 'The local trace file is missing', + &TRACE_NO_TRACEFILES_AT_ALL => + 'There are no trace files at all', +); + +use constant MIRROR_ORIGIN => 0; +use constant MIRROR_PRIMARY => 1; +use constant MIRROR_SECONDARY => 2; +use constant MIRROR_LEAF => 3; +use constant MIRROR_UNKNOWN => 4; + +my %mirrorHTMLIDs = +( + &MIRROR_ORIGIN => 'O', + &MIRROR_PRIMARY => 'P', + &MIRROR_SECONDARY => 'S', + &MIRROR_LEAF => 'L', + &MIRROR_UNKNOWN => '?', +); +my %mirrorTypes = +( + 'Origin' => MIRROR_ORIGIN, + 'Push-Primary' => MIRROR_PRIMARY, + 'Push-Secondary' => MIRROR_SECONDARY, + 'leaf' => MIRROR_LEAF, +); + +sub getMirrorType { + my ($host) = @_; + return $mirrorTypes{$addrs{$host}{info}{Type}} + if defined $addrs{$host}{info}{Type} and + defined $mirrorTypes{$addrs{$host}{info}{Type}}; + # return $addrs{$host}{info}{Type} + # if defined $addrs{$host}{info}{Type}; + return MIRROR_UNKNOWN; +} + +sub getMirrorHTMLIDs { + my ($host) = @_; + return $mirrorHTMLIDs{getMirrorType($host)}; +} + + +sub addTraceEntry { + my ($host, $section, $entry) = @_; + push @{$data{$host}{$section}{tracestat}}, $entry; +} + +sub getTraceEntries { + my ($host, $section) = @_; + return () unless defined $data{$host}{$section}{tracestat}; + @{$data{$host}{$section}{tracestat}}; +} + +sub isTraceEntry { + my ($host, $section, $nr) = @_; + + return 0 unless defined $data{$host}{$section}{tracestat}; + foreach my $t (@{$data{$host}{$section}{tracestat}}) { + return 1 if $nr == $t; + } + return 0; +} + +sub computeTraceStates { + + foreach my $section (@sections) { + foreach my $host (keys %data) { + next unless defined $data{$host}{$section}; + + # TRACE_NO_TRACEFILES_AT_ALL + addTraceEntry($host, $section, TRACE_NO_TRACEFILES_AT_ALL) + unless defined $data{$host}{$section}{timestamps_str}; + + # TRACE_NO_MASTERFILE + # TRACE_TIMESTAMPS_BEFORE_MASTER + my $ms = masterSeconds($host, $section); + if (!defined $ms || $ms == 0) { + addTraceEntry($host, $section, TRACE_NO_MASTERFILE); + } else { + foreach my $k (keys %{$data{$host}{$section}{timestamps_sec}}) { + if (defined $data{$host}{$section}{timestamps_sec}{$k} && + $data{$host}{$section}{timestamps_sec}{$k} != 0 && + $data{$host}{$section}{timestamps_sec}{$k} < $ms) { + addTraceEntry($host, $section, TRACE_TIMESTAMPS_BEFORE_MASTER); + last; + } + } + } + + # TRACE_INVALID_DATES + foreach my $k (keys %{$data{$host}{$section}{timestamps_sec}}) { + if (defined $data{$host}{$section}{timestamps_sec}{$k} && + $data{$host}{$section}{timestamps_sec}{$k} == 0) { + addTraceEntry($host, $section, TRACE_INVALID_DATES); + last; + } + } + + # TRACE_NOT_DOWNLOADABLE + # not implemented yet... + + my $mirror_type = getMirrorType($host); + my $credit; + # TRACE_NO_PRIMARY + if ($mirror_type != MIRROR_PRIMARY and $mirror_type != MIRROR_ORIGIN) { + $credit = 1; + $credit++ if (defined $ms && $ms != 0); + $credit++ + if (defined $data{$host}{$section}{timestamps_str}{$host}); + addTraceEntry($host, $section, TRACE_NO_PRIMARY) + if (scalar keys %{$data{$host}{$section}{timestamps_str}} < + $credit); + } + + + # TRACE_NO_SECONDARY + if ($mirror_type == MIRROR_SECONDARY) { + $credit = 1; + $credit++ if (defined $ms && $ms != 0); + $credit++ + if (defined $data{$host}{$section}{timestamps_str}{$host}); + addTraceEntry($host, $section, TRACE_NO_SECONDARY) + if (scalar keys %{$data{$host}{$section}{timestamps_str}} < + $credit); + } + + # TRACE_NO_TRACEFILE_FOR_OWN_MIRROR + my $bo = defined $data{$host}{$section}{timestamps_str}{$host}; + foreach my $h (keys %{$data{$host}{$section}{timestamps_str}}) { + last if $bo; + $bo = 1 if getOfficialHostname($h, $section) eq $host; + } + addTraceEntry($host, $section, TRACE_NO_TRACEFILE_FOR_OWN_MIRROR) + unless $bo; + } + + } + +} + +sub printSectionInfo { + my $sect = shift; + my $i = 1; + my $master_type = ($sect eq 'www')?'www':'ftp'; + + print H "

Archive: $sect

\n\n\n"; +} + +sub printHierarchyList { + my ($section, $pad, $z) = @_; + + print H " "x$pad, "
    \n"; + foreach (keys %$z) { + next if $_ eq '__count__'; + my $rs = ''; + $rs .= " class=\"misplaced\"" + if (isTraceEntry($_, $section, TRACE_NO_PRIMARY) || + isTraceEntry($_, $section, TRACE_NO_SECONDARY)); + print H " "x($pad+1), "$_", + ($$z{$_}{__count__} > 1)?" ($$z{$_}{__count__})":'', "\n"; + + printHierarchyList($section, $pad+1, $$z{$_}) if keys %{$$z{$_}} > 1; + } + print H " "x$pad, "
\n"; +} + +sub constructMatrix { + my ($y, $x, $matrix, $hosts, %z) = @_; + my $ysum=0; + foreach my $z (keys %z) { + next if $z eq '__count__'; + #print "II (",$y+$ysum,", $x): ", " "x$x, $z{$z}{'__count__'}, " $z\n"; + $matrix->[$y+$ysum][$x] = { "__count__" => $z{$z}{'__count__'}, host => $z}; + $hosts->[$y+$ysum] = $z; + my $i = 1; + for ($i = 1; $i < $z{$z}{'__count__'}; $i++) { + $matrix->[$y+$ysum+$i][$x] = { "__count__" => 0}; + } + my $childsum = constructMatrix($y+$ysum, $x+1, $matrix, $hosts, %{$z{$z}}); + + if ($childsum) { + foreach my $pad (($childsum)..($z{$z}{'__count__'}-1)) { + unless (defined $matrix->[$y+$ysum+$pad][$x+1]) { + $matrix->[$y+$ysum+$pad][$x+1] = { "__count__" => 0, host => '' }; + #print "PP (",$y+$ysum+$pad,", ", $x+1, "): ", " "x$x, $z{$z}{'__count__'}, "\n"; + $hosts->[$y+$ysum+$pad] = $z; + } + } + } + $ysum += $z{$z}{__count__}; + } + #print "SUM: $ysum\n"; + $ysum; +} + +sub printHierarchies { + my ($section) = @_; + + my %a; + my $longest = 0; + my $pa; + foreach my $host (keys %data) { + my $mts = masterTimeString($host, $section); + next if !defined $mts || $mts eq ''; + if (defined $data{$host}{$section}{timestamps_sec} ) { + my @tmp = + sort { ($data{$host}{$section}{timestamps_sec}{$a} || 0xffffffff) + <=> ($data{$host}{$section}{timestamps_sec}{$b} || 0xffffffff) } + keys %{$data{$host}{$section}{timestamps_sec}}; + my $ms = masterSeconds($host, $section); + $ms = 0 unless defined $ms; + + #print STDERR "Unoff: ", join(", ", @tmp), "\n"; + my @tmpoff = map { getOfficialHostname($_, $section) } @tmp; + #print STDERR "Off: ", join(", ", @tmpoff), "\n"; + $longest = @tmp if $longest < @tmp; + $pa = \%a; + push @tmp, $host; + push @tmpoff, $host; + for (my $t = 0; $t <= $#tmp; $t++) { + next + if (defined $data{$host}{$section}{timestamps_sec}{$tmp[$t]} && + $data{$host}{$section}{timestamps_sec}{$tmp[$t]} < $ms); + next if ($t < $#tmp && areHostsEqual($tmp[$t], $tmp[$t+1])); + + #print "$tmpoff[$t] "; + $pa->{$tmpoff[$t]} = {} unless defined $pa->{$tmpoff[$t]}; + $pa->{$tmpoff[$t]}{__count__}++; + $pa = $pa->{$tmpoff[$t]}; + } + #print "\n"; + } + } + + #$Data::Dumper::Indent = 1; + #print Data::Dumper->Dump([\%a], ['*a']), "\n"; + + my @matrix = (); + my @hosts = (); + constructMatrix(0, 0, \@matrix, \@hosts, %a); + + #$Data::Dumper::Indent = 1; + #print Data::Dumper->Dump([\@matrix], ['*matrix']), "\n"; + + #print join("_", map { (defined)?$_:'U' }@hosts), "\n"; + + my $maxwidth = 0; + for (my $y=0; $y <= $#matrix; $y++ ) { + $maxwidth = @{$matrix[$y]} if @{$matrix[$y]} > $maxwidth; + } + print H "\n"; + print H ""; + my @headertitles = qw(Host Master Primary Secondary/Leaf Leaf...); + $maxwidth = @headertitles-1 if @headertitles <= $maxwidth; + for (0..$maxwidth) { + print H ""; + } + print H "\n"; + + for (my $y=0; $y <= $#matrix; $y++ ){ + # we prefer HTTP for links + my $p = 'http'; + $p = getWorkingProtocol($hosts[$y], $section) + if (!isProtocolHTTPWorking($hosts[$y], $section)); + next unless defined $p; + + print H " \n \n"; + + for (my $x=0; $x < @{$matrix[$y]}; $x++) { + if (defined $matrix[$y][$x]) { + if ($matrix[$y][$x]{__count__}) { + my $host = $matrix[$y][$x]{host}; + my $count = $matrix[$y][$x]{__count__}; + my $td; + if (defined ($p = getWorkingProtocol($host, $section))) { + $p = 'http' if isProtocolHTTPWorking($host, $section); + $td = $addrs{$host}{$section}{tracedir}; + $url = "$p://".$host.getPathForProtocol($host, $section, $p).'/'.$td; + $url .= '/' if $url !~ /\/$/; + } + my $rs = ''; + my $as = ''; + $rs .= " rowspan=\"$count\"" if $count > 1; + if (isTraceEntry($host, $section, TRACE_NO_PRIMARY) || + isTraceEntry($host, $section, TRACE_NO_SECONDARY)) { + $as = ' class="misplaced"'; + $rs .= $as if !defined $td; + } else { + $as .= ' class="inv"'; + } + print H + " ", (defined $td)?"":'', + ($count > 1)?($count.'-'):'', $host, + (defined $td)?'':'', "\n" + + } elsif (defined $matrix[$y][$x]{host}) { + print H " \n"; + } + } + } + print H " \n"; + } + print H "
$headertitles[$_]
"; + my $url = "$p://".$hosts[$y].getPathForProtocol($hosts[$y], $section, $p); + $url .= '/' if $url !~ /\/$/; + print H "", + ((defined $hosts[$y])?$hosts[$y]:' '), ""; + print H " <-----
\n"; + + print H "

 

\n"; + print H "
\n"; + printHierarchyList($section, 0, \%a); + print H "
\n"; +} + +## ####### ####### ###### # ##### + +print H "

".join(", ", map {"$_" } @sections); + +computeTraceStates(); + +foreach my $sect (@sections) { + print H "

see legend

"; + printSectionInfo($sect); + print H '

 

'; +# printHierarchies($sect); +} + +# legend +print H <Legend + + + + + + + + + +
UIP!Archive_update_in_progress file found
TType: +
    +
  • P: Push-Primary +
  • S: Push-Secondary +
  • L: Leaf +
  • ?: not in DB (will be leaf, of course) +
+
+EOF + +print H "

Trace errors:\n\n"; +foreach my $k (keys %TraceTypeText) { + print H "\n"; +} +print H "
$k: $TraceTypeText{$k}

\n"; + +print H < +HostPattern: $hostpattern + + + +EOF +close H; diff --git a/mirrorcheck/www/.dummy b/mirrorcheck/www/.dummy new file mode 100644 index 0000000..e69de29 -- cgit v1.2.3