Rework mirror protocol selection to favour encrypted protocols

Previously, HTTP servers were preferred over everything, meaning that
HTTPS servers were never used. Now, HTTPS servers have an edge over
other protocols, but if another server is much closer geographically
than others, it will still be used.  If so, HTTP (and FTPS) will have an
edge over FTP and RSYNC.

1 files changed, 17 insertions, 3 deletions

diff --git a/urpm/mirrors.pm b/urpm/mirrors.pm
index 5feb3327..073946a9 100644
--- a/urpm/mirrors.pm
+++ b/urpm/mirrors.pm
@@ -275,10 +275,14 @@ sub add_proximity_and_sort {
 	$_->{proximity_corrected} = $_->{proximity} * _random_correction();
 	$_->{proximity_corrected} *= _between_country_correction($country_code, $_->{country}) if $best;
 	$_->{proximity_corrected} *= _between_continent_correction($best->{continent}, $_->{continent}) if $best;
+	$_->{proximity_corrected} *= _protocol_correction($_->{url});
     }
-    # prefer http mirrors by sorting them to the beginning
-    @$mirrors = sort { ($b->{url} =~ m!^http://!) <=> ($a->{url} =~ m!^http://!)
-		       || $a->{proximity_corrected} <=> $b->{proximity_corrected} } @$mirrors;
+
+    @$mirrors = sort { $a->{proximity_corrected} <=> $b->{proximity_corrected} } @$mirrors;
+
+    #foreach (@$mirrors) {
+    #	    print $_->{proximity_corrected} . " " . $_->{proximity}  . " " . $_->{url} . "\n";
+    #}
 }
 
 # add +/- 5% random
@@ -292,6 +296,7 @@ sub _between_country_correction {
     $here && $mirror or return 1;
     $here eq $mirror ? 0.5 : 1;
 }
+
 sub _between_continent_correction {
     my ($here, $mirror) = @_;
     $here && $mirror or return 1;
@@ -300,6 +305,15 @@ sub _between_continent_correction {
 	1;
 }
 
+sub _protocol_correction {
+    my ($url) = @_;
+    # favor encrypted protocols, then http
+    ( $url =~ m!https://! ) and return 0.7;
+    ( $url =~ m!ftps://! ) and return 0.8;
+    ( $url =~ m!http://! ) and return 0.9;
+    1;
+}
+
 sub _mirrors_raw {
     my ($urpm, $url) = @_;