#!/usr/bin/perl -w # Generates a mirrors_.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 () { /^([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 () { 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 that push-primary come first, followed # by push-secondary. Normally that is followed by geodns, and then leaf. # However, if a country has no push-primary or secondary mirrors, its leaf # mirrors are put before geodns, since we do not want to default to a # geodns mirror that will likely not be in the country. my %cc_has_push_mirror; foreach my $id (0..$#data) { my $cc = $data[$id]->{country}; if (exists $data[$id]->{type} && $data[$id]->{type} =~ /push/i) { $cc_has_push_mirror{$cc}=1; } } foreach my $id (0..$#data) { my $cc = $data[$id]->{country}; my $rating=0; if (exists $data[$id]->{type}) { $rating=1 if $data[$id]->{type} =~ /geodns/i; $rating=4 if $data[$id]->{type} =~ /push/i; $rating=5 if $data[$id]->{type} =~ /push-primary/i; } if (! $rating && ! $cc_has_push_mirror{$cc}) { $rating=2; } $data[$id]->{rating}=$rating; } # 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) { my $cc; if (exists $data[$id]->{type} and $data[$id]->{type} =~ /geodns/i) { $cc='GB'; # location of Ubuntu master archive } else { $cc=$data[$id]->{country}; } next unless exists $data[$id]->{"archive-$type"} and defined $cc; 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; } 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; }