You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 

171 lines
5.1 KiB

  1. #!/usr/bin/perl -w
  2. # Generates a mirrors_<type>.h file, reading from Mirrors.masterlist.
  3. # Note that there will be duplicate strings in the generated file.
  4. # I am relying on the c compiler to fix this, which gcc does.
  5. #
  6. # Pass in the type of mirror we are interested in (http, https, or ftp), or
  7. # use httplist, httpslist, or ftplist to generate a list of country codes
  8. # for the mirror type.
  9. use strict;
  10. my $type = shift || die "please specify mirror type\n";
  11. my $input = shift;
  12. $input = 'Mirrors.masterlist' unless defined $input;
  13. my $hostarch=$ENV{DEB_HOST_ARCH};
  14. if (! defined $hostarch) {
  15. $hostarch=`dpkg-architecture -qDEB_HOST_ARCH`;
  16. chomp $hostarch;
  17. }
  18. my $iso3166tab = 'debian/iso_3166.tab';
  19. my %iso3166;
  20. open(ISO3166TAB, "< $iso3166tab") || die "Unable to read $iso3166tab";
  21. while (<ISO3166TAB>) {
  22. /^([A-Z]+)\t(.*)$/ or next;
  23. $iso3166{$1} = $2;
  24. }
  25. close ISO3166TAB;
  26. # Slurp in the mirror file.
  27. my @data;
  28. my %countries;
  29. my $id=-1; # incremented to 0 when first site is seen
  30. open (IN, $input) or die "$input: $!";
  31. while (<IN>) {
  32. chomp;
  33. if (m/([^:]*):\s+(.*)/) {
  34. my $key = lc $1;
  35. my $value = $2;
  36. if (lc $key eq 'site') {
  37. $id++;
  38. $data[$id]->{site} = $value;
  39. }
  40. elsif (lc $key eq 'country') {
  41. $value =~ s/ .*//;
  42. $value = uc $value;
  43. $data[$id]->{$key} = $value;
  44. }
  45. else {
  46. $data[$id]->{$key} = $value;
  47. }
  48. }
  49. }
  50. close IN;
  51. # Look for entries in $input matching ${CC}, and expand them out to one
  52. # entry for every country code in iso_3166.xml, with the following
  53. # substitution variables:
  54. # ${CC}: lower-case country code
  55. # ${UCC}: upper-case country code
  56. # ${CNAME}: country name
  57. # This is useful if you have a mirror hierarchy using wildcard DNS.
  58. # Use a C-style for loop because we may modify $id in the middle of it.
  59. for (my $id = 0; $id < @data; $id++) {
  60. if ($data[$id]->{site} =~ /\$\{CC}/) {
  61. my @expanded;
  62. foreach my $cc (sort keys %iso3166) {
  63. my %entry = %{$data[$id]};
  64. for my $field (keys %entry) {
  65. $entry{$field} =~ s/\$\{CC}/lc($cc)/eg;
  66. $entry{$field} =~ s/\$\{UCC}/uc($cc)/eg;
  67. $entry{$field} =~ s/\$\{CNAME}/$iso3166{$cc}/g;
  68. }
  69. push @expanded, \%entry;
  70. }
  71. splice @data, $id, 1, @expanded;
  72. $id += @expanded - 1;
  73. }
  74. }
  75. # Assign a rating to each mirror, so that push-primary come first, followed
  76. # by push-secondary. Normally that is followed by geodns, and then leaf.
  77. # However, if a country has no push-primary or secondary mirrors, its leaf
  78. # mirrors are put before geodns, since we do not want to default to a
  79. # geodns mirror that will likely not be in the country.
  80. my %cc_has_push_mirror;
  81. foreach my $id (0..$#data) {
  82. my $cc = $data[$id]->{country};
  83. if (exists $data[$id]->{type} && $data[$id]->{type} =~ /push/i) {
  84. $cc_has_push_mirror{$cc}=1;
  85. }
  86. }
  87. foreach my $id (0..$#data) {
  88. my $cc = $data[$id]->{country};
  89. my $rating=0;
  90. if (exists $data[$id]->{type}) {
  91. $rating=1 if $data[$id]->{type} =~ /geodns/i;
  92. $rating=4 if $data[$id]->{type} =~ /push/i;
  93. $rating=5 if $data[$id]->{type} =~ /push-primary/i;
  94. }
  95. if (! $rating && ! $cc_has_push_mirror{$cc}) {
  96. $rating=2;
  97. }
  98. $data[$id]->{rating}=$rating;
  99. }
  100. # Filter out mirrors that don't carry the target architecture.
  101. my @newdata;
  102. foreach my $id (0..$#data) {
  103. if (exists $data[$id]->{'archive-architecture'} &&
  104. $data[$id]->{'archive-architecture'} ne "any") {
  105. my @arches = split ' ', $data[$id]->{'archive-architecture'};
  106. if (grep /^!/, @arches) {
  107. my %notarches = map { substr($_, 1) => 1 } grep /^!/, @arches;
  108. next if exists $notarches{$hostarch};
  109. } else {
  110. my %arches = map { $_ => 1 } @arches;
  111. next if not exists $arches{$hostarch};
  112. }
  113. }
  114. push @newdata, $data[$id];
  115. }
  116. @data = @newdata;
  117. if ($type =~ /(.*)list/) {
  118. my $type=$1;
  119. open (LIST, ">debian/${type}list-countries") or die "debian/${type}list-countries: $!";
  120. foreach my $id (0..$#data) {
  121. next unless exists $data[$id]->{"archive-$type"} and
  122. exists $data[$id]->{country};
  123. my $cc = $data[$id]->{country};
  124. die "Error: country code '$cc' does not occur in iso-3166 table"
  125. unless exists $iso3166{$cc};
  126. $countries{$iso3166{$cc}} = $cc;
  127. }
  128. foreach my $country (sort (keys %countries)) {
  129. print LIST "$countries{$country}\t${country}\n";
  130. }
  131. close LIST;
  132. }
  133. else {
  134. open (OUT, ">mirrors_$type.h") or die "mirrors_$type.h: $!";
  135. print OUT "/* Automatically generated; do not edit. */\n";
  136. # Now output the mirror list. It is ordered with better mirrors
  137. # near the top.
  138. print OUT "static struct mirror_t mirrors_$type\[] = {\n";
  139. my $q='"';
  140. foreach my $id (sort { $data[$b]->{rating} <=> $data[$a]->{rating} } 0..$#data) {
  141. my $cc;
  142. if (exists $data[$id]->{type} && $data[$id]->{type} =~/geodns/i) {
  143. $cc='NULL';
  144. }
  145. else {
  146. $cc=$q.$data[$id]->{country}.$q;
  147. }
  148. next unless exists $data[$id]->{"archive-$type"} and defined $cc;
  149. if (! exists $data[$id]->{'archive-architecture'}) {
  150. print STDERR "warning: missing archive-architecture for mirror ".$data[$id]->{site}."; assuming it contains all architectures.\n";
  151. }
  152. print OUT "\t{",
  153. join(", ", $q.$data[$id]->{site}.$q, $cc,
  154. $q.$data[$id]->{"archive-$type"}.$q),
  155. "},\n";
  156. }
  157. print OUT "\t{NULL, NULL, NULL}\n";
  158. print OUT "};\n";
  159. close OUT;
  160. }