update-alternatives

#! /usr/bin/perl --

#use POSIX; &ENOENT;
sub ENOENT { 2; }

# Global variables:
#  $alink            Alternative we are managing (ie the symlink we're making/removing) (install only)
#  $name             Name of the alternative (the symlink) we are processing
#  $apath            Path of alternative we are offering
#  $apriority        Priority of link (only when we are installing an alternative)
#  $mode             action to perform (display / install / remove / display / auto / config)
#  $manual           update-mode for alternative (manual / auto)
#  $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
#  $link             Link we are working with
#  @slavenames       List with names of slavelinks
#  %slavenum         Map from name of slavelink to slave-index (into @slavelinks)
#  @slavelinks       List of slavelinks (indexed by slave-index)
#  %versionnum       Map from currently available versions into @versions and @priorities
#  @versions         List of available versions for alternative
#  %priorities       Map from @version-index to priority
#  %slavepath        Map from (@version-index,slavename) to slave-path

$version="1.8.4"; # This line modified by Makefile
sub usageversion {
    print(STDERR <<END)
The update-alternatives $version.  Copyright (C) 1995 Ian Jackson.
This is free software; see the GNU General Public Licence
version 2 or later for copying conditions.  There is NO warranty.

Usage: update-alternatives --install <link> <name> <path> <priority>
                          [--slave <link> <name> <path>] ...
       update-alternatives --remove <name> <path>
       update-alternatives --auto <name>
       update-alternatives --display <name>
       update-alternatives --config <name> [<path>]
<name> is the name in /etc/alternatives.
<path> is the name referred to.
<link> is the link pointing to /etc/alternatives/<name>.
<priority> is an integer; options with higher numbers are chosen.

Options:  --verbose|--quiet  --test  --help  --version
          --altdir <directory>  --admindir <directory>
END
        || &quit("failed to write usage: $!");
}
sub quit { print STDERR "update-alternatives: @_\n"; exit(2); }
sub badusage { print STDERR "update-alternatives: @_\n\n"; &usageversion; exit(2); }

$altdir= '/etc/alternatives';
$admindir= '/var/lib/alternatives';
$testmode= 0;
$verbosemode= 0;
$mode='';
$manual= 'auto';
$|=1;

sub checkmanymodes {
    return unless $mode;
    &badusage("two modes specified: $_ and --$mode");
}

while (@ARGV) {
    $_= shift(@ARGV);
    last if m/^--$/;
    if (!m/^--/) {
        &quit("unknown argument \`$_'");
    } elsif (m/^--(help|version)$/) {
        &usageversion; exit(0);
    } elsif (m/^--test$/) {
        $testmode= 1;
    } elsif (m/^--verbose$/) {
        $verbosemode= +1;
    } elsif (m/^--quiet$/) {
        $verbosemode= -1;
    } elsif (m/^--install$/) {
        &checkmanymodes;
        @ARGV >= 4 || &badusage("--install needs <link> <name> <path> <priority>");
        ($alink,$name,$apath,$apriority,@ARGV) = @ARGV;
        $apriority =~ m/^[-+]?\d+/ || &badusage("priority must be an integer");
        $mode= 'install';
    } elsif (m/^--remove$/) {
        &checkmanymodes;
        @ARGV >= 2 || &badusage("--remove needs <name> <path>");
        ($name,$apath,@ARGV) = @ARGV;
        $mode= 'remove';
    } elsif (m/^--(display|auto)$/) {
        &checkmanymodes;
        @ARGV || &badusage("--$1 needs <name>");
        $mode= $1;
        $name= shift(@ARGV);
    } elsif (m/^--config$/) {
        &checkmanymodes;
        @ARGV || &badusage("--config needs <name> [<path>]");
        ($name,$apath,@ARGV) = @ARGV;
        $mode= 'config';
    } elsif (m/^--slave$/) {
        @ARGV >= 3 || &badusage("--slave needs <link> <name> <path>");
        ($slink,$sname,$spath,@ARGV) = @ARGV;
        defined($aslavelink{$sname}) && &badusage("slave name $sname duplicated");
        $aslavelinkcount{$slink}++ && &badusage("slave link $slink duplicated");
        $aslavelink{$sname}= $slink;
        $aslavepath{$sname}= $spath;
    } elsif (m/^--altdir$/) {
        @ARGV || &badusage("--altdir needs a <directory> argument");
        $altdir= shift(@ARGV);
    } elsif (m/^--admindir$/) {
        @ARGV || &badusage("--admindir needs a <directory> argument");
        $admindir= shift(@ARGV);
    } else {
        &badusage("unknown option \`$_'");
    }
}

