#!/usr/bin/perl
# Debian CD mirror checking script.
# Copyright 2002 by Joey Hess. Licensed under the GNU GPL.
#
# This program verifies that ftp CD mirrors have the required files in the
# right places and with the right sizes. It updates the Mirrors.masterlist
# file with information about the state of the mirrors. A report is also
# output to stdout, and debugging logs to stderr.

use strict;
use warnings;
use Net::FTP;

# Command-line arguments:
my $mirrorlist=shift || 'Mirrors.masterlist';
my $arch=shift || 'i386';

# Configuration:
#
# The current release of Debian.
my $debver="3.0_r0";
# The name of the directory binary iso images should be mirrored to.
my $isodir="$debver/$arch";
# The iso filenames to check for, and their expected sizes (in bytes). 
# If zero, the size is not checked.
my %isofiles=("debian-30r0-$arch-binary-1.iso" => 612171776);
# The name of the directory source iso images should be mirrored to.
my $sourcedir="$debver/source";
# The source iso filenames to check for, and their expected sizes (in bytes). 
# If zero, the size is not checked.
my %sourcefiles=("debian-30r0-source-1.iso" => 564953088);
# How many times to retry connections.
my $num_retry=5;

sub debug {
	print STDERR shift()."\n";
}

sub pp {
	my $val=shift;
	return ' ' unless defined $val;
	return 0 unless length $val;
	return $val;
}
				
sub get_mirror_info {
	my $file=shift;

	my %ret;
	open (IN, $file) || die "cannot read $file: $!\n";
	$/="\n\n";
	while (<IN>) {
		my ($site, $topdir);
		if (/Site:\s+(.*)/i) {
			$site=$1;
		}
		if (/CDImage-ftp:\s+(.*)/i) {
			$topdir=$1;
		}
		$ret{$site} = {site => $site, topdir => $topdir, 
			       retries => 0, stanza => $_};
	}
	close IN;

	# Load up supplimental status file.
	open (IN, "$file.status");
	while (</IN>) {
		if (/Site:\s+(.*)/i) {
			my $site=$1;
			foreach my $line (split("\n", $_)) {
				my ($key, $value) = $line =~ /^(.*): (.*)/;
				$ret{$site}->{status}->{$key} = $value unless $key eq 'Site';
			}
		}
	}
	
	return values %ret;
}

sub check_files {
	my $ftp=shift;
	my $dir=shift;
	my %hash=@_;

	$ftp->cwd($dir) || return 0;
	my @ls=$ftp->ls;
	foreach my $file (keys %hash) {
		if (! grep { $_ eq $file } @ls) {
			debug "fail for $file in @ls";
			return 0;
		}
		elsif ($hash{$file} != 0) {
			$ftp->binary;
			my $size=$ftp->size($file);
			if (defined $size && $size != $hash{$file}) {
				debug "file $file has size $size, rather than expected $hash{$file}";
				return '?';
			}
		}
	}
	return 1;
}

$|=1;
print "login ok  dir exists  binary  source  site\n";
my @mirrors=get_mirror_info($mirrorlist);
my @save;
while (@mirrors) {
	my $mirror=shift @mirrors;
	next unless defined $mirror->{site} and defined $mirror->{topdir};
	my $login_ok = 0;
	my ($dir_exists, $found_iso, $found_source);
	debug "trying $mirror->{site} $mirror->{topdir}";
	my $ftp=Net::FTP->new($mirror->{site}, Debug => 1);
	if ($ftp) {
		$login_ok = $ftp->login();
		if ($login_ok) {
			$dir_exists = $ftp->cwd($mirror->{topdir});
		}
		if ($dir_exists) {
			$found_iso = check_files($ftp, $isodir, %isofiles);
			#$ftp->cwd($topdir);
			$ftp->cwd($mirror->{topdir});
			$found_source = check_files($ftp, $sourcedir, %sourcefiles);
		}
	}
	
	if (! $login_ok) {
		$mirror->{retries}++;
		if ($mirror->{retries} < $num_retry) {
			debug "re-queuing $mirror->{site} (try #$mirror->{retries})";
			push @mirrors, $mirror;
			next;
		}
	}
	
	print pp($login_ok)."         ".pp($dir_exists)."           ".
	      pp($found_iso)."       ".pp($found_source).
	      "       $mirror->{site}\n";
	
	if (defined $found_iso && $found_iso) {
		$mirror->{status}->{"CDImage-ftp-status"} = "good";
		$mirror->{status}->{"CDImage-ftp-lastgood"} = time;
	}
	elsif (! defined $login_ok || ! $login_ok) {
		$mirror->{status}->{"CDImage-ftp-status"} = "down";
	}
	else {
		$mirror->{status}->{"CDImage-ftp-status"} = "bad";
	}
	$mirror->{status}->{"CDImage-ftp-lastchecked"} = time;
	push @save, $mirror;
}

# Write out new mirror file making minimal changes and preserving order.
open(OUT, ">$mirrorlist.status.new") || die "cannot write to $mirrorlist.status.new: $!";
foreach my $mirror (sort { $a->{site} cmp $b->{site} } @save) {
	print OUT "Site: $mirror->{site}\n";
	foreach my $key (keys %{$mirror->{status}}) {
		print OUT "$key: $mirror->{status}->{$key}\n";
	}
	print OUT "\n";
}
close OUT;
rename("$mirrorlist.status.new", "$mirrorlist.status")
	|| die "rename $mirrorlist.new to $mirrorlist: $!";