simpler regexp which handles deprecate url removable_xxx://...

1 files changed, 92 insertions, 80 deletions

diff --git a/urpm.pm b/urpm.pm
index 1fa28377..8d45bb55 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -55,6 +55,17 @@ sub new {
     $self;
 }
 
+sub requested_ftp_http_downloader {
+    my ($urpm, $media_name) = @_;
+
+    $urpm->{options}{downloader} || #- cmd-line switch
+      $media_name && do {
+	  #- per-media config
+	  my ($m) = grep { $_->{name} eq $media_name } @{$urpm->{media}};
+	  $m && $m->{downloader};
+      } || $urpm->{global_config}{downloader};
+}
+
 #- $medium can be undef
 sub sync_webfetch {
     my ($urpm, $medium, $files, $std_options, %more_options) = @_;
@@ -78,6 +89,7 @@ sub sync_webfetch {
 #- syncing algorithms.
 sub _sync_webfetch_raw {    
     my ($urpm, $files, $options) = @_;
+
     my %files;
     #- currently ftp and http protocols are managed by curl or wget,
     #- ssh and rsync protocols are managed by rsync *AND* ssh.
@@ -86,48 +98,36 @@ sub _sync_webfetch_raw {
 	push @{$files{$1}}, $_;
     }
     if ($files{removable} || $files{file}) {
-	my @l = map { analyse_url__file_if_local($_) } @{$files{removable} || []}, @{$files{file} || []};
+	my @l = map { file_from_local_url($_) } @{$files{removable} || []}, @{$files{file} || []};
 	eval { sync_file($options, @l) };
 	$urpm->{fatal}(10, $@) if $@;
 	delete @files{qw(removable file)};
     }
     if ($files{ftp} || $files{http} || $files{https}) {
-	my @webfetch = qw(curl wget prozilla);
-	my %webfetch_executables = (curl => 'curl', wget => 'wget', prozilla => 'proz');
-	my %webfetch_funcs = (curl => \&sync_curl, wget => \&sync_wget, prozilla => \&sync_prozilla);
-	my @available_webfetch = grep {
-	    -x "/usr/bin/$webfetch_executables{$_}" || -x "/bin/$webfetch_executables{$_}";
-	} @webfetch;
+	my @available = urpm::download::available_ftp_http_downloaders();
+
 	#- use user default downloader if provided and available
-	my $option_downloader = $urpm->{options}{downloader}; #- cmd-line switch
-	if (!$option_downloader && $options->{media}) { #- per-media config
-	    (my $m) = grep { $_->{name} eq $options->{media} } @{$urpm->{media}};
-	    ref $m && defined $m->{downloader} and $option_downloader = $m->{downloader};
-	}
-	#- global config
-	!$option_downloader && exists $urpm->{global_config}{downloader}
-	    and $option_downloader = $urpm->{global_config}{downloader};
-	my ($preferred) = grep { $_ eq $option_downloader } @available_webfetch;
-	#- else first downloader of @webfetch is the default one
-	$preferred ||= $available_webfetch[0];
-	if ($option_downloader ne $preferred && $option_downloader && !our $webfetch_not_available) {
-	    $urpm->{log}(N("%s is not available, falling back on %s", $option_downloader, $preferred));
-	    $webfetch_not_available = 1;
-	}
-	my $sync = $webfetch_funcs{$preferred} or die N("no webfetch found, supported webfetch are: %s\n", join(", ", @webfetch));
+	my $requested_downloader = requested_ftp_http_downloader($urpm, $options->{media});
+	my ($preferred) = grep { $_ eq $requested_downloader } @available;
+	if (!$preferred) {
+	    #- else first downloader of @available is the default one
+	    $preferred = $available[0];
+	    if ($requested_downloader && !our $webfetch_not_available) {
+		$urpm->{log}(N("%s is not available, falling back on %s", $requested_downloader, $preferred));
+		$webfetch_not_available = 1;
+	    }
+	}
+	my $sync = $urpm::download::{"sync_$preferred"} or die N("no webfetch found, supported webfetch are: %s\n", join(", ", urpm::download::ftp_http_downloaders()));
 	$sync->($options, @{$files{ftp} || []}, @{$files{http} || []}, @{$files{https} || []});
 
 	delete @files{qw(ftp http https)};
     }
     if ($files{rsync}) {
-	sync_rsync($options, @{$files{rsync} || []});
+	sync_rsync($options, @{$files{rsync}});
 	delete $files{rsync};
     }
     if ($files{ssh}) {
-	my @ssh_files;
-	foreach (@{$files{ssh} || []}) {
-	    m|^ssh://([^/]*)(.*)| and push @ssh_files, "$1:$2";
-	}
+	my @ssh_files = map { m!^ssh://([^/]*)(.*)! ? "$1:$2" : () } @{$files{ssh}};
 	sync_ssh($options, @ssh_files);
 	delete $files{ssh};
     }
@@ -357,10 +357,14 @@ sub is_iso {
     $removable_dev && $removable_dev =~ /\.iso$/i;
 }
 
-sub analyse_url__file_if_local {
+sub file_from_local_url {
     my ($url) = @_;
     $url =~ m!^(?:removable[^:]*:/|file:/)?(/.*)! && $1;
 }
+sub file_from_file_url {
+    my ($url) = @_;
+    $url =~ m!^(?:file:/)?(/.*)! && $1;
+}
 
 #- probe device associated with a removable device.
 sub probe_removable_device {
@@ -377,7 +381,7 @@ sub probe_removable_device {
     }
 
     #- try to find device to open/close for removable medium.
-    if (my $dir = analyse_url__file_if_local($medium->{url})) {
+    if (my $dir = file_from_local_url($medium->{url})) {
 	my %infos;
 	my @mntpoints = urpm::sys::find_mntpoints($dir, \%infos);
 	if (@mntpoints > 1) {	#- return value is suitable for an hash.
@@ -575,7 +579,7 @@ sub configure {
 		    our $currentmedia = $_; #- hack for urpmf
 		    delete @$_{qw(start end)};
 		    if ($_->{virtual}) {
-			my $path = $_->{url} =~ m!^(?:file:/*)?(/[^/].*[^/])/*\Z! && $1;
+			my $path = file_from_file_url($_->{url});
 			if ($path) {
 			    if ($_->{synthesis}) {
 				_parse_synthesis($urpm, $_,
@@ -713,7 +717,7 @@ sub add_medium {
     #- creating the medium info.
     $medium = { name => $name, url => $url, update => $options{update}, modified => 1, ignore => $options{ignore} };
     if ($options{virtual}) {
-	$url =~ m!^(?:file:)?/! or $urpm->{fatal}(1, N("virtual medium needs to be local"));
+	file_from_file_url($url) or $urpm->{fatal}(1, N("virtual medium needs to be local"));
 	$medium->{virtual} = 1;
     } else {
 	$medium->{hdlist} = "hdlist.$name.cz";
@@ -722,7 +726,7 @@ sub add_medium {
     }
 
     #- local media have priority, other are added at the end.
-    if ($url =~ m!^(?:file:)?/!) {
+    if (file_from_file_url($url)) {
 	$medium->{priority} = 0.5;
     } else {
 	$medium->{priority} = 1 + @{$urpm->{media}};
@@ -776,7 +780,7 @@ sub add_distrib_media {
 
     my $distribconf;
 
-    if (my $dir = analyse_url__file_if_local($url)) {
+    if (my $dir = file_from_local_url($url)) {
 	$urpm->try_mounting($dir)
 	    or $urpm->{error}(N("unable to mount the distribution medium")), return ();
 	$distribconf = MDV::Distribconf->new($dir, undef);
@@ -950,48 +954,62 @@ sub _probe_with_try_list {
 
 #- read a reconfiguration file for urpmi, and reconfigure media accordingly
 #- $rfile is the reconfiguration file (local), $name is the media name
+#-
+#- the format is similar to the RewriteRule of mod_rewrite, so:
+#-    PATTERN REPLACEMENT [FLAG]
+#- where FLAG can be L or N
+#-
+#- example of reconfig.urpmi:
+#-    # this is an urpmi reconfiguration file
+#-    /cooker /cooker/$ARCH
 sub reconfig_urpmi {
     my ($urpm, $rfile, $name) = @_;
-    my @replacements;
-    my @reconfigurable = qw(url with_hdlist clear_url);
-    my $reconfigured = 0;
-    my $fh = $urpm->open_safe("<", $rfile) or return undef;
+    -r $rfile or return;
+
     $urpm->{log}(N("reconfiguring urpmi for media \"%s\"", $name));
+
+    my ($magic, @lines) = cat_($rfile);
     #- the first line of reconfig.urpmi must be magic, to be sure it's not an error file
-    my $magic = <$fh>;
     $magic =~ /^# this is an urpmi reconfiguration file/ or return undef;
-    local $_;
-    while (<$fh>) {
+
+    my @replacements;
+    foreach (@lines) {
 	chomp;
 	s/^\s*//; s/#.*$//; s/\s*$//;
 	$_ or next;
 	my ($p, $r, $f) = split /\s+/, $_, 3;
-	$f ||= 1;
-	push @replacements, [ quotemeta $p, $r, $f ];
-    }
-  MEDIA:
-    foreach my $medium (grep { $_->{name} eq $name } @{$urpm->{media}}) {
-        my %orig = map { $_ => $medium->{$_} } @reconfigurable;
-      URLS:
-	foreach my $k (@reconfigurable) {
-	    foreach my $r (@replacements) {
-		if ($medium->{$k} =~ s/$r->[0]/$r->[1]/) {
-		    $reconfigured = 1;
-		    #- Flags stolen from mod_rewrite: L(ast), N(ext)
-		    last if $r->[2] =~ /L/;
-		    redo URLS if $r->[2] =~ /N/;
+	push @replacements, [ quotemeta $p, $r, $f || 1 ];
+    }
+
+    my $reconfigured = 0;
+    my @reconfigurable = qw(url with_hdlist clear_url);
+
+    my ($medium) = grep { $_->{name} eq $name } @{$urpm->{media}} or return;
+    my %orig = %$medium;
+
+  URLS:
+    foreach my $k (@reconfigurable) {
+	foreach my $r (@replacements) {
+	    if ($medium->{$k} =~ s/$r->[0]/$r->[1]/) {
+		$reconfigured = 1;
+		#- Flags stolen from mod_rewrite: L(ast), N(ext)
+		if ($r->[2] =~ /L/) {
+		    last;
+		} elsif ($r->[2] =~ /N/) { #- dangerous option
+		    redo URLS;
 		}
 	    }
-	    #- check that the new url exists before committing changes (local mirrors)
-	    if ($medium->{$k} =~ m!^(?:file:/*)?(/[^/].*[^/])/*\Z! && !-e $1) {
-		$medium->{$k} = $orig{$k} foreach @reconfigurable;
-		$reconfigured = 0;
-		$urpm->{log}(N("...reconfiguration failed"));
-		last MEDIA;
-	    }
+	}
+	#- check that the new url exists before committing changes (local mirrors)
+	my $file = file_from_local_url($medium->{$k});
+	if ($file && !-e $file) {
+	    %$medium = %orig;
+	    $reconfigured = 0;
+	    $urpm->{log}(N("...reconfiguration failed"));
+	    return;
 	}
     }
-    close $fh;
+
     if ($reconfigured) {
 	$urpm->{log}(N("reconfiguration done"));
 	$urpm->write_config;
@@ -1015,8 +1033,7 @@ sub _update_media__when_not_modified {
 
     delete @$medium{qw(start end)};
     if ($medium->{virtual}) {
-	my ($path) = $medium->{url} =~ m!^(?:file:)?/*(/[^/].*[^/])/*\Z!;
-	if ($path) {
+	if (my $path = file_from_file_url($medium->{url})) {
 	    my $with_hdlist_file = "$path/$medium->{with_hdlist}";
 	    if ($medium->{synthesis}) {
 		_parse_synthesis($urpm, $medium, $with_hdlist_file);
@@ -1214,7 +1231,7 @@ sub _update_medium_first_pass {
       or $medium->{modified_synthesis} = 1;
 
     #- if we're rebuilding all media, mark them as modified (except removable ones)
-    $medium->{modified} ||= $options{all} && $medium->{url} !~ m!^removable://!;
+    $medium->{modified} ||= $options{all} && $medium->{url} !~ m!^removable!;
     #- don't ever update static media
     $medium->{static} and $medium->{modified} = 0;
 
@@ -1830,9 +1847,8 @@ sub _update_medium_second_pass {
     } elsif ($medium->{synthesis}) {
 	if ($second_pass) {
 	    if ($medium->{virtual}) {
-		my ($path) = $medium->{url} =~ m!^(?:file:/*)?(/[^/].*[^/])/*\Z!;
-		my $with_hdlist_file = "$path/$medium->{with_hdlist}";
-		if ($path) {
+		if (my $path = file_from_file_url($medium->{url})) {
+		    my $with_hdlist_file = "$path/$medium->{with_hdlist}";
 		    _parse_synthesis($urpm, $medium, $with_hdlist_file);
 		}
 	    } else {
@@ -2412,7 +2428,7 @@ sub get_source_packages {
 	    #- always prefer a list file if available.
 	    my $listfile = $medium->{list} ? "$urpm->{statedir}/$medium->{list}" : '';
 	    if (!$listfile && $medium->{virtual}) {
-		my $dir = analyse_url__file_if_local($medium->{url});
+		my $dir = file_from_local_url($medium->{url});
 		my $with_hdlist_dir = reduce_pathname($dir . ($medium->{with_hdlist} ? "/$medium->{with_hdlist}" : "/.."));
 		my $local_list = 'list' . _hdlist_suffix($medium);
 		$listfile = reduce_pathname("$with_hdlist_dir/../$local_list");
@@ -2600,7 +2616,7 @@ sub copy_packages_of_removable_media {
 	}
 	foreach (values %{$list->[$id]}) {
 	    chomp;
-	    my $dir_ = analyse_url__file_if_local($_) or next;
+	    my $dir_ = file_from_local_url($_) or next;
 	    $dir_ =~ m!/.*/! or next; #- is this really needed??
 	    unless ($dir) {
 		$dir = $dir_;
@@ -2615,7 +2631,7 @@ sub copy_packages_of_removable_media {
     my $examine_removable_medium = sub {
 	my ($id, $device) = @_;
 	my $medium = $urpm->{media}[$id];
-	if (my $dir = analyse_url__file_if_local($medium->{url})) {
+	if (my $dir = file_from_local_url($medium->{url})) {
 	    #- the directory given does not exist and may be accessible
 	    #- by mounting some other directory. Try to figure it out and mount
 	    #- everything that might be necessary.
@@ -2632,7 +2648,7 @@ sub copy_packages_of_removable_media {
 		while (my ($i, $url) = each %{$list->[$id]}) {
 		    chomp $url;
 		    my ($filepath, $filename) = do {
-			my $f = analyse_url__file_if_local($url) or next;
+			my $f = file_from_local_url($url) or next;
 			$f =~ m!/.*/! or next; #- is this really needed??
 			dirname($f), basename($f);
 		    };
@@ -2670,7 +2686,7 @@ sub copy_packages_of_removable_media {
 	#- examine non removable device but that may be mounted.
 	if ($medium->{removable}) {
 	    push @{$removables{$medium->{removable}} ||= []}, $_;
-	} elsif (my $dir = analyse_url__file_if_local($medium->{url})) {
+	} elsif (my $dir = file_from_local_url($medium->{url})) {
 	    -e $dir || $urpm->try_mounting($dir) or
 	      $urpm->{error}(N("unable to access medium \"%s\"", $medium->{name})), next;
 	}
@@ -2719,7 +2735,7 @@ sub download_packages_of_distant_media {
 	while (my ($i, $url) = each %{$list->[$n]}) {
 	    #- the given URL is trusted, so the file can safely be ignored.
 	    defined $sources->{$i} and next;
-	    my $local_file = analyse_url__file_if_local($url);
+	    my $local_file = file_from_local_url($url);
 	    if ($local_file && $local_file =~ /\.rpm$/) {
 		if (-r $local_file) {
 		    $sources->{$i} = $local_file;
@@ -3284,11 +3300,7 @@ sub check_sources_signatures {
 
 sub dump_description_file {
     my ($urpm, $media_name) = @_;
-    open my $fh, '<', "$urpm->{statedir}/descriptions.$media_name"
-	or return ();
-    my @slurp = <$fh>;
-    close $fh;
-    return @slurp;
+    cat_("$urpm->{statedir}/descriptions.$media_name");
 }
 
 #- get reason of update for packages to be updated