defined($aslavelink{$name}) && &badusage("name $name is both primary and slave");
$aslavelinkcount{$alink} && &badusage("link $link is both primary and slave");

$mode || &badusage("need --display, --config, --install, --remove or --auto");
$mode eq 'install' || !%aslavelink || &badusage("--slave only allowed with --install");

if (open(AF,"$admindir/$name")) {
    $manual= &gl("manflag");
    $manual eq 'auto' || $manual eq 'manual' || &badfmt("manflag");
    $link= &gl("link");
    while (($sname= &gl("sname")) ne '') {
        push(@slavenames,$sname);
        defined($slavenum{$sname}) && &badfmt("duplicate slave $sname");
        $slavenum{$sname}= $#slavenames;
        $slink= &gl("slink");
        $slink eq $link && &badfmt("slave link same as main link $link");
        $slavelinkcount{$slink}++ && &badfmt("duplicate slave link $slink");
        push(@slavelinks,$slink);
    }
    while (($version= &gl("version")) ne '') {
        defined($versionnum{$version}) && &badfmt("duplicate path $version");
       if ( -e $version ) {
           push(@versions,$version);
           $versionnum{$version}= $i= $#versions;
           $priority= &gl("priority");
           $priority =~ m/^[-+]?\d+$/ || &badfmt("priority $version $priority");
           $priorities[$i]= $priority;
           for ($j=0; $j<=$#slavenames; $j++) {
               $slavepath{$i,$j}= &gl("spath");
           }
       } else {
           # File not found - remove
           &pr("Alternative for $name points to $version - which wasn't found.  Removing from list of alternatives.")
             if $verbosemode > 0;
           &gl("priority");
           for ($j=0; $j<=$#slavenames; $j++) {
               &gl("spath");
           }
       }
    }
    close(AF);
    $dataread=1;
} elsif ($! != &ENOENT) {
    &quit("failed to open $admindir/$name: $!");
}

$best= '';
for ($i=0; $i<=$#versions; $i++) {
    if ($best eq '' || $priorities[$i] > $bestpri) {
        $best= $versions[$i]; $bestpri= $priorities[$i];
    }
}

if ($mode eq 'display') {
    if (!$dataread) {
        &quit("No alternatives found for $name.");
    } else {
        &pr("$name - status is $manual.");
        if (defined($linkname= readlink("$altdir/$name"))) {
            &pr(" link currently points to $linkname");
        } elsif ($! == &ENOENT) {
            &pr(" link currently absent");
        } else {
            &pr(" link unreadable - $!");
        }
        for ($i=0; $i<=$#versions; $i++) {
            &pr("$versions[$i] - priority $priorities[$i]");
            for ($j=0; $j<=$#slavenames; $j++) {
                next unless length($tspath= $slavepath{$i,$j});
                &pr(" slave $slavenames[$j]: $tspath");
            }
        }
        if ($best eq '') {
            &pr("No versions available.");
        } else {
            &pr("Current \`best' version is $best.");
        }
    }
    exit 0;
}

if ($mode eq 'config') {
    if (!$dataread) {
    &quit("No alternatives found for $name.");
    } else {
    &config_alternatives($name);
    }
}

if (defined($linkname= readlink("$altdir/$name"))) {
    if ($linkname eq $best) {
        $state= 'expected';
    } elsif (defined(readlink("$altdir/$name.tmp"))) {
        $state= 'expected-inprogress';
    } else {
        $state= 'unexpected';
    }
} elsif ($! == &ENOENT) {
    $state= 'nonexistent';
} else {
    $state= 'unexpected';
}

# Possible values for:
#   $manual      manual, auto
#   $state       expected, expected-inprogress, unexpected, nonexistent
#   $mode        auto, install, remove
# all independent

if ($mode eq 'auto') {
    &pr("Setting up automatic selection of $name.")
      if $verbosemode > 0;
    unlink("$altdir/$name.tmp") || $! == &ENOENT ||
        &quit("unable to remove $altdir/$name.tmp: $!");
    unlink("$altdir/$name") || $! == &ENOENT ||
        &quit("unable to remove $altdir/$name.tmp: $!");
    $state= 'nonexistent';
    $manual= 'auto';
} elsif ($state eq 'nonexistent') {
    if ($manual eq 'manual') {
        &pr("$altdir/$name has been deleted, returning to automatic selection.")
          if $verbosemode > 0;
        $manual= 'auto';
    }
}

