#!/usr/bin/perl -w
# Generates a mirrors_<type>.h file, reading from Mirrors.masterlist.
# Note that there will be duplicate strings in the generated file.
# I am relying on the c compiler to fix this, which gcc does.
#
# Pass in the type of mirror we are interested in (http, https, or ftp), or
# use httplist, httpslist, or ftplist to generate a list of country codes
# for the mirror type.
use strict;

my $type = shift || die "please specify mirror type\n";
my $input = shift;
$input = 'Mirrors.masterlist' unless defined $input;

my $hostarch=$ENV{DEB_HOST_ARCH};
if (! defined $hostarch) {
	$hostarch=`dpkg-architecture -qDEB_HOST_ARCH`;
	chomp $hostarch;
}

my $iso3166tab = 'debian/iso_3166.tab';
my %iso3166;
open(ISO3166TAB, "< $iso3166tab") || die "Unable to read $iso3166tab";
while (<ISO3166TAB>) {
	/^([A-Z]+)\t(.*)$/ or next;
	$iso3166{$1} = $2;
}
close ISO3166TAB;

# Slurp in the mirror file.
my @data;
my %countries;
my $id=-1;	# incremented to 0 when first site is seen
open (IN, $input) or die "$input: $!";
while (<IN>) {
	chomp;
	if (m/([^:]*):\s+(.*)/) {
		my $key = lc $1;
		my $value = $2;
		if (lc $key eq 'site') {
			$id++;
			$data[$id]->{site} = $value;
		}
		elsif (lc $key eq 'country') {
			$value =~ s/ .*//;
			$value = uc $value;
			$data[$id]->{$key} = $value;
		}
		else {
			$data[$id]->{$key} = $value;
		}
	}
}
close IN;

# Look for entries in $input matching ${CC}, and expand them out to one
# entry for every country code in iso_3166.xml, with the following
# substitution variables:
#   ${CC}: lower-case country code
#   ${UCC}: upper-case country code
#   ${CNAME}: country name
# This is useful if you have a mirror hierarchy using wildcard DNS.
# Use a C-style for loop because we may modify $id in the middle of it.
for (my $id = 0; $id < @data; $id++) {
	if ($data[$id]->{site} =~ /\$\{CC}/) {
		my @expanded;
		foreach my $cc (sort keys %iso3166) {
			my %entry = %{$data[$id]};
			for my $field (keys %entry) {
				$entry{$field} =~ s/\$\{CC}/lc($cc)/eg;
				$entry{$field} =~ s/\$\{UCC}/uc($cc)/eg;
				$entry{$field} =~ s/\$\{CNAME}/$iso3166{$cc}/g;
			}
			push @expanded, \%entry;
		}
		splice @data, $id, 1, @expanded;
		$id += @expanded - 1;
	}
}

# Assign a rating to each mirror, so we get the ordering:
#   deb.debian.org
#   CC mirror, if any
#   others
#   any remaining mirrors tagged as geodns (as they're probably elsewhere)
foreach my $id (0..$#data) {
	my $rating=1;
	$rating=0 if exists $data[$id]->{type} && $data[$id]->{type} =~ /geodns/i;
	$rating=2 if $data[$id]->{site} =~ /^ftp.*\.debian\.org$/;
	$rating=3 if $data[$id]->{site} eq 'deb.debian.org';
	$data[$id]->{rating}=$rating;
}

# Defaults for released architectures
my $archive = 'archive';

# Is $hostarch a port architecture ?
# Such architectures appear in a Ports-architecture: field
foreach my $id (0..$#data) {
	if (exists $data[$id]->{'ports-architecture'}) {
		my @arches = split ' ', $data[$id]->{'ports-architecture'};
		my %arches = map { $_ => 1 } @arches;
		if (exists $arches{$hostarch} or exists $arches{'!'.$hostarch}) {
			$archive = 'ports';
			last;
		}
	}
}

# Filter out mirrors that don't carry the target architecture.
my @newdata;
foreach my $id (0..$#data) {
	if (exists $data[$id]->{"$archive-architecture"} &&
	    $data[$id]->{"$archive-architecture"} ne "any") {
		my @arches = split ' ', $data[$id]->{"$archive-architecture"};
		if (grep /^!/, @arches) {
			my %notarches = map { substr($_, 1) => 1 } grep /^!/, @arches;
			next if exists $notarches{$hostarch};
		} else {
			my %arches = map { $_ => 1 } @arches;
			next if not exists $arches{$hostarch};
		}
	}
	push @newdata, $data[$id];
}
@data = @newdata;

if ($type =~ /(.*)list/) {
	my $type=$1;
 	open (LIST, ">debian/${type}list-countries") or die "debian/${type}list-countries: $!";
	foreach my $id (0..$#data) {
		next unless exists $data[$id]->{"$archive-$type"} and
			exists $data[$id]->{country};
		my $cc = $data[$id]->{country};
		die "Error: country code '$cc' does not occur in iso-3166 table"
			unless exists $iso3166{$cc};
		$countries{$iso3166{$cc}} = $cc;
	}
	foreach my $country (sort (keys %countries)) {
		print LIST "$countries{$country}\t${country}\n";
	}
	close LIST;
}
elsif ($type eq "port_architecture") {
	open(OUT,"> debian/port_architecture") || die "Unable to write debian/port_architecture\n";
	if ($archive eq 'ports') {
		print OUT "1";
	} else {
		print OUT "0";
	}
	close OUT;
}
else {
	open (OUT, ">mirrors_$type.h") or die "mirrors_$type.h: $!";
	print OUT "/* Automatically generated; do not edit. */\n";

	# Now output the mirror list. It is ordered with better mirrors
	# near the top.
	print OUT "static struct mirror_t mirrors_$type\[] = {\n";
	my $q='"';
	foreach my $id (sort { $data[$b]->{rating} <=> $data[$a]->{rating} } 0..$#data) {
		my $cc;
		if (exists $data[$id]->{type} && $data[$id]->{type} =~/geodns/i) {
			$cc='NULL';
		}
		else {
			$cc=$q.$data[$id]->{country}.$q;
		}
		next unless exists $data[$id]->{"$archive-$type"} and defined $cc;
		if (! exists $data[$id]->{"$archive-architecture"}) {
			print STDERR "warning: missing $archive-architecture for mirror ".$data[$id]->{site}."; assuming it contains all architectures.\n";
		}
		print OUT "\t{",
			join(", ", $q.$data[$id]->{site}.$q, $cc,
				 $q.$data[$id]->{"$archive-$type"}.$q),
			"},\n";
	}
	print OUT "\t{NULL, NULL, NULL}\n";
	print OUT "};\n";

	close OUT;
}