diff options
Diffstat (limited to 'urpm.pm')
| -rw-r--r-- | urpm.pm | 348 |
1 files changed, 1 insertions, 347 deletions
@@ -6,6 +6,7 @@ use strict; use vars qw($VERSION @ISA @EXPORT); use MDK::Common; use urpm::msg; +use urpm::download; $VERSION = '4.4'; @ISA = qw(URPM); @@ -14,9 +15,6 @@ use URPM; use URPM::Resolve; use POSIX; -#- tool functions. -sub localtime2changelog { scalar(localtime($_[0])) =~ /(.*) \S+ (\d{4})$/ && "$1 $2" }; - #- create a new urpm object. sub new { my ($class) = @_; @@ -46,59 +44,6 @@ sub new { }, $class; } -sub get_proxy { - my $proxy = { - http_proxy => undef , - ftp_proxy => undef , - user => undef, - pwd => undef - }; - local (*F, $_); - open F, "/etc/urpmi/proxy.cfg" or return undef; - while (<F>) { - chomp; s/#.*$//; s/^\s*//; s/\s*$//; - /^http_proxy\s*=\s*(.*)$/ and $proxy->{http_proxy} = $1, next; - /^ftp_proxy\s*=\s*(.*)$/ and $proxy->{ftp_proxy} = $1, next; - /^proxy_user\s*=\s*(.*):(.*)$/ and do { - $proxy->{user} = $1; - $proxy->{pwd} = $2; - next; - }; - next; - } - close F; - $proxy; -} - -sub set_proxy { - my $proxy = shift @_; - my @res; - if (defined $proxy->{proxy}{http_proxy} or defined $proxy->{proxy}{ftp_proxy}) { - for ($proxy->{type}) { - /wget/ && do { - for ($proxy->{proxy}) { - if (defined $_->{http_proxy}) { - $ENV{http_proxy} = $_->{http_proxy} =~ /^http:/ ? $_->{http_proxy} : "http://$_->{http_proxy}"; - } - $ENV{ftp_proxy} = $_->{ftp_proxy} if defined $_->{ftp_proxy}; - @res = ("--proxy-user=$_->{user}", "--proxy-passwd=$_->{pwd}") if defined $_->{user} && defined $_->{pwd}; - } - last; - }; - /curl/ && do { - for ($proxy->{proxy}) { - push @res, ('-x', $_->{http_proxy}) if defined $_->{http_proxy}; - push @res, ('-x', $_->{ftp_proxy}) if defined $_->{ftp_proxy}; - push @res, ('-U', "$_->{user}:$_->{pwd}") if defined $_->{user} && defined $_->{pwd}; - } - last; - }; - die N("Unknown webfetch `%s' !!!\n", $proxy->{type}); - } - } - return @res; -} - #- quoting/unquoting a string that may be containing space chars. sub quotespace { local $_ = $_[0] || ''; s/(\s)/\\$1/g; $_ } sub unquotespace { local $_ = $_[0] || ''; s/\\(\s)/$1/g; $_ } @@ -154,297 +99,6 @@ sub sync_webfetch { } %files and die N("unable to handle protocol: %s", join ', ', keys %files); } -sub propagate_sync_callback { - my $options = shift @_; - if (ref($options) && $options->{callback}) { - my $mode = shift @_; - if ($mode =~ /^(start|progress|end)$/) { - my $file = shift @_; - $file =~ s|([^:]*://[^/:\@]*:)[^/:\@]*(\@.*)|$1xxxx$2|; #- if needed... - return $options->{callback}($mode, $file, @_); - } else { - return $options->{callback}($mode, @_); - } - } -} -sub sync_file { - my $options = shift @_; - foreach (@_) { - my ($in) = m!^(?:removable[^:]*|file):/(.*)!; - propagate_sync_callback($options, 'start', $_); - system("cp", "-p", "-R", $in || $_, ref($options) ? $options->{dir} : $options) and - die N("copy failed: %s", $@); - propagate_sync_callback($options, 'end', $_); - } -} -sub sync_wget { - -x "/usr/bin/wget" or die N("wget is missing\n"); - local *WGET; - my $options = shift @_; - #- force download to be done in cachedir to avoid polluting cwd. - my $cwd = `pwd`; chomp $cwd; - chdir(ref($options) ? $options->{dir} : $options); - my ($buf, $total, $file) = ('', undef, undef); - my $wget_pid = open WGET, join(" ", map { "'$_'" } "/usr/bin/wget", - (ref($options) && $options->{limit_rate} ? "--limit-rate=$options->{limit_rate}" : ()), - (ref($options) && $options->{resume} ? "--continue" : ()), - (ref($options) && $options->{proxy} ? set_proxy({ type => "wget", proxy => $options->{proxy} }) : ()), - (ref($options) && $options->{callback} ? ("--progress=bar:force", "-o", "-") : - ref($options) && $options->{quiet} ? "-q" : @{[]}), - "--retr-symlinks", "-NP", - (ref($options) ? $options->{dir} : $options), @_) . " |"; - local $/ = \1; #- read input by only one char, this is slow but very nice (and it works!). - while (<WGET>) { - $buf .= $_; - if ($_ eq "\r" || $_ eq "\n") { - if (ref($options) && $options->{callback}) { - if ($buf =~ /^--\d\d:\d\d:\d\d--\s+(\S.*)\n/ms) { - $file && $file ne $1 and propagate_sync_callback($options, 'end', $file); - ! defined $file and propagate_sync_callback($options, 'start', $file = $1); - } elsif (defined $file && ! defined $total && $buf =~ /==>\s+RETR/) { - $total = ''; - } elsif (defined $total && $total eq '' && $buf =~ /^[^:]*:\s+(\d\S*)/) { - $total = $1; - } elsif (my ($percent, $speed, $eta) = $buf =~ /^\s*(\d+)%.*\s+(\S+)\s+ETA\s+(\S+)\s*[\r\n]$/ms) { - if (propagate_sync_callback($options, 'progress', $file, $percent, $total, $eta, $speed) eq 'canceled') { - kill 15, $wget_pid; - close WGET; - return; - } - if ($_ eq "\n") { - propagate_sync_callback($options, 'end', $file); - ($total, $file) = (undef, undef); - } - } - } else { - ref($options) && $options->{quiet} or print STDERR $buf; - } - $buf = ''; - } - } - $file and propagate_sync_callback($options, 'end', $file); - chdir $cwd; - close WGET or die N("wget failed: exited with %d or signal %d\n", $? >> 8, $? & 127); -} -sub sync_curl { - -x "/usr/bin/curl" or die N("curl is missing\n"); - local *CURL; - my $options = shift @_; - #- force download to be done in cachedir to avoid polluting cwd, - #- howerver for curl, this is mandatory. - my $cwd = `pwd`; chomp $cwd; - chdir(ref($options) ? $options->{dir} : $options); - my (@ftp_files, @other_files); - foreach (@_) { - m|^ftp://.*/([^/]*)$| && -s $1 > 8192 and do { push @ftp_files, $_; next }; #- manage time stamp for large file only. - push @other_files, $_; - } - if (@ftp_files) { - my ($cur_ftp_file, %ftp_files_info); - - eval { require Date::Manip }; - - #- prepare to get back size and time stamp of each file. - open CURL, join(" ", map { "'$_'" } "/usr/bin/curl", - (ref($options) && $options->{limit_rate} ? ("--limit-rate", $options->{limit_rate}) : ()), - (ref($options) && $options->{proxy} ? set_proxy({ type => "curl", proxy => $options->{proxy} }) : ()), - "--stderr", "-", "-s", "-I", @ftp_files) . " |"; - while (<CURL>) { - if (/Content-Length:\s*(\d+)/) { - !$cur_ftp_file || exists($ftp_files_info{$cur_ftp_file}{size}) and $cur_ftp_file = shift @ftp_files; - $ftp_files_info{$cur_ftp_file}{size} = $1; - } - if (/Last-Modified:\s*(.*)/) { - !$cur_ftp_file || exists($ftp_files_info{$cur_ftp_file}{time}) and $cur_ftp_file = shift @ftp_files; - eval { - $ftp_files_info{$cur_ftp_file}{time} = Date::Manip::ParseDate($1); - $ftp_files_info{$cur_ftp_file}{time} =~ s/(\d{6}).{4}(.*)/$1$2/; #- remove day and hour. - }; - } - } - close CURL; - - #- now analyse size and time stamp according to what already exists here. - if (@ftp_files) { - #- re-insert back shifted element of ftp_files, because curl output above - #- have not been parsed correctly, in doubt download them all. - push @ftp_files, keys %ftp_files_info; - } else { - #- for that, it should be clear ftp_files is empty... else a above work is - #- use less. - foreach (keys %ftp_files_info) { - my ($lfile) = m|/([^/]*)$| or next; #- strange if we can't parse it correctly. - my $ltime = eval { Date::Manip::ParseDate(scalar gmtime((stat $1)[9])) }; - $ltime =~ s/(\d{6}).{4}(.*)/$1$2/; #- remove day and hour. - -s $lfile == $ftp_files_info{$_}{size} && $ftp_files_info{$_}{time} eq $ltime or - push @ftp_files, $_; - } - } - } - #- http files (and other files) are correctly managed by curl to conditionnal download. - #- options for ftp files, -R (-O <file>)* - #- options for http files, -R (-z file -O <file>)* - if (my @all_files = ((map { ("-O", $_) } @ftp_files), (map { m|/([^/]*)$| ? ("-z", $1, "-O", $_) : @{[]} } @other_files))) { - my @l = (@ftp_files, @other_files); - my ($buf, $file) = ('', undef); - my $curl_pid = open CURL, join(" ", map { "'$_'" } "/usr/bin/curl", - (ref($options) && $options->{limit_rate} ? ("--limit-rate", $options->{limit_rate}) : ()), - (ref($options) && $options->{resume} ? ("--continue-at", "-") : ()), - (ref($options) && $options->{proxy} ? set_proxy({ type => "curl", proxy => $options->{proxy} }) : ()), - (ref($options) && $options->{quiet} && !$options->{verbose} ? "-s" : @{[]}), - "-k", `curl -h` =~ /location-trusted/ ? "--location-trusted" : @{[]}, - "-R", "-f", "--stderr", "-", - @all_files) . " |"; - local $/ = \1; #- read input by only one char, this is slow but very nice (and it works!). - while (<CURL>) { - $buf .= $_; - if ($_ eq "\r" || $_ eq "\n") { - if (ref($options) && $options->{callback}) { - unless (defined $file) { - $file = shift @l; - propagate_sync_callback($options, 'start', $file); - } - if (my ($percent, $total, $eta, $speed) = $buf =~ /^\s*(\d+)\s+(\S+)[^\r\n]*\s+(\S+)\s+(\S+)[\r\n]$/ms) { - if (propagate_sync_callback($options, 'progress', $file, $percent, $total, $eta, $speed) eq 'canceled') { - kill 15, $curl_pid; - close CURL; - return; - } - if ($_ eq "\n") { - propagate_sync_callback($options, 'end', $file); - $file = undef; - } - } elsif ($buf =~ /^curl:/) { #- likely to be an error reported by curl - local $/ = "\n"; - chomp $buf; - propagate_sync_callback($options, 'error', $file, $buf); - } - } else { - ref($options) && $options->{quiet} or print STDERR $buf; - } - $buf = ''; - } - } - chdir $cwd; - close CURL or die N("curl failed: exited with %d or signal %d\n", $? >> 8, $? & 127); - } else { - chdir $cwd; - } -} -sub sync_rsync { - -x "/usr/bin/rsync" or die N("rsync is missing\n"); - my $options = shift @_; - #- force download to be done in cachedir to avoid polluting cwd. - my $cwd = `pwd`; chomp $cwd; - chdir(ref($options) ? $options->{dir} : $options); - my $limit_rate = ref($options) && $options->{limit_rate}; - for ($limit_rate) { - /^(\d+)$/ and $limit_rate = int $1/1024; - /^(\d+)[kK]$/ and $limit_rate = $1; - /^(\d+)[mM]$/ and $limit_rate = 1024*$1; - /^(\d+)[gG]$/ and $limit_rate = 1024*1024*$1; - } - foreach (@_) { - my $count = 10; #- retry count on error (if file exists). - my $basename = basename($_); - my ($file) = m|^rsync://(.*)| or next; $file =~ /::/ or $file = $_; - propagate_sync_callback($options, 'start', $file); - do { - local (*RSYNC, $_); - my $buf = ''; - open RSYNC, join(" ", map { "'$_'" } "/usr/bin/rsync", - ($limit_rate ? "--bwlimit=$limit_rate" : ()), - (ref($options) && $options->{quiet} ? qw(-q) : qw(--progress -v)), - if_(ref($options) && $options->{compress}, qw(-z)), - qw(--partial --no-whole-file), $file, (ref($options) ? $options->{dir} : $options)) . " |"; - local $/ = \1; #- read input by only one char, this is slow but very nice (and it works!). - while (<RSYNC>) { - $buf .= $_; - if ($_ eq "\r" || $_ eq "\n") { - if (ref($options) && $options->{callback}) { - if (my ($percent, $speed) = $buf =~ /^\s*\d+\s+(\d+)%\s+(\S+)\s+/) { - propagate_sync_callback($options, 'progress', $file, $percent, undef, undef, $speed); - } - } else { - ref($options) && $options->{quiet} or print STDERR $buf; - } - $buf = ''; - } - } - close RSYNC; - } while ($? != 0 && --$count > 0 && -e (ref($options) ? $options->{dir} : $options) . "/$basename"); - propagate_sync_callback($options, 'end', $file); - } - chdir $cwd; - $? == 0 or die N("rsync failed: exited with %d or signal %d\n", $? >> 8, $? & 127); -} -sub sync_ssh { - -x "/usr/bin/rsync" or die N("rsync is missing\n"); - -x "/usr/bin/ssh" or die N("ssh is missing\n"); - my $options = shift @_; - #- force download to be done in cachedir to avoid polluting cwd. - my $cwd = `pwd`; chomp $cwd; - chdir(ref($options) ? $options->{dir} : $options); - my $limit_rate = ref($options) && $options->{limit_rate}; - for ($limit_rate) { - /^(\d+)$/ and $limit_rate = int $1/1024; - /^(\d+)[kK]$/ and $limit_rate = $1; - /^(\d+)[mM]$/ and $limit_rate = 1024*$1; - /^(\d+)[gG]$/ and $limit_rate = 1024*1024*$1; - } - foreach my $file (@_) { - my $count = 10; #- retry count on error (if file exists). - my $basename = basename($file); - propagate_sync_callback($options, 'start', $file); - do { - local (*RSYNC, $_); - my $buf = ''; - open RSYNC, join(" ", map { "'$_'" } "/usr/bin/rsync", - ($limit_rate ? "--bwlimit=$limit_rate" : ()), - (ref($options) && $options->{quiet} ? qw(-q) : qw(--progress -v)), - if_(ref($options) && $options->{compress}, qw(-z)), - qw(--partial -e ssh), $file, (ref($options) ? $options->{dir} : $options)) . " |"; - local $/ = \1; #- read input by only one char, this is slow but very nice (and it works!). - while (<RSYNC>) { - $buf .= $_; - if ($_ eq "\r" || $_ eq "\n") { - if (ref($options) && $options->{callback}) { - if (my ($percent, $speed) = $buf =~ /^\s*\d+\s+(\d+)%\s+(\S+)\s+/) { - propagate_sync_callback($options, 'progress', $file, $percent, undef, undef, $speed); - } - } else { - ref($options) && $options->{quiet} or print STDERR $buf; - } - $buf = ''; - } - } - close RSYNC; - } while ($? != 0 && --$count > 0 && -e (ref($options) ? $options->{dir} : $options) . "/$basename"); - propagate_sync_callback($options, 'end', $file); - } - chdir $cwd; - $? == 0 or die N("rsync failed: exited with %d or signal %d\n", $? >> 8, $? & 127); -} -#- default logger suitable for sync operation on STDERR only. -sub sync_logger { - my ($mode, $file, $percent, $total, $eta, $speed) = @_; - if ($mode eq 'start') { - print STDERR " $file\n"; - } elsif ($mode eq 'progress') { - my $text; - if (defined $total && defined $eta) { - $text = N(" %s%% of %s completed, ETA = %s, speed = %s", $percent, $total, $eta, $speed); - } else { - $text = N(" %s%% completed, speed = %s", $percent, $speed); - } - print STDERR $text, " " x (79 - length($text)), "\r"; - } elsif ($mode eq 'end') { - print STDERR " " x 79, "\r"; - } elsif ($mode eq 'error') { - #- error is 3rd argument, saved in $percent - print STDERR N("...retrieving failed: %s", $percent), "\n"; - } -} #- read /etc/urpmi/urpmi.cfg as config file, keep compability with older #- configuration file by examining if one entry is of the form |