#   $manual      manual, auto
#   $state       expected, expected-inprogress, unexpected, nonexistent
#   $mode        auto, install, remove
# mode=auto <=> state=nonexistent

if ($state eq 'unexpected' && $manual eq 'auto') {
    &pr("$altdir/$name has been changed (manually or by a script).\n".
        "Switching to manual updates only.")
      if $verbosemode > 0;
    $manual= 'manual';
}

#   $manual      manual, auto
#   $state       expected, expected-inprogress, unexpected, nonexistent
#   $mode        auto, install, remove
# mode=auto <=> state=nonexistent
# state=unexpected => manual=manual

&pr("Checking available versions of $name, updating links in $altdir ...\n".
    "(You may modify the symlinks there yourself if desired - see \`man ln'.)")
  if $verbosemode > 0;

if ($mode eq 'install') {
    if ($link ne $alink && $link ne '') {
        &pr("Renaming $name link from $link to $alink.")
          if $verbosemode > 0;
        &rename_mv($link,$alink) || $! == &ENOENT ||
            &quit("unable to rename $link to $alink: $!");
    }
    $link= $alink;
    if (!defined($i= $versionnum{$apath})) {
        push(@versions,$apath);
        $versionnum{$apath}= $i= $#versions;
    }
    $priorities[$i]= $apriority;
    for $sname (keys %aslavelink) {
        if (!defined($j= $slavenum{$sname})) {
            push(@slavenames,$sname);
            $slavenum{$sname}= $j= $#slavenames;
        }
        $oldslavelink= $slavelinks[$j];
        $newslavelink= $aslavelink{$sname};
        $slavelinkcount{$oldslavelink}-- if $oldslavelink ne '';
        $slavelinkcount{$newslavelink}++ &&
            &quit("slave link name $newslavelink duplicated");
        if ($newslavelink ne $oldslavelink && $oldslavelink ne '') {
            &pr("Renaming $sname slave link from $oldslavelink to $newslavelink.")
              if $verbosemode > 0;
            &rename_mv($oldslavelink,$newslavelink) || $! == &ENOENT ||
                &quit("unable to rename $oldslavelink to $newslavelink: $!");
        }
        $slavelinks[$j]= $newslavelink;
    }
    for ($j=0; $j<=$#slavenames; $j++) {
        $slavepath{$i,$j}= $aslavepath{$slavenames[$j]};
    }
}

if ($mode eq 'remove') {
    if ($manual eq "manual" and $state eq "expected") {
        &pr("Removing manually selected alternative - switching to auto mode");
    $manual= "auto";
    }
    if (defined($i= $versionnum{$apath})) {
        $k= $#versions;
        $versionnum{$versions[$k]}= $i;
        delete $versionnum{$versions[$i]};
        $versions[$i]= $versions[$k]; $#versions--;
        $priorities[$i]= $priorities[$k]; $#priorities--;
        for ($j=0; $j<=$#slavenames; $j++) {
            $slavepath{$i,$j}= $slavepath{$k,$j};
            delete $slavepath{$k,$j};
        }
    } else {
        &pr("Alternative $apath for $name not registered, not removing.")
          if $verbosemode > 0;
    }
}

for ($j=0; $j<=$#slavenames; $j++) {
    for ($i=0; $i<=$#versions; $i++) {
        last if $slavepath{$i,$j} ne '';
    }
    if ($i > $#versions) {
        &pr("Discarding obsolete slave link $slavenames[$j] ($slavelinks[$j]).")
          if $verbosemode > 0;
        unlink("$altdir/$slavenames[$j]") || $! == &ENOENT ||
            &quit("unable to remove $slavenames[$j]: $!");
        unlink($slavelinks[$j]) || $! == &ENOENT ||
            &quit("unable to remove $slavelinks[$j]: $!");
        $k= $#slavenames;
        $slavenum{$slavenames[$k]}= $j;
        delete $slavenum{$slavenames[$j]};
        $slavelinkcount{$slavelinks[$j]}--;
        $slavenames[$j]= $slavenames[$k]; $#slavenames--;
        $slavelinks[$j]= $slavelinks[$k]; $#slavelinks--;
        for ($i=0; $i<=$#versions; $i++) {
            $slavepath{$i,$j}= $slavepath{$i,$k};
            delete $slavepath{$i,$k};
        }
        $j--;
    }
}

