The following commit has been merged in the master branch:
commit b51a31124678220859d08859497dba7771d0a909
Author: Raphael Hertzog <hert...@debian.org>
Date: Wed Feb 18 15:40:22 2009 +0100
update-alternatives: complete rewrite
Full rewrite of update-alternatives. It was badly needed so that
we can actually understand its behaviour and implement new features
on top of it. This commit doesn't add any new feature but still improves
the behaviour of --config: it has a nicer output (with choices sorted
alphabetically, closes: #437060) and it accepts a path as well as the
index of the choice (to make it easier to write non regression tests for
this action). The test-suite is adjusted accordingly.
diff --git a/ChangeLog b/ChangeLog
index 86f2670..1fe98d9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,14 @@
2009-02-22 Raphael Hertzog <hert...@debian.org>
+ * scripts/update-alternatives.pl: Rewrite it entirely in a more
+ object-oriented way. The only behaviour changes concern --config:
+ the output is nicer and sorted, it accets a path as well as the
+ index of the choice.
+ * scripts/t/900_update_alternatives.t: Test suite adjusted to the
+ --config change.
+
+2009-02-22 Raphael Hertzog <hert...@debian.org>
+
* scripts/dpkg-gencontrol.pl, scripts/dpkg-gensymbols.pl: Reset
umask to 0022 to ensure that files created in the DEBIAN directory
have sane permissions.
diff --git a/debian/changelog b/debian/changelog
index c363634..06275f4 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -153,6 +153,9 @@ dpkg (1.15.0) UNRELEASED; urgency=low
* Reset umask to 0022 in dpkg-gencontrol and dpkg-gensymbols to ensure that
files created in the DEBIAN directory have sane permissions.
Closes: #516481
+ * Rewrite update-alternatives (so that we can understand it again) and
+ implement new features on top of it:
+ - the --config output is now sorted. Closes: #437060
[ Pierre Habouzit ]
* Add a --query option to update-alternatives. Closes: #336091, #441904
diff --git a/scripts/t/900_update_alternatives.t
b/scripts/t/900_update_alternatives.t
index 12bccf7..ad7bd89 100644
--- a/scripts/t/900_update_alternatives.t
+++ b/scripts/t/900_update_alternatives.t
@@ -99,8 +99,11 @@ sub set_choice {
sub config_choice {
my ($id, %opts) = @_;
my ($input, $output) = ("", "");
- if (defined $id) {
- $input = $id + 1;
+ if ($id >= 0) {
+ my $alt = $choices[$id];
+ $input = $alt->{path};
+ } else {
+ $input = "0";
}
$input .= "\n";
$opts{from_string} = \$input;
@@ -162,7 +165,8 @@ sub check_choice {
if (defined $id) {
# Check status
call_ua([ "--query", "$main_name" ], to_string => \$output);
- ok(($output =~ /^Status: $mode$/im), "$msg: status is not $mode.");
+ $output =~ /^Status: (.*)$/im;
+ is($1, $mode, "$msg: status is not $mode.");
# Check links
my $alt = $choices[$id];
check_link("$altdir/$main_name", $alt->{path}, $msg);
@@ -221,11 +225,9 @@ ok(unlink("$altdir/generic-test"), "failed removal");
install_choice(1);
check_choice(0, "auto", "<altdir>/generic-test lost, back to auto");
# test --config
-# TODO: for now order of choices in config depends on order of --install calls
-# it's not very "test-friendly"
-config_choice(1);
-check_choice(0, "manual", "config to best but manual");
config_choice(0);
+check_choice(0, "manual", "config to best but manual");
+config_choice(1);
check_choice(1, "manual", "config to manual");
config_choice(-1);
check_choice(0, "auto", "config auto");
@@ -263,4 +265,4 @@ system("echo garbage > $admindir/generic-test");
install_choice(0, error_to_file => "/dev/null", expect_failure => 1);
# TODO: add checks for invalid values of parameters, add checks for
-# usage of links as both master and slave
+# usage of links as both master and slave, install in non-existing dir
diff --git a/scripts/update-alternatives.pl b/scripts/update-alternatives.pl
index d8f78d1..dd98260 100755
--- a/scripts/update-alternatives.pl
+++ b/scripts/update-alternatives.pl
@@ -16,54 +16,272 @@ textdomain("dpkg");
# Global variables:
my $altdir = '/etc/alternatives';
-# FIXME: this should not override the previous assignment.
-$admindir = $admindir . '/alternatives';
+my $admdir = $admindir . '/alternatives';
+my $action = ''; # Action to perform (display / query / install / remove
/ auto / config)
+my $skip_auto = ''; # Skip alternatives properly configured in auto mode
(for --config)
+my $alternative; # Alternative worked on
+my $inst_alt; # Alternative to install
+my $fileset; # Set of files to install in the alternative
+my $path; # Path of alternative we are offering
my $verbosemode = 0;
-my $action = ''; # Action to perform (display / query / install / remove
/ auto / config)
-my $mode = 'auto'; # Update mode for alternative (manual / auto)
-my $skip = ''; # Skip alternatives properly configured in auto mode
(for --config)
-my $state; # State of alternative:
- # expected: alternative with highest priority is the
active alternative
- # expected-inprogress: busy selecting alternative with
highest priority
- # unexpected: alternative another alternative is
active / error during readlink
- # nonexistent: alternative-symlink does not exist
-
-my %versionnum; # Map from currently available versions into @versions
and @priorities
-my @versions; # List of available versions for alternative
-my @priorities; # Map from @version-index to priority
-
-my $best;
-my $bestpri;
-my $bestnum;
-
-my $link; # Link we are working with
-my $linkname;
-
-my $alink; # Alternative we are managing (ie the symlink we're
making/removing) (install only)
-my $name; # Name of the alternative (the symlink) we are processing
-my $apath; # Path of alternative we are offering
-my $apriority; # Priority of link (only when we are installing an
alternative)
-my %aslavelink;
-my %aslavepath;
-my %aslavelinkcount;
-
-my $slink;
-my $sname;
-my $spath;
-my @slavenames; # List with names of slavelinks
-my %slavenum; # Map from name of slavelink to slave-index (into
@slavelinks)
-my @slavelinks; # List of slavelinks (indexed by slave-index)
-my %slavepath; # Map from (@version-index,slavename) to slave-path
-my %slavelinkcount;
+$| = 1;
+
+#
+# Main program
+#
+
+while (@ARGV) {
+ $_ = shift(@ARGV);
+ last if m/^--$/;
+ if (!m/^--/) {
+ quit(_g("unknown argument \`%s'"), $_);
+ } elsif (m/^--help$/) {
+ usage();
+ exit(0);
+ } elsif (m/^--version$/) {
+ version();
+ exit(0);
+ } elsif (m/^--verbose$/) {
+ $verbosemode= +1;
+ } elsif (m/^--quiet$/) {
+ $verbosemode= -1;
+ } elsif (m/^--install$/) {
+ set_action("install");
+ @ARGV >= 4 || badusage(_g("--install needs <link> <name> <path>
<priority>"));
+ my $link = shift @ARGV;
+ my $name = shift @ARGV;
+ my $path = shift @ARGV;
+ my $priority = shift @ARGV;
+ $priority =~ m/^[-+]?\d+/ || badusage(_g("priority must be an
integer"));
+ $alternative = Alternative->new($name);
+ $inst_alt = Alternative->new($name);
+ $inst_alt->set_status("auto");
+ $inst_alt->set_link($link);
+ $fileset = FileSet->new($path, $priority);
+ } elsif (m/^--(remove|set)$/) {
+ set_action($1);
+ @ARGV >= 2 || badusage(_g("--%s needs <name> <path>"), $1);
+ $alternative = Alternative->new(shift(@ARGV));
+ $path = shift @ARGV;
+ } elsif (m/^--(display|query|auto|config|list|remove-all)$/) {
+ set_action($1);
+ @ARGV || badusage(_g("--%s needs <name>"), $1);
+ $alternative = Alternative->new(shift(@ARGV));
+ } elsif (m/^--all$/) {
+ set_action('all');
+ } elsif (m/^--slave$/) {
+ badusage(_g("--slave only allowed with --install"))
+ unless $action eq "install";
+ @ARGV >= 3 || badusage(_g("--slave needs <link> <name> <path>"));
+ my $slink = shift @ARGV;
+ my $sname = shift @ARGV;
+ my $spath = shift @ARGV;
+ badusage(_g("name %s is both primary and slave"), $inst_alt->name())
+ if $sname eq $inst_alt->name();
+ if ($inst_alt->has_slave($sname)) {
+ badusage(_g("slave name %s duplicated"), $sname);
+ }
+ foreach my $slave ($inst_alt->slaves()) {
+ my $link = $inst_alt->slave_link($slave) || "";
+ badusage(_g("slave link %s duplicated"), $slink) if $link eq
$slink;
+ badusage(_g("link %s is both primary and slave"), $slink)
+ if $link eq $inst_alt->link();
+ }
+ $inst_alt->add_slave($sname, $slink);
+ $fileset->add_slave($sname, $spath);
+ } elsif (m/^--altdir$/) {
+ @ARGV || badusage(_g("--%s needs a <directory> argument"), "altdir");
+ $altdir = shift @ARGV;
+ } elsif (m/^--admindir$/) {
+ @ARGV || badusage(_g("--%s needs a <directory> argument"), "admindir");
+ $admdir = shift @ARGV;
+ } elsif (m/^--skip-auto$/) {
+ $skip_auto = 1;
+ } else {
+ badusage(_g("unknown option \`%s'"), $_);
+ }
+}
+
+badusage(_g("need --display, --query, --list, --config, --set, --install," .
+ "--remove, --all, --remove-all or --auto")) unless $action;
+
+# Handle actions
+if ($action eq 'all') {
+ config_all();
+ exit 0;
+}
+
+# Load the alternative info, stop on failure except for --install
+if (not $alternative->load("$admdir/" . $alternative->name())
+ and $action ne "install")
+{
+ pr(_g("No alternatives for %s."), $alternative->name());
+ # FIXME: Be consistent for now with the case when we try to remove a
+ # non-existing path from an existing link group file.
+ exit 0 if $action eq "remove";
+ exit 1;
+}
+
+if ($action eq 'display') {
+ $alternative->display_user();
+ exit 0;
+} elsif ($action eq 'query') {
+ $alternative->display_query();
+ exit 0;
+} elsif ($action eq 'list') {
+ $alternative->display_list();
+ exit 0;
+}
+
+# Actions below might modify the system
+
+my $current_choice = '';
+if ($alternative->has_current_link()) {
+ $current_choice = $alternative->current();
+ # Detect manually modified alternative, switch to manual
+ if (not $alternative->has_choice($current_choice)) {
+ if ($alternative->status() ne "manual") {
+ pr(_g("%s has been changed (manually or by a script).\n" .
+ "Switching to manual updates only."),
+ "$altdir/" . $alternative->name())
+ if $verbosemode >= 0;
+ $alternative->set_status('manual');
+ }
+ }
+} else {
+ # Lack of alternative link => automatic mode
+ pr(sprintf(_g("Setting up automatic selection of %s."),
$alternative->name()))
+ if $verbosemode > 0;
+ $alternative->set_status('auto');
+}
+
+my $new_choice;
+if ($action eq 'set') {
+ $alternative->set_status('manual');
+ $new_choice = $path;
+} elsif ($action eq 'auto') {
+ $alternative->set_status('auto');
+ $new_choice = $alternative->best();
+} elsif ($action eq 'config') {
+ if (not scalar($alternative->choices())) {
+ printf _g("There is no program which provides %s.\n".
+ "Nothing to configure.\n"), $alternative->name();
+ } elsif ($skip_auto && $alternative->status() eq 'auto') {
+ $alternative->display_user();
+ } elsif (scalar($alternative->choices()) == 1 and
+ $alternative->status() eq 'auto' and
+ $alternative->has_current_link()) {
+ printf _g("There is only 1 program which provides %s properly in auto
mode\n".
+ "(%s). Nothing to configure.\n"), $alternative->name(),
+ $alternative->current();
+ } else {
+ $new_choice = $alternative->select_choice();
+ }
+} elsif ($action eq 'remove') {
+ if ($alternative->has_choice($path)) {
+ $alternative->remove_choice($path);
+ } else {
+ pr(_g("Alternative %s for %s not registered, not removing."),
+ $path, $alternative->name()) if $verbosemode > 0;
+ }
+ if ($current_choice eq $path) {
+ # Current choice is removed
+ if ($alternative->status() eq "manual") {
+ # And it was manual, switch to auto
+ pr(_g("Removing manually selected alternative - switching to auto
mode"))
+ if $verbosemode >= 0;
+ $alternative->set_status('auto');
+ }
+ $new_choice = $alternative->best();
+ }
+} elsif ($action eq 'remove-all') {
+ foreach my $choice ($alternative->choices()) {
+ $alternative->remove_choice($choice);
+ }
+} elsif ($action eq 'install') {
+ if (defined($alternative->link())) {
+ # Alternative already exists, check if anything got updated
+ my ($old, $new) = ($alternative->link(), $inst_alt->link());
+ $alternative->set_link($new);
+ if ($old ne $new and -l $old) {
+ pr(_g("Renaming %s link from %s to %s."), $inst_alt->name(),
+ $old, $new) if $verbosemode >= 0;
+ rename_mv($old, $new, 1) ||
+ quit(_g("unable to rename %s to %s: see error above"), $old,
$new);
+ }
+ # Check if new slaves have been added, or existing ones renamed
+ foreach my $slave ($inst_alt->slaves()) {
+ $new = $inst_alt->slave_link($slave);
+ if (not $alternative->has_slave($slave)) {
+ $alternative->add_slave($slave, $new);
+ next;
+ }
+ $old = $alternative->slave_link($slave);
+ $alternative->add_slave($slave, $new);
+ if ($old ne $new and -l $old) {
+ pr(_g("Renaming %s slave link from %s to %s."), $slave,
+ $old, $new) if $verbosemode >= 0;
+ rename_mv($old, $new, 1) ||
+ quit(_g("unable to rename %s to %s: see error above"),
$old, $new);
+ }
+ }
+ } else {
+ # Alternative doesn't exist, create from parameters
+ $alternative = $inst_alt;
+ }
+ $alternative->add_choice($fileset);
+ if ($alternative->status() eq "auto") {
+ # Update automatic choice if needed
+ $new_choice = $alternative->best();
+ } else {
+ pr(_g("Automatic updates of %s are disabled, leaving it alone."),
+ "$altdir/" . $alternative->name()) if $verbosemode > 0;
+ pr(_g("To return to automatic updates use \`update-alternatives --auto
%s'."),
+ $alternative->name()) if $verbosemode > 0;
+ }
+}
+
+# No choice left, remove everything
+if (not scalar($alternative->choices())) {
+ $alternative->remove();
+ exit 0;
+}
+# New choice wanted
+#print "NEW: $new_choice, was $current_choice\n";
+if (defined($new_choice) and ($current_choice ne $new_choice)) {
+ printf _g("Using '%s' to provide '%s' in %s.") . "\n", $new_choice,
+ $alternative->name(),
+ ($alternative->status() eq "auto" ? _g("auto mode") : _g("manual
mode"))
+ if $verbosemode >= 0;
+ $alternative->prepare_install($new_choice);
+} elsif ($alternative->is_broken()) {
+ # TODO: warn & log
+ $alternative->prepare_install($current_choice) if $current_choice;
+}
+
+# Save administrative file if needed
+if ($alternative->is_modified()) {
+ $alternative->save("$admdir/" . $alternative->name() . ".dpkg-tmp");
+ checked_mv("$admdir/" . $alternative->name() . ".dpkg-tmp",
+ "$admdir/" . $alternative->name());
+}
+
+# Replace all symlinks in one pass
+$alternative->commit();
+
+exit 0;
+
+### FUNCTIONS ####
sub version {
printf _g("Debian %s version %s.\n"), $progname, $version;
printf _g("
-Copyright (C) 1995 Ian Jackson.
-Copyright (C) 2000-2002 Wichert Akkerman.");
+Copyright © 1995 Ian Jackson.
+Copyright © 2000-2002 Wichert Akkerman.
+Copyright © 2009 Raphaël Hertzog.");
printf _g("
This is free software; see the GNU General Public Licence version 2 or
@@ -111,704 +329,583 @@ Options:
"), $progname, $altdir;
}
-sub quit
-{
- printf STDERR "%s: %s\n", $progname, "@_";
- exit(2);
+sub quit {
+ my ($format, @params) = @_;
+ $! = 2;
+ die sprintf("%s: %s\n", $progname, sprintf($format, @params));
}
-sub badusage
-{
- printf STDERR "%s: %s\n\n", $progname, "@_";
+sub badusage {
+ my ($format, @params) = @_;
+ printf STDERR "%s: %s\n\n", $progname, sprintf($format, @params);
usage();
exit(2);
}
-sub read_link_group
-{
- return 1 if not -s "$admindir/$name"; # Ignore empty file
- if (open(AF, "$admindir/$name")) {
- $mode = gl("update_mode");
- $mode eq 'auto' || $mode eq 'manual' || badfmt(_g("invalid update
mode"));
- $link = gl("link");
- while (($sname = gl("sname")) ne '') {
- push(@slavenames, $sname);
- defined($slavenum{$sname}) && badfmt(sprintf(_g("duplicate slave
%s"), $sname));
- $slavenum{$sname} = $#slavenames;
- $slink = gl("slink");
- $slink eq $link && badfmt(sprintf(_g("slave link same as main link
%s"), $link));
- $slavelinkcount{$slink}++ && badfmt(sprintf(_g("duplicate slave
link %s"), $slink));
- push(@slavelinks, $slink);
- }
- while (($version = gl("version")) ne '') {
- defined($versionnum{$version}) && badfmt(sprintf(_g("duplicate path
%s"), $version));
- if (-r $version) {
- push(@versions, $version);
- my $i;
- $versionnum{$version} = $i = $#versions;
- my $priority = gl("priority");
- $priority =~ m/^[-+]?\d+$/ || badfmt(sprintf(_g("priority %s
%s"), $version, $priority));
- $priorities[$i] = $priority;
- for (my $j = 0; $j <= $#slavenames; $j++) {
- $slavepath{$i,$j} = gl("spath");
- }
- } else {
- # File not found - remove
- pr(sprintf(_g("Alternative for %s points to %s - which wasn't
found. Removing from list of alternatives."), $name, $version))
- if $verbosemode > 0;
- gl("priority");
- for (my $j = 0; $j <= $#slavenames; $j++) {
- gl("spath");
- }
- }
- }
- close(AF);
- return 0;
- } elsif ($! != ENOENT) {
- quit(sprintf(_g("unable to open %s: %s"), "$admindir/$name", $!));
- } elsif ($! == ENOENT) {
- return 1;
- }
-}
-
-sub fill_missing_slavepaths()
-{
- for (my $j = 0; $j <= $#slavenames; $j++) {
- for (my $i = 0; $i <= $#versions; $i++) {
- $slavepath{$i,$j} ||= '';
- }
- }
-}
-
-sub find_best_version
-{
- $best = '';
- for (my $i = 0; $i <= $#versions; $i++) {
- if ($best eq '' || $priorities[$i] > $bestpri) {
- $best = $versions[$i];
- $bestpri = $priorities[$i];
- $bestnum = $i;
- }
- }
-}
-
-sub display_link_group
-{
- pr(sprintf("%s - %s", $name,
- ($mode eq "auto") ? _g("auto mode") : _g("manual mode")));
- $linkname = readlink("$altdir/$name");
-
- if (defined($linkname)) {
- pr(sprintf(_g(" link currently points to %s"), $linkname));
- } elsif ($! == ENOENT) {
- pr(_g(" link currently absent"));
- } else {
- pr(sprintf(_g(" link unreadable - %s"), $!));
- }
-
- for (my $i = 0; $i <= $#versions; $i++) {
- pr(sprintf(_g("%s - priority %s"), $versions[$i], $priorities[$i]));
- for (my $j = 0; $j <= $#slavenames; $j++) {
- my $tspath = $slavepath{$i, $j};
- next unless length($tspath);
- pr(sprintf(_g(" slave %s: %s"), $slavenames[$j], $tspath));
- }
- }
-
- if ($best eq '') {
- pr(_g("No versions available."));
- } else {
- pr(sprintf(_g("Current \`best' version is %s."), $best));
+sub set_action {
+ my ($value) = @_;
+ if ($action) {
+ badusage(_g("two commands specified: --%s and --%s"), $value, $action);
}
+ $action = $value;
}
-sub query_link_group
-{
- pr(sprintf("Link: %s", $name));
- pr(sprintf("Status: %s", $mode));
- if ($best ne '') {
- pr(sprintf("Best: %s", $best));
- }
- $linkname = readlink("$altdir/$name");
-
- if (defined($linkname)) {
- pr(sprintf("Value: %s", $linkname));
- } elsif ($! == ENOENT) {
- pr("Value: none");
- } else {
- pr("Value: error");
- pr(sprintf("Error: %s", $!));
- }
-
- for (my $i = 0; $i <= $#versions; $i++) {
- pr("");
- pr(sprintf("Alternative: %s", $versions[$i]));
- pr(sprintf("Priority: %s", $priorities[$i]));
- next unless ($#slavenames >= 0);
- pr("Slaves:");
- for (my $j = 0; $j <= $#slavenames; $j++) {
- my $tspath = $slavepath{$i, $j};
- next unless length($tspath);
- pr(sprintf(" %s %s", $slavenames[$j], $tspath));
- }
+sub config_all {
+ opendir(ADMINDIR, $admdir)
+ or quit(_g("can't readdir %s: %s"), $admdir, $!);
+ my @filenames = grep !/^\.\.?$/, readdir ADMINDIR;
+ close(ADMINDIR);
+ foreach my $name (@filenames) {
+ system "$0 $skip --config $name";
+ exit $? if $?;
+ print "\n";
}
}
-sub list_link_group
-{
- for (my $i = 0; $i <= $#versions; $i++) {
- pr("$versions[$i]");
- }
+sub pr {
+ my ($format, @params) = @_;
+ print sprintf($format, @params) . "\n";
}
-sub checked_alternative($$$)
-{
- my ($name, $link, $path) = @_;
-
- $linkname = readlink($link);
- if (!defined($linkname) && $! != ENOENT) {
- pr(sprintf(_g("warning: %s is supposed to be a symlink to %s, \n".
- "or nonexistent; however, readlink failed: %s"),
- $link, "$altdir/$name", $!))
- if $verbosemode > 0;
- } elsif (!defined($linkname) ||
- (defined($linkname) && $linkname ne "$altdir/$name")) {
- checked_rm("$link.dpkg-tmp");
- checked_symlink("$altdir/$name", "$link.dpkg-tmp");
- checked_mv("$link.dpkg-tmp", $link);
- }
- $linkname = readlink("$altdir/$name");
- if (defined($linkname) && $linkname eq $path) {
- pr(sprintf(_g("Leaving %s (%s) pointing to %s."), $name, $link, $path))
- if $verbosemode > 0;
- } else {
- pr(sprintf(_g("Updating %s (%s) to point to %s."), $name, $link, $path))
- if $verbosemode > 0;
+sub rename_mv {
+ my ($source, $dest, $ignore_enoent) = @_;
+ $ignore_enoent = 0 unless defined($ignore_enoent);
+ return 1 if ($ignore_enoent and not -e $source);
+ if (not rename($source, $dest)) {
+ if (system("mv", $source, $dest) != 0) {
+ return $ignore_enoent if $! == ENOENT;
+ return 0;
+ }
}
+ return 1;
}
-sub set_links($$$;$)
-{
- my ($spath, $link, $preferred, $quiet) = (@_);
-
- printf STDOUT _g("Using '%s' to provide '%s' in %s.") . "\n", $spath,
- $name, ($mode eq "auto" ? _g("auto mode") : _g("manual
mode"))
- unless $quiet;
- checked_alternative($name, $link, $spath);
- checked_symlink("$spath","$altdir/$name.dpkg-tmp");
- checked_mv("$altdir/$name.dpkg-tmp", "$altdir/$name");
-
- # Link slaves...
- for (my $slnum = 0; $slnum < @slavenames; $slnum++) {
- my $slave = $slavenames[$slnum];
- if ($slavepath{$preferred, $slnum} ne '') {
- checked_alternative($slave, $slavelinks[$slnum],
- $slavepath{$preferred, $slnum});
- checked_symlink($slavepath{$preferred, $slnum},
- "$altdir/$slave.dpkg-tmp");
- checked_mv("$altdir/$slave.dpkg-tmp", "$altdir/$slave");
- } else {
- pr(sprintf(_g("Removing %s (%s), not appropriate with %s."), $slave,
- $slavelinks[$slnum], $versions[$preferred]))
- if $verbosemode > 0;
- checked_rm("$altdir/$slave");
- checked_rm($slavelinks[$slnum]);
- }
- }
+sub checked_symlink {
+ my ($filename, $linkname) = @_;
+ symlink($filename, $linkname) ||
+ quit(_g("unable to make %s a symlink to %s: %s"), $linkname,
$filename, $!);
}
-sub check_many_actions()
-{
- return unless $action;
- badusage(sprintf(_g("two commands specified: %s and --%s"), $_, $action));
+sub checked_mv {
+ my ($source, $dest) = @_;
+ rename_mv($source, $dest) ||
+ quit(_g("unable to install %s as %s: %s"), $source, $dest, $!);
}
-sub checked_rm($)
-{
+sub checked_rm {
my ($f) = @_;
- unlink($f) || $! == ENOENT ||
- quit(sprintf(_g("unable to remove %s: %s"), $f, $!));
-}
-
-#
-# Main program
-#
-
-$| = 1;
-
-while (@ARGV) {
- $_= shift(@ARGV);
- last if m/^--$/;
- if (!m/^--/) {
- quit(sprintf(_g("unknown argument \`%s'"), $_));
- } elsif (m/^--help$/) {
- usage();
- exit(0);
- } elsif (m/^--version$/) {
- version();
- exit(0);
- } elsif (m/^--verbose$/) {
- $verbosemode= +1;
- } elsif (m/^--quiet$/) {
- $verbosemode= -1;
- } elsif (m/^--install$/) {
- check_many_actions();
- @ARGV >= 4 || badusage(_g("--install needs <link> <name> <path>
<priority>"));
- ($alink,$name,$apath,$apriority,@ARGV) = @ARGV;
- $apriority =~ m/^[-+]?\d+/ || badusage(_g("priority must be an
integer"));
- $action = 'install';
- } elsif (m/^--(remove|set)$/) {
- check_many_actions();
- @ARGV >= 2 || badusage(sprintf(_g("--%s needs <name> <path>"), $1));
- ($name,$apath,@ARGV) = @ARGV;
- $action = $1;
- } elsif (m/^--(display|query|auto|config|list|remove-all)$/) {
- check_many_actions();
- @ARGV || badusage(sprintf(_g("--%s needs <name>"), $1));
- $action = $1;
- $name= shift(@ARGV);
- } elsif (m/^--slave$/) {
- @ARGV >= 3 || badusage(_g("--slave needs <link> <name> <path>"));
- ($slink,$sname,$spath,@ARGV) = @ARGV;
- defined($aslavelink{$sname}) && badusage(sprintf(_g("slave name %s
duplicated"), $sname));
- $aslavelinkcount{$slink}++ && badusage(sprintf(_g("slave link %s
duplicated"), $slink));
- $aslavelink{$sname}= $slink;
- $aslavepath{$sname}= $spath;
- } elsif (m/^--altdir$/) {
- @ARGV || badusage(sprintf(_g("--%s needs a <directory> argument"),
"altdir"));
- $altdir= shift(@ARGV);
- } elsif (m/^--admindir$/) {
- @ARGV || badusage(sprintf(_g("--%s needs a <directory> argument"),
"admindir"));
- $admindir= shift(@ARGV);
- } elsif (m/^--skip-auto$/) {
- $skip = '--skip-auto';
- } elsif (m/^--all$/) {
- $action = 'all';
- } else {
- badusage(sprintf(_g("unknown option \`%s'"), $_));
- }
+ unlink($f) || $! == ENOENT || quit(_g("unable to remove %s: %s"), $f, $!);
}
-defined($name) && defined($aslavelink{$name}) &&
- badusage(sprintf(_g("name %s is both primary and slave"), $name));
-defined($alink) && $aslavelinkcount{$alink} &&
- badusage(sprintf(_g("link %s is both primary and slave"), $alink));
+### OBJECTS ####
-$action ||
- badusage(_g("need --display, --query, --config, --set, --install, --remove,
--all, --remove-all or --auto"));
-$action eq 'install' || !%aslavelink ||
- badusage(_g("--slave only allowed with --install"));
+package FileSet;
-if ($action eq 'all') {
- config_all();
- exit 0;
-}
+use Dpkg::Gettext;
-if (read_link_group()) {
- if ($action eq 'remove') {
- # FIXME: Be consistent for now with the case when we try to remove a
- # non-existing path from an existing link group file.
- exit 0;
- } elsif ($action ne 'install') {
- pr(sprintf(_g("No alternatives for %s."), $name));
- exit 1;
- }
+sub new {
+ my ($class, $master_file, $prio) = @_;
+ my $self = {
+ "master_file" => $master_file,
+ "priority" => $prio,
+ "slaves" =>
+ {
+ # "slave_name" => "slave_file"
+ },
+ };
+ return bless $self, $class;
}
-
-if ($action eq 'display') {
- find_best_version();
- display_link_group();
- exit 0;
+sub add_slave {
+ my ($self, $name, $file) = @_;
+ $self->{slaves}{$name} = $file;
}
-
-if ($action eq 'query') {
- find_best_version();
- query_link_group();
- exit 0;
+sub has_slave {
+ my ($self, $slave) = @_;
+ return (exists $self->{"slaves"}{$slave} and $self->{"slaves"}{$slave});
}
-
-if ($action eq 'list') {
- list_link_group();
- exit 0;
+sub master {
+ my ($self, $val) = @_;
+ return $self->{"master_file"};
}
-
-find_best_version();
-
-if ($action eq 'config') {
- config_alternatives($name);
+sub priority {
+ my ($self) = @_;
+ return $self->{"priority"};
}
-
-if ($action eq 'set') {
- set_alternatives($name);
+sub slave {
+ my ($self, $slave) = @_;
+ return $self->{"slaves"}{$slave};
}
-if (defined($linkname= readlink("$altdir/$name"))) {
- if ($linkname eq $best) {
- $state= 'expected';
- } elsif (defined(readlink("$altdir/$name.dpkg-tmp"))) {
- $state= 'expected-inprogress';
- } else {
- if (-e $linkname) {
- $state = 'unexpected';
- } else {
- $state = 'nonexistent';
- }
- }
-} elsif ($! == ENOENT) {
- $state= 'nonexistent';
-} else {
- $state= 'unexpected';
-}
+package Alternative;
-# Possible values for:
-# $mode manual, auto
-# $state expected, expected-inprogress, unexpected, nonexistent
-# $action auto, install, remove, remove-all
-# all independent
+use Dpkg::Gettext;
-if (($action eq 'auto') || ($state eq 'nonexistent')) {
- pr(sprintf(_g("Setting up automatic selection of %s."), $name))
- if $verbosemode > 0;
- checked_rm("$altdir/$name.dpkg-tmp");
- checked_rm("$altdir/$name");
- $state= 'nonexistent';
- $mode = 'auto';
+sub pr { main::pr(@_) }
+sub quit { main::quit(@_) }
+
+sub new {
+ my ($class, $name) = @_;
+ my $self = {};
+ bless $self, $class;
+ $self->reset($name);
+ return $self;
+}
+sub reset {
+ my ($self, $name) = @_;
+ my $new = {
+ "master_name" => $name,
+ "master_link" => undef,
+ "status" => undef,
+ "slaves" => {
+ # "slave_name" => "slave_link"
+ },
+ "choices" => {
+ # "master_file" => $fileset
+ },
+ "modified" => 0,
+ "commit_ops" => [],
+ };
+ %$self = %$new;
+}
+sub choices {
+ my ($self) = @_;
+ my @choices = sort { $a cmp $b } keys %{$self->{choices}};
+ return wantarray ? @choices : scalar(@choices);
+}
+sub slaves {
+ my ($self) = @_;
+ my @slaves = sort { $a cmp $b } keys %{$self->{slaves}};
+ return wantarray ? @slaves : scalar(@slaves);
+}
+sub name {
+ my ($self) = @_;
+ return $self->{master_name};
+}
+sub link {
+ my ($self) = @_;
+ return $self->{master_link};
+}
+sub status {
+ my ($self) = @_;
+ return $self->{status};
+}
+sub fileset {
+ my ($self, $id) = @_;
+ return $self->{choices}{$id} if exists $self->{choices}{$id};
+ return undef;
+}
+sub slave_link {
+ my ($self, $id) = @_;
+ return $self->{slaves}{$id} if exists $self->{slaves}{$id};
+ return undef;
+}
+sub has_slave {
+ my ($self, $slave) = @_;
+ return (exists $self->{"slaves"}{$slave} and $self->{"slaves"}{$slave});
+}
+sub is_modified {
+ my ($self) = @_;
+ return $self->{modified};
+}
+sub has_choice {
+ my ($self, $id) = @_;
+ return exists $self->{choices}{$id};
+}
+sub add_choice {
+ my ($self, $fileset) = @_;
+ $self->{choices}{$fileset->master()} = $fileset;
+ $self->{modified} = 1; # XXX: be smarter in detecting change ?
+}
+sub add_slave {
+ my ($self, $slave, $link) = @_;
+ $self->{slaves}{$slave} = $link;
+}
+sub set_status {
+ my ($self, $status) = @_;
+ if (!defined($self->status()) or $status ne $self->status()) {
+ $self->{modified} = 1;
+ }
+ $self->{status} = $status;
+}
+sub set_link {
+ my ($self, $link) = @_;
+ if (!defined($self->link()) or $link ne $self->link()) {
+ $self->{modified} = 1;
+ }
+ $self->{master_link} = $link;
+}
+sub remove_choice {
+ my ($self, $id) = @_;
+ if ($self->has_choice($id)) {
+ delete $self->{choices}{$id};
+ $self->{modified} = 1;
+ return 1;
+ }
+ return 0;
}
-# $mode manual, auto
-# $state expected, expected-inprogress, unexpected, nonexistent
-# $action auto, install, remove
-# action=auto <=> state=nonexistent
-
-if ($state eq 'unexpected' && $mode eq 'auto') {
- pr(sprintf(_g("%s has been changed (manually or by a script).\n" .
- "Switching to manual updates only."), "$altdir/$name"))
- if $verbosemode >= 0;
- $mode = 'manual';
-}
-
-# $mode manual, auto
-# $state expected, expected-inprogress, unexpected, nonexistent
-# $action auto, install, remove
-# action=auto <=> state=nonexistent
-# state=unexpected => mode=manual
-
-pr(sprintf(_g("Checking available versions of %s, updating links in %s ..."),
- $name, $altdir))
- if $verbosemode > 0;
-
-if ($action eq 'install') {
- if (defined($link) && $link ne $alink) {
- pr(sprintf(_g("Renaming %s link from %s to %s."), $name, $link,
$alink))
- if $verbosemode > 0;
- rename_mv($link, $alink, 1) ||
- quit(sprintf(_g("unable to rename %s to %s: see error above"),
$link, $alink));
- }
- $link= $alink;
- my $i;
- if (!defined($i= $versionnum{$apath})) {
- push(@versions,$apath);
- $versionnum{$apath}= $i= $#versions;
- }
- $priorities[$i]= $apriority;
- for $sname (keys %aslavelink) {
- my $j;
- if (!defined($j= $slavenum{$sname})) {
- push(@slavenames,$sname);
- $slavenum{$sname}= $j= $#slavenames;
- }
- my $oldslavelink = $slavelinks[$j];
- my $newslavelink = $aslavelink{$sname};
- $slavelinkcount{$oldslavelink}-- if defined($oldslavelink);
- $slavelinkcount{$newslavelink}++ &&
- quit(sprintf(_g("slave link name %s duplicated"), $newslavelink));
- if (defined($oldslavelink) && $newslavelink ne $oldslavelink) {
- pr(sprintf(_g("Renaming %s slave link from %s to %s."), $sname,
$oldslavelink, $newslavelink))
- if $verbosemode > 0;
- rename_mv($oldslavelink, $newslavelink, 1) ||
- quit(sprintf(_g("unable to rename %s to %s: see error above"),
$oldslavelink, $newslavelink));
+{
+ # Helper functions for load() and save()
+ my ($fh, $filename);
+ sub config_helper {
+ ($fh, $filename) = @_;
+ }
+ sub gl {
+ undef $!;
+ my $line = <$fh>;
+ unless (defined($line)) {
+ quit(_g("error while reading %s: %s"), $filename, $!) if $!;
+ quit(_g("unexpected end of file in %s while trying to read %s"),
+ $filename, $_[0]);
}
- $slavelinks[$j]= $newslavelink;
+ chomp($line);
+ return $line;
}
- for (my $j = 0; $j <= $#slavenames; $j++) {
- $slavepath{$i,$j}= $aslavepath{$slavenames[$j]};
+ sub badfmt {
+ quit(_g("internal error: %s corrupt: %s"), $filename, sprintf(@_));
}
-
- fill_missing_slavepaths();
-
- if (($mode eq "manual") and defined($linkname) and ($linkname eq $apath)) {
- # Recreate links to fix any links gone missing
- set_alternatives(1); # quiet
+ sub paf {
+ my $line = shift @_;
+ if ($line =~ m/\n/) {
+ quit(_g("newlines prohibited in update-alternatives files (%s)"),
$line);
+ }
+ print $fh "$line\n" || quit(_g("error writing %s: %s"), $filename, $!);
+ }
+}
+
+sub load {
+ my ($self, $file, $must_not_die) = @_;
+ return 0 unless -s $file;
+ eval {
+ open(my $fh, "<", $file) || quit(_g(""), $file, $!);
+ config_helper($fh, $file);
+ my $status = gl(_g("status"));
+ badfmt(_g("invalid status")) unless $status =~ /^(?:auto|manual)$/;
+ my $link = gl("link");
+ my (%slaves, @slaves);
+ while ((my $slave_name = gl(_g("slave name"))) ne '') {
+ my $slave_link = gl(_g("slave link"));
+ badfmt(_g("duplicate slave %s"), $slave_name)
+ if exists $slaves{$slave_name};
+ badfmt(_g("slave link same as main link %s"), $link)
+ if $slave_link eq $link;
+ badfmt(_g("duplicate slave link %s"), $slave_link)
+ if grep { $_ eq $slave_link } values %slaves;
+ $slaves{$slave_name} = $slave_link;
+ push @slaves, $slave_name;
+ }
+ my @filesets;
+ my $modified = 0;
+ while ((my $main_file = gl(_g("master file"))) ne '') {
+ badfmt(_g("duplicate path %s"), $main_file)
+ if grep { $_->{master_file} eq $main_file } @filesets;
+ if (-e $main_file) {
+ my $priority = gl(_g("priority"));
+ badfmt(_g("priority of %s: %s"), $main_file, $priority)
+ unless $priority =~ m/^[-+]?\d+$/;
+ my $group = FileSet->new($main_file, $priority);
+ foreach my $slave (@slaves) {
+ $group->add_slave($slave, gl(_g("slave file")));
+ }
+ push @filesets, $group;
+ } else {
+ # File not found - remove
+ pr(_g("Alternative for %s points to %s - which wasn't found.
Removing from list of alternatives."),
+ $alternative->name(), $main_file) if $verbosemode > 0;
+ gl(_g("priority"));
+ foreach my $slave (@slaves) {
+ gl(_g("slave file"));
+ }
+ $modified = 1;
+ }
+ }
+ close($fh);
+ # We parsed the file without trouble, load data into the object
+ $self->{master_link} = $link;
+ $self->{slaves} = \%slaves;
+ $self->{status} = $status;
+ $self->{modified} = $modified;
+ $self->{choices} = {};
+ foreach my $group (@filesets) {
+ $self->{choices}{$group->master()} = $group;
+ }
+ };
+ if ($@) {
+ return 0 if $must_not_die;
+ die $@;
}
+ return 1;
}
-if ($action eq 'remove') {
- my $hits = 0;
- if ($mode eq "manual" and $state ne "expected" and (map { $hits += $apath
eq $_ } @versions) and $hits and $linkname eq $apath) {
- pr(_g("Removing manually selected alternative - switching to auto
mode"));
- $mode = "auto";
+sub save {
+ my ($self, $file) = @_;
+ # Cleanup unused slaves before writing admin file
+ foreach my $slave ($self->slaves()) {
+ my $has_slave = 0;
+ foreach my $choice ($self->choices()) {
+ my $fileset = $self->fileset($choice);
+ $has_slave++ if $fileset->has_slave($slave);
+ }
+ unless ($has_slave) {
+ pr(_g("Discarding obsolete slave link %s (%s)."),
+ $slave, $self->slave_link($slave))
+ if $verbosemode > 0;
+ delete $self->{"slaves"}{$slave};
+ }
}
- if (defined(my $i = $versionnum{$apath})) {
- my $k = $#versions;
- $versionnum{$versions[$k]}= $i;
- delete $versionnum{$versions[$i]};
- $versions[$i]= $versions[$k]; $#versions--;
- $priorities[$i]= $priorities[$k]; $#priorities--;
- for (my $j = 0; $j <= $#slavenames; $j++) {
- $slavepath{$i,$j}= $slavepath{$k,$j};
- delete $slavepath{$k,$j};
+ # Write admin file
+ open(my $fh, ">", $file) || quit(_g("unable to write %s: %s"), $file, $!);
+ config_helper($fh, $file);
+ paf($self->status());
+ paf($self->link());
+ foreach my $slave ($self->slaves()) {
+ paf($slave);
+ paf($self->slave_link($slave));
+ }
+ paf('');
+ foreach my $choice ($self->choices()) {
+ paf($choice);
+ my $fileset = $self->fileset($choice);
+ paf($fileset->priority());
+ foreach my $slave ($self->slaves()) {
+ if ($fileset->has_slave($slave)) {
+ paf($fileset->slave($slave));
+ } else {
+ paf('');
+ }
}
- } else {
- pr(sprintf(_g("Alternative %s for %s not registered, not removing."),
$apath, $name))
- if $verbosemode > 0;
}
+ paf('');
+ close($fh) || quit(_g("unable to close %s: %s"), $file, $!);
}
-if ($action eq 'remove-all') {
- $mode = "auto";
- my $k = $#versions;
- for (my $i = 0; $i <= $#versions; $i++) {
- $k--;
- delete $versionnum{$versions[$i]};
- $#priorities--;
- for (my $j = 0; $j <= $#slavenames; $j++) {
- $slavepath{$i,$j}= $slavepath{$k,$j};
- delete $slavepath{$k,$j};
- }
+sub display_query {
+ my ($self) = @_;
+ pr("Link: %s", $self->name());
+ pr("Status: %s", $self->status());
+ my $best = $self->best();
+ if (defined($best)) {
+ pr("Best: %s", $best);
}
- $#versions=$k;
-}
-
-for (my $j = 0; $j <= $#slavenames; $j++) {
- my $i;
- for ($i = 0; $i <= $#versions; $i++) {
- last if $slavepath{$i,$j} ne '';
- }
- if ($i > $#versions) {
- pr(sprintf(_g("Discarding obsolete slave link %s (%s)."),
$slavenames[$j], $slavelinks[$j]))
- if $verbosemode > 0;
- checked_rm("$altdir/$slavenames[$j]");
- checked_rm($slavelinks[$j]);
- my $k = $#slavenames;
- $slavenum{$slavenames[$k]}= $j;
- delete $slavenum{$slavenames[$j]};
- $slavelinkcount{$slavelinks[$j]}--;
- $slavenames[$j]= $slavenames[$k]; $#slavenames--;
- $slavelinks[$j]= $slavelinks[$k]; $#slavelinks--;
- for (my $i = 0; $i <= $#versions; $i++) {
- $slavepath{$i,$j}= $slavepath{$i,$k};
- delete $slavepath{$i,$k};
- }
- $j--;
+ if ($self->has_current_link()) {
+ pr("Value: %s", $self->current());
+ } else {
+ pr("Value: none");
}
-}
-
-if ($mode eq 'manual') {
- pr(sprintf(_g("Automatic updates of %s are disabled, leaving it alone."),
"$altdir/$name"))
- if $verbosemode > 0;
- pr(sprintf(_g("To return to automatic updates use \`update-alternatives
--auto %s'."), $name))
- if $verbosemode > 0;
-} else {
- if ($state eq 'expected-inprogress') {
- pr(sprintf(_g("Recovering from previous failed update of %s ..."),
$name));
- checked_mv("$altdir/$name.dpkg-tmp", "$altdir/$name");
- $state= 'expected';
- }
-}
-
-# $mode manual, auto
-# $state expected, expected-inprogress, unexpected, nonexistent
-# $action auto, install, remove
-# action=auto <=> state=nonexistent
-# state=unexpected => mode=manual
-# mode=auto => state!=expected-inprogress && state!=unexpected
-
-open(AF,">$admindir/$name.dpkg-new") ||
- quit(sprintf(_g("unable to open %s for write: %s"),
"$admindir/$name.dpkg-new", $!));
-paf($mode);
-paf($link);
-for (my $j = 0; $j <= $#slavenames; $j++) {
- paf($slavenames[$j]);
- paf($slavelinks[$j]);
-}
-
-find_best_version();
-
-paf('');
-for (my $i = 0; $i <= $#versions; $i++) {
- paf($versions[$i]);
- paf($priorities[$i]);
- for (my $j = 0; $j <= $#slavenames; $j++) {
- paf($slavepath{$i,$j});
- }
-}
-paf('');
-close(AF) || quit(sprintf(_g("unable to close %s: %s"),
"$admindir/$name.dpkg-new", $!));
-
-# Purge alternative when nothing left
-if ($best eq '') {
- pr(sprintf(_g("Last package providing %s (%s) removed, deleting it."),
$name, $link))
- if $verbosemode > 0;
- checked_rm("$altdir/$name");
- checked_rm("$link");
- checked_rm("$admindir/$name.dpkg-new");
- checked_rm("$admindir/$name");
- exit(0);
-}
-
-if ($mode eq 'auto') {
- checked_alternative($name, $link, $best);
- checked_rm("$altdir/$name.dpkg-tmp");
- checked_symlink($best, "$altdir/$name.dpkg-tmp");
-}
-
-checked_mv("$admindir/$name.dpkg-new", "$admindir/$name");
-
-if ($mode eq 'auto') {
- checked_mv("$altdir/$name.dpkg-tmp", "$altdir/$name");
- for (my $j = 0; $j <= $#slavenames; $j++) {
- $sname= $slavenames[$j];
- $slink= $slavelinks[$j];
- $spath= $slavepath{$bestnum,$j};
- checked_rm("$altdir/$sname.dpkg-tmp");
- if ($spath eq '') {
- pr(sprintf(_g("Removing %s (%s), not appropriate with %s."),
$sname, $slink, $best))
- if $verbosemode > 0;
- checked_rm("$altdir/$sname");
- checked_rm("$slink");
- } else {
- checked_alternative($sname, $slink, $spath);
- checked_symlink("$spath", "$altdir/$sname.dpkg-tmp");
- checked_mv("$altdir/$sname.dpkg-tmp", "$altdir/$sname");
+
+ foreach my $choice ($self->choices()) {
+ pr("");
+ pr("Alternative: %s", $choice);
+ my $fileset = $self->fileset($choice);
+ pr("Priority: %s", $fileset->priority());
+ next unless scalar($self->slaves());
+ pr("Slaves:");
+ foreach my $slave ($self->slaves()) {
+ if ($fileset->has_slave($slave)) {
+ pr(" %s %s", $slave, $fileset->slave($slave));
+ }
}
}
}
-sub config_message {
- if ($#versions < 0) {
- print "\n";
- printf _g("There is no program which provides %s.\n".
- "Nothing to configure.\n"), $name;
- return -1;
- }
- if ($skip && $mode eq 'auto' && $best eq readlink("$altdir/$name")) {
- print "\n";
- display_link_group();
- return -1;
- }
- if ($#versions == 0 && $mode eq 'auto' && $best eq
readlink("$altdir/$name")) {
- print "\n";
- printf _g("There is only 1 program which provides %s properly in auto
mode\n".
- "(%s). Nothing to configure.\n"), $name, $versions[0];
- return -1;
- }
- print STDOUT "\n";
- printf(STDOUT _g("There are %s alternatives which provide \`%s'.\n\n".
- " Selection Alternative\n".
- "-----------------------------------------------\n"),
- $#versions+1, $name);
- printf STDOUT "%s 0 %s (%s)\n",
- ($mode eq "auto" && readlink("$altdir/$name") eq $best) ? '*' : ' ',
- $best, _g("auto mode");
- for (my $i = 0; $i <= $#versions; $i++) {
- printf STDOUT "%s %8s %s (%s) priority=%s\n",
- (readlink("$altdir/$name") eq $versions[$i] && $mode eq "manual") ?
'*' : ' ',
- $i+1, $versions[$i], _g("manual mode"), $priorities[$i];
- }
- printf(STDOUT "\n"._g("Press enter to keep the default[*], or type
selection number: "));
- return 0;
-}
+sub display_user {
+ my ($self) = @_;
+ pr("%s - %s", $self->name(),
+ ($self->status() eq "auto") ? _g("auto mode") : _g("manual mode"));
-sub config_alternatives {
- my $preferred;
- do {
- return if config_message() < 0;
- $preferred=<STDIN>;
- chop($preferred);
- } until $preferred eq '' || $preferred>=0 && $preferred<=$#versions+1 &&
- ($preferred =~ m/[0-9]*/);
- if ($preferred ne '') {
- if ($preferred == 0) {
- $action = "auto";
- $mode = "auto";
- } else {
- $mode = "manual";
- $preferred--;
- my $spath = $versions[$preferred];
-
- set_links($spath, $link, $preferred);
+ if ($self->has_current_link()) {
+ pr(_g(" link currently points to %s"), $self->current());
+ } else {
+ pr(_g(" link currently absent"));
+ }
+ foreach my $choice ($self->choices()) {
+ my $fileset = $self->fileset($choice);
+ pr(_g("%s - priority %s"), $choice, $fileset->priority());
+ foreach my $slave ($self->slaves()) {
+ if ($fileset->has_slave($slave)) {
+ pr(_g(" slave %s: %s"), $slave, $fileset->slave($slave));
+ }
}
}
-}
-sub set_alternatives {
- my ($quiet) = @_;
- $mode = "manual";
- # Get preferred number
- my $preferred = -1;
- for (my $i = 0; $i <= $#versions; $i++) {
- if($versions[$i] eq $apath) {
- $preferred = $i;
- last;
- }
- }
- if ($preferred == -1) {
- quit(sprintf(_g("Cannot find alternative `%s'."), $apath)."\n");
+ my $best = $self->best();
+ if (defined($best) && $best) {
+ pr(_g("Current \`best' version is %s."), $best);
+ } else {
+ pr(_g("No versions available."));
}
- set_links($apath, $link, $preferred, $quiet);
}
-sub pr
-{
- print(STDOUT "@_\n") ||
- quit(sprintf(_g("error writing stdout: %s"), $!));
+sub display_list {
+ my ($self) = @_;
+ pr($_) foreach ($self->choices());
}
-sub paf {
- $_[0] =~ m/\n/ && quit(sprintf(_g("newlines prohibited in
update-alternatives files (%s)"), $_[0]));
- print(AF "$_[0]\n") || quit(sprintf(_g("error writing stdout: %s"), $!));
-}
-sub gl {
- $!=0; $_= <AF>;
- defined($_) || quit(sprintf(_g("error or eof reading %s for %s (%s)"),
- "$admindir/$name", $_[0], $!));
- s/\n$// || badfmt(sprintf(_g("missing newline after %s"), $_[0]));
- $_;
-}
-sub badfmt {
- quit(sprintf(_g("internal error: %s corrupt: %s"), "$admindir/$name",
$_[0]));
-}
-sub rename_mv {
- my ($source, $dest, $ignore_enoent) = @_;
- $ignore_enoent = 0 unless defined($ignore_enoent);
- return 1 if ($ignore_enoent and not -e $source);
- if (not rename($source, $dest)) {
- if (system("mv", $source, $dest) != 0) {
- return $ignore_enoent if $! == ENOENT;
- return 0;
+sub select_choice {
+ my ($self) = @_;
+ while (1) {
+ my $current = $self->current() || "";
+ my $best = $self->best();
+ printf _g("There are %s choices for the alternative %s (providing
%s).") . "\n\n",
+ scalar($self->choices()), $self->name(), $self->link();
+ my $length = 15;
+ foreach ($self->choices()) {
+ $length = (length($_) > $length) ? length($_) + 1 : $length;
+ }
+ printf " %-12.12s %-${length}.${length}s %-10.10s %s\n",
_g("Selection"),
+ _g("Path"), _g("Priority"), _g("Status");
+ print "-" x 60 . "\n";
+ printf "%s %-12d %-${length}s % -10d %s\n",
+ ($self->status() eq "auto" and $current eq $best) ? "*" : " ",
0,
+ $best, $self->fileset($best)->priority(), _g("auto mode");
+ my $index = 1;
+ my %sel = ("0" => $best);
+ foreach my $choice ($self->choices()) {
+ $sel{$index} = $choice;
+ $sel{$choice} = $choice;
+ printf "%s %-12d %-${length}.${length}s % -10d %s\n",
+ ($self->status() eq "manual" and $current eq $choice) ?
"*" : " ",
+ $index, $choice, $self->fileset($choice)->priority(),
+ _g("manual mode");
+ $index++;
+ }
+ print "\n";
+ printf _g("Press enter to keep the current choice[*], or type
selection number: ");
+ my $selection = <STDIN>;
+ return undef unless defined($selection);
+ chomp($selection);
+ return $current if $selection eq "";
+ if (exists $sel{$selection}) {
+ $self->set_status(($selection eq "0") ? "auto" : "manual");
+ return $sel{$selection};
}
}
- return 1;
-}
-sub checked_symlink {
- my ($filename, $linkname) = @_;
- symlink($filename, $linkname) ||
- quit(sprintf(_g("unable to make %s a symlink to %s: %s"), $linkname,
$filename, $!));
-}
-sub checked_mv {
- my ($source, $dest) = @_;
- rename_mv($source, $dest) ||
- quit(sprintf(_g("unable to install %s as %s: %s"), $source, $dest,
$!));
}
-sub config_all {
- opendir ADMINDIR, $admindir or die sprintf(_g("Serious problem: %s"), $!);
- my @filenames = grep !/^\.\.?$/, readdir ADMINDIR;
- close ADMINDIR;
- foreach my $name (@filenames) {
- system "$0 $skip --config $name";
- exit $? if $?;
+
+
+sub best {
+ my ($self) = @_;
+ my @choices = sort { $self->fileset($b)->priority() <=>
+ $self->fileset($a)->priority()
+ } ($self->choices());
+ if (scalar(@choices)) {
+ return $choices[0];
+ } else {
+ return undef;
+ }
+}
+
+sub has_current_link {
+ my ($self) = @_;
+ return -l "$altdir/$self->{master_name}";
+}
+
+sub current {
+ my ($self) = @_;
+ return undef unless $self->has_current_link();
+ my $val = readlink("$altdir/$self->{master_name}");
+ pr(_g("readlink(%s) failed: %s"), "$altdir/$self->{master_name}", $!)
+ unless defined $val;
+ return $val;
+}
+
+sub add_commit_op {
+ my ($self, $sub) = @_;
+ push @{$self->{commit_ops}}, $sub;
+}
+sub prepare_install {
+ my ($self, $choice) = @_;
+ my ($link, $name) = ($self->link(), $self->name());
+ my $fileset = $self->fileset($choice);
+ # Setup main link
+ main::checked_rm("$link.dpkg-tmp");
+ main::checked_symlink("$altdir/$name", "$link.dpkg-tmp");
+ # Setup main alternative link
+ main::checked_rm("$altdir/$name.dpkg-tmp");
+ main::checked_symlink($choice, "$altdir/$name.dpkg-tmp");
+ # Add commit operations
+ $self->add_commit_op(sub {
+ main::checked_mv("$link.dpkg-tmp", $link);
+ main::checked_mv("$altdir/$name.dpkg-tmp", "$altdir/$name");
+ });
+ # Take care of slaves links
+ foreach my $slave ($self->slaves()) {
+ my ($slink, $spath) = ($self->slave_link($slave),
$fileset->slave($slave));
+ if ($fileset->has_slave($slave)) {
+ # Setup slave link
+ main::checked_rm("$slink.dpkg-tmp");
+ main::checked_symlink("$altdir/$slave", "$slink.dpkg-tmp");
+ # Setup slave alternative link
+ main::checked_rm("$altdir/$slave.dpkg-tmp");
+ main::checked_symlink($spath, "$altdir/$slave.dpkg-tmp");
+ # Add commit operations
+ $self->add_commit_op(sub {
+ main::checked_mv("$slink.dpkg-tmp", $slink);
+ main::checked_mv("$altdir/$slave.dpkg-tmp", "$altdir/$slave");
+ });
+ } else {
+ # Drop unused slave
+ $self->add_commit_op(sub {
+ main::checked_rm($slink);
+ main::checked_rm("$altdir/$slave");
+ });
+ }
}
}
-exit(0);
+sub remove {
+ my ($self) = @_;
+ my ($link, $name) = ($self->link(), $self->name());
+ main::checked_rm("$link.dpkg-tmp");
+ main::checked_rm($link);
+ main::checked_rm("$altdir/$name.dpkg-tmp");
+ main::checked_rm("$altdir/$name");
+ foreach my $slave ($self->slaves()) {
+ my $slink = $self->slave_link($slave);
+ main::checked_rm("$slink.dpkg-tmp");
+ main::checked_rm($slink);
+ main::checked_rm("$altdir/$slave.dpkg-tmp");
+ main::checked_rm("$altdir/$slave");
+ }
+ # Drop admin file
+ main::checked_rm("$admdir/$name");
+}
+
+sub commit {
+ my ($self) = @_;
+ foreach my $sub (@{$self->{commit_ops}}) {
+ &$sub();
+ }
+ $self->{commit_ops} = [];
+}
+
+sub is_broken {
+ my ($self) = @_;
+ my $name = $self->name();
+ return 1 if not $self->has_current_link();
+ # Check master link
+ my $file = readlink($self->link());
+ return 1 if not defined($file);
+ return 1 if $file ne "$altdir/$name";
+ # Stop if we have an unmanaged alternative
+ return 0 if not $self->has_choice($self->current());
+ # Check slaves
+ my $fileset = $self->fileset($self->current());
+ foreach my $slave ($self->slaves()) {
+ $file = readlink($self->slave_link($slave));
+ if ($fileset->has_slave($slave)) {
+ return 1 if not defined($file);
+ return 1 if $file ne "$altdir/$slave";
+ $file = readlink("$altdir/$slave");
+ return 1 if not defined($file);
+ return 1 if $file ne $fileset->slave($slave);
+ } else {
+ # Slave link must not exist
+ return 1 if defined($file);
+ $file = readlink("$altdir/$slave");
+ return 1 if defined($file);
+ }
+ }
+ return 0;
+}
# vim: nowrap ts=8 sw=4
--
dpkg's main repository
--
To UNSUBSCRIBE, email to debian-dpkg-cvs-requ...@lists.debian.org
with a subject of "unsubscribe". Trouble? Contact listmas...@lists.debian.org
