#!/usr/bin/perl
# Debian CD mirror checking script.
# Copyright 2002 by Joey Hess. Licensed under the GNU GPL.

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";
#my $isodir="$debver/images/$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";
#my $sourcedir="$debver/images/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);
# The directory jigdo files should be mirrored to.
#my $jigdodir="jigdo/$arch";
# The jigdo filename(s) to check for, and their expected sizes( in bytes).
#my %jigdofiles=("woody-$arch-1.jigdo" => 0, "woody-$arch-1.template" => 0);
# 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+(.*)/) {
			$site=$1;
		}
		if (/CDImage-http:\s+(.*)/) {
			$topdir=$1;
		}
		if (defined $topdir && defined $site) {
			push @ret, {site => $site, topdir => $topdir, retries => 0};
		}
	}
	close IN;
	return @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) {
			my $size=$ftp->size($file);
			if (defined $size && $size != $hash{$file}) {
				debug "file $file has size $size, rather than expected $hash{$file}";
				# It seems that some sites that have the
				# right files report wrongly with the size
				# command.
				return '?';
			}
		}
	}
	return 1;
}

$|=1;
print "login ok  dir exists  binary  source  site\n";
my @mirrors=get_mirror_info($mirrorlist);
while (@mirrors) {
	my $mirror=shift @mirrors;
	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);
			#$found_jigdo = check_files($ftp, $jigdodir, %jigdofiles);
			$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";
}