if ($manual eq 'manual') {
    &pr("Automatic updates of $altdir/$name are disabled, leaving it alone.")
      if $verbosemode > 0;
    &pr("To return to automatic updates use \`update-alternatives --auto $name'.")
      if $verbosemode > 0;
} else {
    if ($state eq 'expected-inprogress') {
        &pr("Recovering from previous failed update of $name ...");
        rename("$altdir/$name.tmp","$altdir/$name") ||
            &quit("unable to rename $altdir/$name.tmp to $altdir/$name: $!");
        $state= 'expected';
    }
}

#   $manual      manual, auto
#   $state       expected, expected-inprogress, unexpected, nonexistent
#   $mode        auto, install, remove
# mode=auto <=> state=nonexistent
# state=unexpected => manual=manual
# manual=auto => state!=expected-inprogress && state!=unexpected

open(AF,">$admindir/$name.new") ||
    &quit("unable to open $admindir/$name.new for write: $!");
&paf($manual);
&paf($link);
for ($j=0; $j<=$#slavenames; $j++) {
    &paf($slavenames[$j]);
    &paf($slavelinks[$j]);
}
&paf('');
$best= '';
for ($i=0; $i<=$#versions; $i++) {
    if ($best eq '' || $priorities[$i] > $bestpri) {
        $best= $versions[$i]; $bestpri= $priorities[$i]; $bestnum= $i;
    }
    &paf($versions[$i]);
    &paf($priorities[$i]);
    for ($j=0; $j<=$#slavenames; $j++) {
        &paf($slavepath{$i,$j});
    }
}
&paf('');
close(AF) || &quit("unable to close $admindir/$name.new: $!");

if ($manual eq 'auto') {
    if ($best eq '') {
        &pr("Last package providing $name ($link) removed, deleting it.")
          if $verbosemode > 0;
        unlink("$altdir/$name") || $! == &ENOENT ||
            &quit("unable to remove $altdir/$name: $!");
        unlink("$link") || $! == &ENOENT ||
            &quit("unable to remove $altdir/$name: $!");
        unlink("$admindir/$name.new") ||
            &quit("unable to remove $admindir/$name.new: $!");
        unlink("$admindir/$name") || $! == &ENOENT ||
            &quit("unable to remove $admindir/$name: $!");
        exit(0);
    } else {
        if (!defined($linkname= readlink($link)) && $! != &ENOENT) {
            &pr("warning: $link is supposed to be a symlink to $altdir/$name\n".
                " (or nonexistent); however, readlink failed: $!")
              if $verbosemode > 0;
        } elsif ($linkname ne "$altdir/$name") {
            &tmped_symlink("$altdir/$name",$link);
        }
        if (defined($linkname= readlink("$altdir/$name")) && $linkname eq $best) {
            &pr("Leaving $name ($link) pointing to $best.")
              if $verbosemode > 0;
        } else {
            &pr("Updating $name ($link) to point to $best.")
              if $verbosemode > 0;
        }
        &checked_symlink($best,"$altdir/$name.tmp");
    }
}

rename("$admindir/$name.new","$admindir/$name") ||
    &quit("unable to rename $admindir/$name.new to $admindir/$name: $!");

if ($manual eq 'auto') {
    &checked_mv("$altdir/$name.tmp","$altdir/$name");
    for ($j=0; $j<=$#slavenames; $j++) {
        $sname= $slavenames[$j];
        $slink= $slavelinks[$j];
        if (!defined($linkname= readlink($slink)) && $! != &ENOENT) {
            &pr("warning: $slink is supposed to be a slave symlink to\n".
                " $altdir/$sname, or nonexistent; however, readlink failed: $!")
              if $verbosemode > 0;
        } elsif ($linkname ne "$altdir/$sname") {
            &tmped_symlink("$altdir/$sname",$slink);
        }
        $spath= $slavepath{$bestnum,$j};
        unlink("$altdir/$sname.tmp") || $! == &ENOENT ||
            &quit("unable to ensure $altdir/$sname.tmp nonexistent: $!");
        if ($spath eq '') {
            &pr("Removing $sname ($slink), not appropriate with $best.")
              if $verbosemode > 0;
            unlink("$altdir/$sname") || $! == &ENOENT ||
                &quit("unable to remove $altdir/$sname: $!");
        unlink("$slink") || $! == &ENOENT ||
            &quit("unable to remove $slink: $!");
        } else {
            if (defined($linkname= readlink("$altdir/$sname")) && $linkname eq $spath) {
                &pr("Leaving $sname ($slink) pointing to $spath.")
                  if $verbosemode > 0;
            } else {
                &pr("Updating $sname ($slink) to point to $spath.")
                  if $verbosemode > 0;
            }
            &tmped_symlink("$spath","$altdir/$sname");
        }
    }
}

