summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--urpm.pm2
-rw-r--r--urpm/args.pm272
-rwxr-xr-xurpmi164
3 files changed, 325 insertions, 113 deletions
diff --git a/urpm.pm b/urpm.pm
index 1a1901ff..5806f3aa 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -3097,7 +3097,7 @@ sub install {
local (*CHILD_RETURNS, *ERROR_OUTPUT, $_);
if ($options{fork}) {
pipe(CHILD_RETURNS, ERROR_OUTPUT);
- defined($pid = fork()) or die "Can't fork: $!\n"
+ defined($pid = fork()) or die "Can't fork: $!\n";
if ($pid) {
# parent process
close ERROR_OUTPUT;
diff --git a/urpm/args.pm b/urpm/args.pm
new file mode 100644
index 00000000..7ce058c8
--- /dev/null
+++ b/urpm/args.pm
@@ -0,0 +1,272 @@
+package urpm::args;
+
+use strict;
+use warnings;
+no warnings 'once';
+use Getopt::Long;# 2.33;
+
+# The program that invokes us
+(my $tool = $0) =~ s!.*/!!;
+
+# Configuration of Getopt. urpmf is a special case, because we need to
+# parse non-alphanumerical options (-! -( -))
+my @configuration = qw(bundling gnu_compat permute);
+push @configuration, 'pass_through'
+ if $tool eq 'urpmf' || $tool eq 'urpmi.addmedia';
+Getopt::Long::Configure(@configuration);
+
+# global urpm object to be passed by the main program
+my $urpm;
+
+# options specifications for Getopt::Long
+my %options_spec = (
+
+ urpmi => {
+ "help|h" => sub {
+ if (defined &::usage) { ::usage() } else { die "No help defined\n" }
+ },
+ "no-locales" => sub {
+ require urpm; # make sure it has been loaded
+ undef *::N; undef *urpm::N;
+ *::N = *urpm::N = sub { sprintf(@_) };
+ },
+ update => \$::update,
+ 'media|mediums=s' => \$::media,
+ 'excludemedia|exclude-media=s' => \$::excludemedia,
+ 'sortmedia|sort-media=s' => \$::sortmedia,
+ 'synthesis=s' => \$::synthesis,
+ auto => \$urpm->{options}{auto},
+ 'allow-medium-change' => \$::allow_medium_change,
+ 'auto-select' => \$::auto_select,
+ 'no-remove|no-uninstall' => \$::no_remove,
+ keep => \$urpm->{options}{keep},
+ 'split-level=s' => \$urpm->{options}{'split-level'},
+ 'split-length=s' => \$urpm->{options}{'split-length'},
+ 'fuzzy!' => \$urpm->{options}{fuzzy},
+ 'src|s' => \$::src,
+ 'install-src' => \$::install_src,
+ clean => sub { $::clean = 1; $::noclean = 0 },
+ noclean => sub {
+ $::clean = $urpm->{options}{'pre-clean'} = $urpm->{options}{'post-clean'} = 0;
+ $::noclean = 1;
+ },
+ 'pre-clean!' => \$urpm->{options}{'pre-clean'},
+ 'post-clean!' => \$urpm->{options}{'post-clean'},
+ 'no-priority-upgrades' => sub {
+ $urpm->{options}{'priority-upgrade'} = '';
+ },
+ force => \$::force,
+ 'allow-nodeps' => \$urpm->{options}{'allow-nodeps'},
+ 'allow-force' => \$urpm->{options}{'allow-force'},
+ 'parallel=s' => \$::parallel,
+ wget => sub { $urpm->{options}{downloader} = 'wget' },
+ curl => sub { $urpm->{options}{downloader} = 'curl' },
+ 'limit-rate=s' => \$urpm->{options}{'limit-rate'},
+ 'resume!' => \$urpm->{options}{resume},
+ proxy => sub {
+ my (undef, $value) = @_;
+ my ($proxy, $port) = $value =~ m,^(?:http://)?([^:]+(:\d+)?)/*$,
+ or die N("bad proxy declaration on command line\n");
+ $proxy .= ":1080" unless $port;
+ $urpm->{proxy}{http_proxy} = "http://$proxy";
+ },
+ 'proxy-user' => sub {
+ my (undef, $value) = @_;
+ $value =~ /(.+):(.+)/ or die N("bad proxy declaration on command line\n");
+ @{$urpm->{proxy}}{qw(user pwd)} = ($1, $2);
+ },
+ 'bug=s' => \$::bug,
+ 'env=s' => \$::env,
+ X => \$::X,
+ WID => \$::WID,
+ 'best-output' => sub {
+ $::X ||= $ENV{DISPLAY} && system('/usr/X11R6/bin/xtest', '') == 0
+ },
+ 'verify-rpm!' => \$urpm->{options}{'verify-rpm'},
+ 'test!' => \$::test,
+ 'skip=s' => \$::skip,
+ 'root=s' => \$::root,
+ 'use-distrib=s' => \$::usedistrib,
+ 'excludepath|exclude-path=s' => \$urpm->{options}{excludepath},
+ 'excludedocs|exclude-docs' => \$urpm->{options}{excludedocs},
+ a => \$::all,
+ q => sub { --$::verbose; $::rpm_opt = '' },
+ v => sub { ++$::verbose; $::rpm_opt = 'vh' },
+ p => sub { $::use_provides = 1 },
+ P => sub { $::use_provides = 0 },
+ y => \$urpm->{options}{fuzzy},
+ z => \$urpm->{options}{compress},
+ },
+
+ urpme => {
+ auto => \$::auto,
+ v => \$::verbose,
+ a => \$::matches,
+ },
+
+ urpmf => {
+ 'verbose|v' => \$::verbose,
+ 'quiet|q' => \$::quiet,
+ 'uniq|u' => \$::uniq,
+ all => sub {
+ foreach my $k (qw(filename group size summary description sourcerpm
+ packager buildhost url provides requires files conflicts obsoletes))
+ {
+ $::params{$k} = 1;
+ }
+ },
+ name => \$::params{filename},
+ 'group|size|epoch|summary|description|sourcerpm|packager|buildhost|url|provides|requires|files|conflicts|obsoletes' => sub {
+ $::params{$_[0]} = 1;
+ },
+ i => sub { $::pattern = 'i' },
+ f => sub { $::full = 'full' },
+ 'e=s' => sub { $::expr .= "($_[0])" },
+ a => sub { $::expr .= ' && ' },
+ o => sub { $::expr .= ' || ' },
+ '<>' => sub {
+ my $p = shift;
+ if ($p =~ /^-([!()])$/) {
+ # This is for -! -( -)
+ $::expr .= $1;
+ }
+ else {
+ # This is for non-option arguments.
+ # Assume a regex unless a ++ is inside the string.
+ $p = quotemeta $p if $p =~ /\+\+/;
+ $::expr .= "m{$p}".$::pattern;
+ }
+ },
+ },
+
+ urpmq => {
+ update => \$::query->{update},
+ 'media|mediums=s' => \$::query->{media},
+ 'excludemedia|exclude-media=s' => \$::query->{excludemedia},
+ 'sortmedia|sort-media=s' => \$::query->{sortmedia},
+ 'synthesis=s' => \$::query->{sortmedia},
+ 'auto-select' => sub {
+ $::query->{deps} = $::query->{upgrade} = $::query->{auto_select} = 1;
+ },
+ fuzzy => sub {
+ $::query->{fuzzy} = $::query->{all} = 1;
+ },
+ keep => \$::query->{keep},
+ list => \$::query->{list},
+ 'list-media' => \$::query->{list_media},
+ 'list-url' => \$::query->{list_url},
+ 'list-nodes' => \$::query->{list_nodes},
+ 'list-aliases' => \$::query->{list_aliases},
+ 'dump-config' => \$::query->{dump_config},
+ 'src|s' => \$::query->{src},
+ headers => \$::query->{headers},
+ sources => \$::query->{sources},
+ force => \$::query->{force},
+ 'skip=s' => \$::query->{skip},
+ 'root=s' => \$::query->{root},
+ 'use-distrib=s' => \$::query->{usedistrib},
+ 'parallel=s' => \$::query->{parallel},
+ 'env=s' => \$::query->{env},
+ 'changelog=s' => \$::query->{changelog},
+ d => \$::query->{deps},
+ u => \$::query->{upgrade},
+ a => \$::query->{all},
+ 'm|M' => sub { $::query->{deps} = $::query->{upgrade} = 1 },
+ c => \$::query->{complete},
+ g => \$::query->{group},
+ p => \$::query->{use_provides},
+ P => sub { $::query->{use_provides} = 0 },
+ R => \$::query->{what_requires},
+ y => sub { $::query->{fuzzy} = $::query->{all} = 1 },
+ v => \$::query->{verbose},
+ i => \$::query->{info},
+ l => \$::query->{list_files},
+ r => sub {
+ $::query->{version} = $::query->{release} = 1;
+ },
+ f => sub {
+ $::query->{version} = $::query->{release} = $::query->{arch} = 1;
+ },
+ },
+
+ 'urpmi.update' => {
+ a => \$::options{all},
+ c => sub { $::options{noclean} = 0 },
+ f => sub { ++$::options{force} },
+ z => sub { ++$::options{compress} },
+ update => \$::options{update},
+ 'force-key' => \$::options{forcekey},
+ 'limit-rate=s' => \$::options{limit_rate},
+ 'no-md5sum' => \$::options{nomd5sum},
+ 'noa|d' => \my $dummy, # default, keeped for compatibility
+ '<>' => sub { push @::toupdates, $_[0] },
+ },
+
+ 'urpmi.addmedia' => {
+ 'probe-synthesis' => sub { $::options{probe_with} = 'synthesis' },
+ 'probe-hdlist' => sub { $::options{probe_with} = 'hdlist' },
+ 'no-probe' => sub { $::options{probe_with} = undef },
+ distrib => sub { $::options{distrib} = undef },
+ 'from=s' => \$::options{mirrors_url},
+ 'version=s' => \$::options{version},
+ 'arch=s' => \$::options{arch},
+ virtual => \$::options{virtual},
+ '<>' => sub {
+ if ($_[0] =~ /^--distrib-(.*)$/) {
+ $::options{distrib} = $1;
+ }
+ },
+ },
+
+);
+
+# common options setup
+# TODO <> for arguments
+
+foreach my $k ("help|h", "no-locales", "test!", "force", "root=s", "use-distrib=s",
+ "parallel=s")
+{
+ $options_spec{urpme}{$k} = $options_spec{urpmi}{$k};
+}
+
+foreach my $k ("help|h", "no-locales", "update", "media|mediums=s",
+ "excludemedia|exclude-media=s", "sortmedia|sort-media=s",
+ "synthesis=s", "env=s")
+{
+ $options_spec{urpmf}{$k} = $options_spec{urpmi}{$k};
+}
+
+foreach my $k ("help|h", "wget", "curl", "proxy", "proxy-user") {
+ $options_spec{'urpmi.update'}{$k} =
+ $options_spec{urpmq}{$k} = $options_spec{urpmi}{$k};
+}
+
+foreach my $k ("help|h", "wget", "curl", "proxy", "proxy-user", "c", "f", "z",
+ "limit-rate=s", "no-md5sum", "update")
+{
+ $options_spec{'urpmi.addmedia'}{$k} = $options_spec{'urpmi.update'}{$k};
+}
+
+sub parse_cmdline {
+ my %args = @_;
+ # set up global urpm object
+ $urpm = $args{urpm};
+ # get default values (and read config file)
+ # TODO
+ # parse options
+ GetOptions(%{$options_spec{$tool}});
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+urpm::args - command-line argument parser for the urpm* tools
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=cut
diff --git a/urpmi b/urpmi
index 485084d9..c7905b40 100755
--- a/urpmi
+++ b/urpmi
@@ -18,44 +18,44 @@
#- along with this program; if not, write to the Free Software
#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#use strict qw(subs vars refs);
use strict;
use urpm;
+use urpm::args;
use MDK::Common;
#- contains informations to parse installed system.
my $urpm = new urpm;
#- default options.
-my $update = 0;
-my $media = '';
-my $excludemedia = '';
-my $sortmedia = '';
-my $synthesis = '';
-my $allow_medium_change = 0;
-my $auto_select = 0;
-my $no_remove = 0;
+our $update = 0;
+our $media = '';
+our $excludemedia = '';
+our $sortmedia = '';
+our $synthesis = '';
+our $allow_medium_change = 0;
+our $auto_select = 0;
+our $no_remove = 0;
+our $src = 0;
+our $install_src = 0;
+our $clean = 0;
+our $noclean = 0;
my $split_level = 20;
my $split_length = 1;
-my $force = 0;
-my $parallel = '';
-my $X = 0;
-my $WID = 0;
-my $all = 0;
-my $rpm_opt = "vh";
-my $use_provides = 1;
-my $src = 0;
-my $install_src = 0;
-my $clean = 0;
-my $noclean = 0;
-my $verbose = 0;
-my $skip = '';
-my $root = '';
-my $usedistrib = 0;
-my $bug = '';
-my $env = '';
+our $force = 0;
+our $parallel = '';
+our $bug = '';
+our $env = '';
+our $X = 0;
+our $WID = 0;
+our $test = 0;
+our $skip = '';
+our $root = '';
+our $all = 0;
+our $rpm_opt = "vh";
+our $use_provides = 1;
+our $verbose = 0;
+our $usedistrib = 0;
my $log = '';
-my $test = 0;
my $uid;
my @files;
@@ -161,86 +161,28 @@ sub save_file {
exit(1);
}
-#- parse arguments list.
-my @nextargv;
+# Parse command line
my $command_line = join " ", @ARGV;
@ARGV or usage;
-my @argv = @ARGV;
-while (defined($_ = shift @argv)) {
- /^--help$/ and do { usage; next };
- /^--no-locales$/ and do { undef *N; undef *urpm::N; *N = *urpm::N = sub { sprintf(shift @_, @_) }; next };
- /^--update$/ and do { $update = 1; next };
- /^--media$/ and do { push @nextargv, \$media; next };
- /^--exclude-?media$/ and do { push @nextargv, \$excludemedia; next };
- /^--sort-?media$/ and do { push @nextargv, \$sortmedia; next };
- /^--mediums$/ and do { push @nextargv, \$media; next };
- /^--synthesis$/ and do { push @nextargv, \$synthesis; next };
- /^--auto$/ and do { $urpm->{options}{auto} = 1; next };
- /^--allow-medium-change$/ and do { $allow_medium_change = 1; next };
- /^--auto-select$/ and do { $auto_select = 1; next };
- /^--no-(remove|uninstall)$/ and do { $no_remove = 1; next };
- /^--keep$/ and do { $urpm->{options}{keep} = 1; next };
- /^--split-level$/ and do { push @nextargv, \$urpm->{options}{'split-level'}; next };
- /^--split-length$/ and do { push @nextargv, \$urpm->{options}{'split-length'}; next };
- /^--(no-)?fuzzy$/ and do { $urpm->{options}{fuzzy} = !$1; next };
- /^--src$/ and do { $src = 1; next };
- /^--install-src$/ and do { $install_src = 1; next };
- /^--clean$/ and do { $clean = 1; $noclean = 0; next };
- /^--noclean$/ and do { $clean = $urpm->{options}{'pre-clean'} = $urpm->{options}{'post-clean'} = 0; $noclean = 1; next };
- /^--(no-)?pre-clean$/ and do { $urpm->{options}{'pre-clean'} = !$1; next };
- /^--(no-)?post-clean$/ and do { $urpm->{options}{'post-clean'} = !$1; next };
- /^--no-priority-upgrade$/ and do { $urpm->{options}{'priority-upgrade'} = ''; next };
- /^--force$/ and do { $force = 1; next };
- /^--allow-nodeps$/ and do { $urpm->{options}{'allow-nodeps'} = 1; next };
- /^--allow-force$/ and do { $urpm->{options}{'allow-force'} = 1; next };
- /^--parallel$/ and do { push @nextargv, \$parallel; next };
- /^--wget$/ and do { $urpm->{options}{downloader} = 'wget'; next };
- /^--curl$/ and do { $urpm->{options}{downloader} = 'curl'; next };
- /^--limit-rate$/ and do { push @nextargv, \$urpm->{options}{'limit-rate'}; next };
- /^--(no-)?resume$/ and do { $urpm->{options}{'resume'} = !$1; next };
- /^--proxy$/ and do {
- my ($proxy, $port) = ($_ = shift @argv) =~ m,^(?:http://)?([^:]+(:\d+)?)/*$, or
- die N("bad proxy declaration on command line\n");
- $proxy .= ":1080" unless $port;
- $urpm->{proxy}{http_proxy} = "http://$proxy";
- next;
- };
- /^--proxy-user$/ and do {
- ($_ = shift @argv) =~ /(.+):(.+)/, or
- die N("bad proxy declaration on command line\n");
- @{$urpm->{proxy}}{qw(user pwd)} = ($1, $2);
+my @ARGVcopy; # keep a copy, in case we have to restart
+
+# Expand *.urpmi arguments
+foreach my $a (@ARGV) {
+ if ($a =~ /\.urpmi$/) {
+ push @ARGVcopy, split /\n/, cat_($a);
next;
- };
- /^--bug$/ and do { push @nextargv, \$bug; next };
- /^--env$/ and do { push @nextargv, \$env; next };
- /^--X$/ and do { $X = 1; next };
- /^--WID=(.*)$/ and do { $WID = $1; next };
- /^--WID$/ and do { push @nextargv, \$WID; next };
- /^--best-output$/ and do { $X ||= $ENV{DISPLAY} && system('/usr/X11R6/bin/xtest', '') == 0;
- next };
- /^--(no-)?verify-rpm$/ and do { $urpm->{options}{'verify-rpm'} = !$1; next };
- /^--(no-)?test$/ and do { $test = !$1; next };
- /^--comment$/ and do { push @nextargv, undef; next };
- /^--skip$/ and do { push @nextargv, \$skip; next };
- /^--root$/ and do { push @nextargv, \$root; next };
- /^--use-distrib$/ and do { push @nextargv, \$usedistrib; next };
- /^--exclude-?path$/ and do { $urpm->{options}{excludepath} = undef; push @nextargv, \$urpm->{options}{excludepath}; next };
- /^--exclude-?docs$/ and do { $urpm->{options}{excludedocs} = 1; next };
- /^-(.*)$/ and do { foreach (split //, $1) {
- /[\?h]/ and do { usage; next };
- /a/ and do { $all = 1; next };
- /c/ and do { next };
- /m/ and do { next };
- /M/ and do { next }; #- nop
- /q/ and do { --$verbose; $rpm_opt = ""; next };
- /p/ and do { $use_provides = 1; next };
- /P/ and do { $use_provides = 0; next };
- /y/ and do { $urpm->{options}{fuzzy} = 1; next };
- /s/ and do { $src = 1; next };
- /v/ and do { ++$verbose; $rpm_opt = "vh"; next };
- /z/ and do { $urpm->{options}{compress} = 1; next };
- die N("urpmi: unknown option \"-%s\", check usage with --help\n", $1) } next };
- @nextargv and do { my $r = shift @nextargv; $r and $$r = $_; next };
+ }
+ else {
+ push @ARGVcopy, $a;
+ }
+}
+@ARGV = @ARGVcopy;
+
+# Parse command line options
+urpm::args::parse_cmdline(urpm => $urpm);
+
+# Process the rest of the arguments
+while (defined($_ = shift @ARGV)) {
if (/\.rpm$/) {
if (/\.src\.rpm$/) {
push @src_files, $_;
@@ -249,10 +191,6 @@ while (defined($_ = shift @argv)) {
}
next;
}
- if (/\.urpmi$/) {
- push @argv, split /\n/, cat_($_);
- next;
- }
if ($src) {
push @src_names, $_;
} else {
@@ -853,10 +791,12 @@ if ($restart_itself && !$exit_code) {
#- it seems to work correctly with exec instead of system, provided
#- STDOUT or STDERR are not closed before (else no output at all).
#- added --no-priority-upgrade to make sure no restart will be done after this one.
- #- renamed bug report dir as /restarted to avoid exit because it alllreday exists
- #- This permit to have in same dir bug report before and after the restart
- my @arg = ($ARGV[0], map { $ARGV[$_] . ($ARGV[$_ - 1] =~ /^--bug$/ ? "/restarted" : "") } (1 .. $#ARGV));
- exec "$0", '--no-priority-upgrade', @arg;
+ #- renamed bug report dir as /restarted to avoid exit because it already exists
+ #- This permits to have in a same dir bug reports before and after the restart
+ @ARGV = @ARGVcopy;
+ my @arg = ($ARGV[0], map { $ARGV[$_] . ($ARGV[$_ - 1] =~ /^--bug$/
+ ? "/restarted" : "") } (1 .. $#ARGV));
+ exec $0, '--no-priority-upgrade', @arg;
}
#- this help flushing correctly by closing this file before (piped on tee).