summaryrefslogtreecommitdiffstats
path: root/urpm.pm
diff options
context:
space:
mode:
Diffstat (limited to 'urpm.pm')
-rw-r--r--urpm.pm348
1 files changed, 1 insertions, 347 deletions
diff --git a/urpm.pm b/urpm.pm
index 33ac145f..9747cb96 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -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