sub config_message {
    if ($#versions == 0) {
    &pr("\nThere is only 1 program which provides $name");
    &pr("($versions[0]). Nothing to configure.");
    exit(0);
    }
    printf(STDOUT "\nThere are %s programs which provide \`$name'.\n\n", $#versions+1);
    printf(STDOUT "  Selection    Command\n");
    printf(STDOUT "-----------------------------------------------\n");
    for ($i=0; $i<=$#versions; $i++) {
    printf(STDOUT "%s%s    %s        %s\n",
        (readlink("$altdir/$name") eq $versions[$i]) ? '*' : ' ',
        ($best eq $versions[$i]) ? '+' : ' ',
        $i+1, $versions[$i]);
    }
    printf(STDOUT "\nEnter to keep the default[*], or type selection number: ");
}

sub config_alternative {
    my ($preferred) = @_;
    $manual = "manual";
    &pr("Using \`$versions[$preferred]' to provide \`$name'.");
    my $spath = $versions[$preferred];
    &tmped_symlink("$spath","$altdir/$name");
    #Link slaves...
    for( my $slnum = 0; $slnum < @slavenames; $slnum++ ) {
    my $slave = $slavenames[$slnum];
    if ($slavepath{$preferred,$slnum} ne '') {
        &tmped_symlink($slavepath{$preferred,$slnum}, "$altdir/$slave");
    } else {
        &pr("Removing $slave ($slavelinks[$slnum]), not appropriate with $versions[$preferred].")
        if $verbosemode > 0;
        unlink("$altdir/$slave") || $! == &ENOENT ||
        &quit("unable to remove $altdir/$slave: $!");
    }
    }
    exit(0);
}

sub config_alternatives {
    if (defined($apath)) {
    if (defined($i= $versionnum{$apath})) {
        &config_alternative($i);
    } else {
        &quit("Alternative $apath for $name not registered.");
    }
    }
    do {
    &config_message;
    $preferred=<STDIN>;
    chop($preferred);
    } until $preferred eq '' || $preferred>=1 && $preferred<=$#versions+1 &&
    ($preferred =~ m/[0-9]*/);
    if ($preferred ne '') {
    $preferred--;
        &config_alternative($preferred);
    } else {
    &quit("Nothing selected.");
    }
}

sub pr { print(STDOUT "@_\n") || &quit("error writing stdout: $!"); }
sub paf {
    $_[0] =~ m/\n/ && &quit("newlines prohibited in update-alternatives files ($_[0])");
    print(AF "$_[0]\n") || &quit("error writing stdout: $!");
}
sub gl {
    $!=0; $_= <AF>;
    length($_) || &quit("error or eof reading $admindir/$name for $_[0] ($!)");
    s/\n$// || &badfmt("missing newline after $_[0]");
    $_;
}
sub badfmt {
    &quit("internal error: $admindir/$name corrupt: $_[0]");
}
sub rename_mv {
    return (rename($_[0], $_[1]) || (system(("mv", $_[0], $_[1])) == 0));
}
sub checked_symlink {
    my ($filename, $linkname) = @_;
    unlink($linkname) || $! == &ENOENT ||
    &quit("unable to ensure $linkname nonexistent: $!");
    symlink($filename,$linkname) ||
    &quit("unable to symlink $linkname to $filename: $!");
}
sub checked_mv {
    my ($source, $dest) = @_;
    &rename_mv($source, $dest) ||
    &quit("unable to install $source as $dest: $!");
}
sub tmped_symlink {
    my ($filename, $linkname) = @_;
    my $tmplink = "$linkname.tmp";

    &checked_symlink($filename,$tmplink);
    &checked_mv($tmplink,$linkname);
}

exit(0);