chiark - git - mdw - dpkg/blob - utils/t/update_alternatives.t

   1 #!/usr/bin/perl
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 use strict;
  17 use warnings;
  18
  19 use Test::More;
  20
  21 use File::Spec;
  22
  23 use Dpkg::IPC;
  24 use Dpkg::Path qw(find_command);
  25
  26 my $srcdir = $ENV{srcdir} || '.';
  27 my $tmpdir = 't.tmp/update_alternatives';
  28 my $admindir = File::Spec->rel2abs("$tmpdir/admindir"),
  29 my $altdir = File::Spec->rel2abs("$tmpdir/alternatives");
  30 my $bindir = File::Spec->rel2abs("$tmpdir/bin");
  31 my @ua = ("$ENV{builddir}/update-alternatives", '--log', '/dev/null',
  32           '--quiet', '--admindir', "$admindir", '--altdir', "$altdir");
  33
  34 my %paths = (
  35     true => find_command('true'),
  36     false => find_command('false'),
  37     yes => find_command('yes'),
  38     cat => find_command('cat'),
  39     date => find_command('date'),
  40     sleep => find_command('sleep'),
  41 );
  42
  43 if (! -x "$ENV{builddir}/update-alternatives") {
  44     plan skip_all => 'update-alternatives not available';
  45     exit(0);
  46 }
  47
  48 my $main_link = "$bindir/generic-test";
  49 my $main_name = 'generic-test';
  50 my @choices = (
  51     {
  52         path => $paths{true},
  53         priority => 20,
  54         slaves => [
  55             {
  56                 link => "$bindir/slave2",
  57                 name => 'slave2',
  58                 path => $paths{cat},
  59             },
  60             {
  61                 link => "$bindir/slave3",
  62                 name => 'slave3',
  63                 path => $paths{cat},
  64             },
  65             {
  66                 link => "$bindir/slave1",
  67                 name => 'slave1',
  68                 path => $paths{yes},
  69             },
  70             {
  71                 link => "$bindir/slave4",
  72                 name => 'slave4',
  73                 path => $paths{cat},
  74             },
  75         ],
  76     },
  77     {
  78         path => $paths{false},
  79         priority => 10,
  80         slaves => [
  81             {
  82                 link => "$bindir/slave1",
  83                 name => 'slave1',
  84                 path => $paths{date},
  85             },
  86         ],
  87     },
  88     {
  89         path => $paths{sleep},
  90         priority => 5,
  91         slaves => [],
  92     },
  93 );
  94 my $nb_slaves = 4;
  95 plan tests => (4 * ($nb_slaves + 1) + 2) * 26 # number of check_choices
  96                + 106;                         # rest
  97
  98 sub cleanup {
  99     system("rm -rf $tmpdir && mkdir -p $admindir && mkdir -p $altdir");
 100     system("mkdir -p $bindir/more");
 101 }
 102
 103 sub call_ua {
 104     my ($params, %opts) = @_;
 105     spawn(exec => [ @ua, @$params ], nocheck => 1,
 106           wait_child => 1, env => { LC_ALL => 'C' }, %opts);
 107     my $test_id = '';
 108     $test_id = "$opts{test_id}: " if defined $opts{test_id};
 109     if ($opts{expect_failure}) {
 110         ok($? != 0, "${test_id}update-alternatives @$params should fail.") or
 111             diag("Did not fail as expected: @ua @$params");
 112     } else {
 113         ok($? == 0, "${test_id}update-alternatives @$params should work.") or
 114             diag("Did not succeed as expected: @ua @$params");
 115     }
 116 }
 117
 118 sub install_choice {
 119     my ($id, %opts) = @_;
 120     my $alt = $choices[$id];
 121     my @params;
 122     push @params, @{$opts{params}} if exists $opts{params};
 123     push @params, '--install', "$main_link", "$main_name",
 124                   $alt->{path}, $alt->{priority};
 125     foreach my $slave (@{ $alt->{slaves} }) {
 126         push @params, '--slave', $slave->{link}, $slave->{name}, $slave->{path};
 127     }
 128     call_ua(\@params, %opts);
 129 }
 130
 131 sub remove_choice {
 132     my ($id, %opts) = @_;
 133     my $alt = $choices[$id];
 134     my @params;
 135     push @params, @{$opts{params}} if exists $opts{params};
 136     push @params, '--remove', $main_name, $alt->{path};
 137     call_ua(\@params, %opts);
 138 }
 139
 140 sub remove_all_choices {
 141     my (%opts) = @_;
 142     my @params;
 143     push @params, @{$opts{params}} if exists $opts{params};
 144     push @params, '--remove-all', $main_name;
 145     call_ua(\@params, %opts);
 146 }
 147
 148 sub set_choice {
 149     my ($id, %opts) = @_;
 150     my $alt = $choices[$id];
 151     my @params;
 152     push @params, @{$opts{params}} if exists $opts{params};
 153     push @params, '--set', $main_name, $alt->{path};
 154     call_ua(\@params, %opts);
 155 }
 156
 157 sub config_choice {
 158     my ($id, %opts) = @_;
 159     my ($input, $output) = ('', '');
 160     if ($id >= 0) {
 161         my $alt = $choices[$id];
 162         $input = $alt->{path};
 163     } else {
 164         $input = '0';
 165     }
 166     $input .= "\n";
 167     $opts{from_string} = \$input;
 168     $opts{to_string} = \$output;
 169     my @params;
 170     push @params, @{$opts{params}} if exists $opts{params};
 171     push @params, '--config', $main_name;
 172     call_ua(\@params, %opts);
 173 }
 174
 175 sub get_slaves_status {
 176     my ($id) = @_;
 177     my %slaves;
 178     # None of the slaves are installed
 179     foreach my $alt (@choices) {
 180         for my $i (0 .. @{$alt->{slaves}} - 1) {
 181             $slaves{$alt->{slaves}[$i]{name}} = $alt->{slaves}[$i];
 182             $slaves{$alt->{slaves}[$i]{name}}{installed} = 0;
 183         }
 184     }
 185     # except those of the current alternative (minus optional slaves)
 186     if (defined($id)) {
 187         my $alt = $choices[$id];
 188         for my $i (0 .. @{$alt->{slaves}} - 1) {
 189             $slaves{$alt->{slaves}[$i]{name}} = $alt->{slaves}[$i];
 190             if (-e $alt->{slaves}[$i]{path}) {
 191                 $slaves{$alt->{slaves}[$i]{name}}{installed} = 1;
 192             }
 193         }
 194     }
 195     my @slaves = sort { $a->{name} cmp $b->{name} } values %slaves;
 196
 197     return @slaves;
 198 }
 199
 200 sub check_link {
 201     my ($link, $value, $msg) = @_;
 202     ok(-l $link, "$msg: $link disappeared.");
 203     is(readlink($link), $value, "$link doesn't point to $value.");
 204 }
 205 sub check_no_link {
 206     my ($link, $msg) = @_;
 207     lstat($link);
 208     ok(!-e _, "$msg: $link still exists.");
 209     ok(1, 'fake test'); # Same number of tests as check_link
 210 }
 211
 212 sub check_slaves {
 213     my ($id, $msg) = @_;
 214     foreach my $slave (get_slaves_status($id)) {
 215         if ($slave->{installed}) {
 216             check_link("$altdir/$slave->{name}", $slave->{path}, $msg);
 217             check_link($slave->{link}, "$altdir/$slave->{name}", $msg);
 218         } else {
 219             check_no_link("$altdir/$slave->{name}", $msg);
 220             check_no_link($slave->{link}, $msg);
 221         }
 222     }
 223 }
 224 # (4 * (nb_slaves+1) + 2) tests in each check_choice() call
 225 sub check_choice {
 226     my ($id, $mode, $msg) = @_;
 227     my $output;
 228     if (defined $id) {
 229         # Check status
 230         call_ua([ '--query', "$main_name" ], to_string => \$output, test_id => $msg);
 231         $output =~ /^Status: (.*)$/im;
 232         is($1, $mode, "$msg: status is not $mode.");
 233         # Check links
 234         my $alt = $choices[$id];
 235         check_link("$altdir/$main_name", $alt->{path}, $msg);
 236         check_link($main_link, "$altdir/$main_name", $msg);
 237         check_slaves($id, $msg);
 238     } else {
 239         call_ua([ '--query', "$main_name" ], error_to_string => \$output,
 240                 expect_failure => 1, test_id => $msg);
 241         ok($output =~ /no alternatives/, "$msg: bad error message for --query.");
 242         # Check that all links have disappeared
 243         check_no_link("$altdir/$main_name", $msg);
 244         check_no_link($main_link, $msg);
 245         check_slaves(undef, $msg);
 246     }
 247 }
 248
 249 ### START OF TESTS
 250 cleanup();
 251 # removal when not installed should not fail
 252 remove_choice(0);
 253 # successive install in auto mode
 254 install_choice(1);
 255 check_choice(1, 'auto', 'initial install 1');
 256 install_choice(2); # 2 is lower prio, stays at 1
 257 check_choice(1, 'auto', 'initial install 2');
 258 install_choice(0); # 0 is higher priority
 259 check_choice(0, 'auto', 'initial install 3');
 260
 261 # verify that the administrative file is sorted properly
 262 {
 263     local $/ = undef;
 264     open(my $db_fh, '<', "$admindir/generic-test") or die $!;
 265     my $content = <$db_fh>;
 266     close($db_fh);
 267
 268     my $expected =
 269 "auto
 270 $bindir/generic-test
 271 slave1
 272 $bindir/slave1
 273 slave2
 274 $bindir/slave2
 275 slave3
 276 $bindir/slave3
 277 slave4
 278 $bindir/slave4
 279
 280 ";
 281
 282     my %slaves;
 283
 284     # Store slaves in a hash to easily retrieve present and missing ones.
 285     foreach my $alt (@choices) {
 286         foreach my $slave (@{$alt->{slaves}}) {
 287             $slaves{$slave->{name}}{$alt->{path}} = $slave;
 288         }
 289     }
 290
 291     foreach my $alt (sort { $a->{path} cmp $b->{path} } @choices) {
 292         $expected .= $alt->{path} . "\n";
 293         $expected .= $alt->{priority} . "\n";
 294         foreach my $slave_name (sort keys %slaves) {
 295             $expected .= $slaves{$slave_name}{$alt->{path}}{path} || '';
 296             $expected .= "\n";
 297         }
 298     }
 299     $expected .= "\n";
 300
 301     is($content, $expected, 'administrative file is as expected');
 302 }
 303
 304 # manual change with --set-selections
 305 my $input = "doesntexist auto $paths{date}\ngeneric-test manual $paths{false}\n";
 306 my $output = '';
 307 call_ua(['--set-selections'], from_string => \$input,
 308         to_string => \$output, test_id => 'manual update with --set-selections');
 309 check_choice(1, 'manual', 'manual update with --set-selections');
 310 $input = "generic-test auto $paths{true}\n";
 311 call_ua(['--set-selections'], from_string => \$input,
 312         to_string => \$output, test_id => 'auto update with --set-selections');
 313 check_choice(0, 'auto', 'auto update with --set-selections');
 314 # manual change with set
 315 set_choice(2, test_id => 'manual update with --set');
 316 check_choice(2, 'manual', 'manual update with --set'); # test #388313
 317 remove_choice(2, test_id => 'remove manual, back to auto');
 318 check_choice(0, 'auto', 'remove manual, back to auto');
 319 remove_choice(0, test_id => 'remove best');
 320 check_choice(1, 'auto', 'remove best');
 321 remove_choice(1, test_id => 'no alternative left');
 322 check_choice(undef, '', 'no alternative left');
 323 # single choice in manual mode, to be removed
 324 install_choice(1);
 325 set_choice(1);
 326 check_choice(1, 'manual', 'single manual choice');
 327 remove_choice(1);
 328 check_choice(undef, '', 'removal single manual');
 329 # test --remove-all
 330 install_choice(0);
 331 install_choice(1);
 332 install_choice(2);
 333 remove_all_choices(test_id => 'remove all');
 334 check_choice(undef, '', 'no alternative left');
 335 # check auto-recovery of user mistakes (#100135)
 336 install_choice(1);
 337 ok(unlink("$bindir/generic-test"), 'failed removal');
 338 ok(unlink("$bindir/slave1"), 'failed removal');
 339 install_choice(1);
 340 check_choice(1, 'auto', 'recreate links in auto mode');
 341 set_choice(1);
 342 ok(unlink("$bindir/generic-test"), 'failed removal');
 343 ok(unlink("$bindir/slave1"), 'failed removal');
 344 install_choice(1);
 345 check_choice(1, 'manual', 'recreate links in manual mode');
 346 # check recovery of /etc/alternatives/*
 347 install_choice(0);
 348 ok(unlink("$altdir/generic-test"), 'failed removal');
 349 install_choice(1);
 350 check_choice(0, 'auto', '<altdir>/generic-test lost, back to auto');
 351 # test --config
 352 config_choice(0);
 353 check_choice(0, 'manual', 'config to best but manual');
 354 config_choice(1);
 355 check_choice(1, 'manual', 'config to manual');
 356 config_choice(-1);
 357 check_choice(0, 'auto', 'config auto');
 358
 359 # test rename of links
 360 install_choice(0);
 361 my $old_slave = $choices[0]{slaves}[0]{link};
 362 my $old_link = $main_link;
 363 $choices[0]{slaves}[0]{link} = "$bindir/more/generic-slave";
 364 $main_link = "$bindir/more/mytest";
 365 install_choice(0);
 366 check_choice(0, 'auto', 'test rename of links');
 367 check_no_link($old_link, 'test rename of links');
 368 check_no_link($old_slave, 'test rename of links');
 369 # rename with installing other alternatives
 370 $old_link = $main_link;
 371 $main_link = "$bindir/generic-test";
 372 install_choice(1);
 373 check_choice(0, 'auto', 'rename link');
 374 check_no_link($old_link, 'rename link');
 375 # rename with lost file
 376 unlink($old_slave);
 377 $old_slave = $choices[0]{slaves}[0]{link};
 378 $choices[0]{slaves}[0]{link} = "$bindir/generic-slave-bis";
 379 install_choice(0);
 380 check_choice(0, 'auto', 'rename lost file');
 381 check_no_link($old_slave, 'rename lost file');
 382 # update of alternative with many slaves not currently installed
 383 # and the link of the renamed slave exists while it should not
 384 set_choice(1);
 385 symlink("$paths{cat}", "$bindir/generic-slave-bis");
 386 $choices[0]{slaves}[0]{link} = "$bindir/slave2";
 387 install_choice(0, test_id => 'update with non-installed slaves');
 388 check_no_link("$bindir/generic-slave-bis",
 389               'drop renamed symlink that should not be installed');
 390
 391 # test install with empty admin file (#457863)
 392 cleanup();
 393 system("touch $admindir/generic-test");
 394 install_choice(0);
 395 # test install with garbage admin file
 396 cleanup();
 397 system("echo garbage > $admindir/generic-test");
 398 install_choice(0, error_to_file => '/dev/null', expect_failure => 1);
 399
 400 # test invalid usages
 401 cleanup();
 402 install_choice(0);
 403 # try to install a slave alternative as new master
 404 call_ua(['--install', "$bindir/testmaster", 'slave1', "$paths{date}", '10'],
 405         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 406 # try to install a master alternative as slave
 407 call_ua(['--install', "$bindir/testmaster", 'testmaster', "$paths{date}", '10',
 408          '--slave', "$bindir/testslave", 'generic-test', "$paths{true}" ],
 409         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 410 # try to reuse master link in slave
 411 call_ua(['--install', "$bindir/testmaster", 'testmaster', "$paths{date}", '10',
 412          '--slave', "$bindir/testmaster", 'testslave', "$paths{true}" ],
 413         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 414 # try to reuse links in master alternative
 415 call_ua(['--install', "$bindir/slave1", 'testmaster', "$paths{date}", '10'],
 416         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 417 # try to reuse links in slave alternative
 418 call_ua(['--install', "$bindir/testmaster", 'testmaster', "$paths{date}", '10',
 419          '--slave', "$bindir/generic-test", 'testslave', "$paths{true}" ],
 420         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 421 # try to reuse slave link in another slave alternative of another choice of
 422 # the same main alternative
 423 call_ua(['--install', $main_link, $main_name, "$paths{date}", '10',
 424          '--slave', "$bindir/slave1", 'testslave', "$paths{true}" ],
 425         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 426 # lack of absolute filenames in links or file path, non-existing path,
 427 call_ua(['--install', '../testmaster', 'testmaster', "$paths{date}", '10'],
 428         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 429 call_ua(['--install', "$bindir/testmaster", 'testmaster', './update-alternatives.pl', '10'],
 430         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 431 # non-existing alternative path
 432 call_ua(['--install', "$bindir/testmaster", 'testmaster', "$bindir/doesntexist", '10'],
 433         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 434 # invalid alternative name in master
 435 call_ua(['--install', "$bindir/testmaster", 'test/master', "$paths{date}", '10'],
 436         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 437 # invalid alternative name in slave
 438 call_ua(['--install', "$bindir/testmaster", 'testmaster', "$paths{date}", '10',
 439          '--slave', "$bindir/testslave", 'test slave', "$paths{true}" ],
 440         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 441 # install in non-existing dir should fail
 442 call_ua(['--install', "$bindir/doesntexist/testmaster", 'testmaster', "$paths{date}", '10',
 443          '--slave', "$bindir/testslave", 'testslave', "$paths{true}" ],
 444         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 445 call_ua(['--install', "$bindir/testmaster", 'testmaster', "$paths{date}", '10',
 446          '--slave', "$bindir/doesntexist/testslave", 'testslave', "$paths{true}" ],
 447         expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 448
 449 # non-existing alternative path in slave is not a failure
 450 my $old_path = $choices[0]{slaves}[0]{path};
 451 $old_slave = $choices[0]{slaves}[0]{link};
 452 $choices[0]{slaves}[0]{path} = "$bindir/doesntexist";
 453 $choices[0]{slaves}[0]{link} = "$bindir/baddir/slave2";
 454 # test rename of slave link that existed but that doesn't anymore
 455 # and link is moved into non-existing dir at the same time
 456 install_choice(0);
 457 check_choice(0, 'auto', 'optional renamed slave2 in non-existing dir');
 458 # same but on fresh install
 459 cleanup();
 460 install_choice(0);
 461 check_choice(0, 'auto', 'optional slave2 in non-existing dir');
 462 $choices[0]{slaves}[0]{link} = $old_slave;
 463 # test fresh install with a non-existing slave file
 464 cleanup();
 465 install_choice(0);
 466 check_choice(0, 'auto', 'optional slave2');
 467 $choices[0]{slaves}[0]{path} = $old_path;
 468
 469 # test management of pre-existing files
 470 cleanup();
 471 system("touch $main_link $bindir/slave1");
 472 install_choice(0);
 473 ok(!-l $main_link, 'install preserves files that should be links');
 474 ok(!-l "$bindir/slave1", 'install preserves files that should be slave links');
 475 remove_choice(0);
 476 ok(-f $main_link, 'removal keeps real file installed as master link');
 477 ok(-f "$bindir/slave1", 'removal keeps real files installed as slave links');
 478 install_choice(0, params => ['--force']);
 479 check_choice(0, 'auto', 'install --force replaces files with links');
 480
 481 # test management of pre-existing files #2
 482 cleanup();
 483 system("touch $main_link $bindir/slave2");
 484 install_choice(0);
 485 install_choice(1);
 486 ok(!-l $main_link, 'inactive install preserves files that should be links');
 487 ok(!-l "$bindir/slave2", 'inactive install preserves files that should be slave links');
 488 ok(-f $main_link, 'inactive install keeps real file installed as master link');
 489 ok(-f "$bindir/slave2", 'inactive install keeps real files installed as slave links');
 490 set_choice(1);
 491 ok(!-l $main_link, 'manual switching preserves files that should be links');
 492 ok(!-l "$bindir/slave2", 'manual switching preserves files that should be slave links');
 493 ok(-f $main_link, 'manual switching keeps real file installed as master link');
 494 ok(-f "$bindir/slave2", 'manual switching keeps real files installed as slave links');
 495 remove_choice(1);
 496 ok(!-l $main_link, 'auto switching preserves files that should be links');
 497 ok(!-l "$bindir/slave2", 'auto switching preserves files that should be slave links');
 498 ok(-f $main_link, 'auto switching keeps real file installed as master link');
 499 ok(-f "$bindir/slave2", 'auto switching keeps real files installed as slave links');
 500 remove_all_choices(params => ['--force']);
 501 ok(!-e "$bindir/slave2", 'forced removeall drops real files installed as slave links');
 502
 503 # test management of pre-existing files #3
 504 cleanup();
 505 system("touch $main_link $bindir/slave2");
 506 install_choice(0);
 507 install_choice(1);
 508 remove_choice(0);
 509 ok(!-l $main_link, 'removal + switching preserves files that should be links');
 510 ok(!-l "$bindir/slave2", 'removal + switching preserves files that should be slave links');
 511 ok(-f $main_link, 'removal + switching keeps real file installed as master link');
 512 ok(-f "$bindir/slave2", 'removal + switching keeps real files installed as slave links');
 513 install_choice(0);
 514 ok(!-l $main_link, 'install + switching preserves files that should be links');
 515 ok(!-l "$bindir/slave2", 'install + switching preserves files that should be slave links');
 516 ok(-f $main_link, 'install + switching keeps real file installed as master link');
 517 ok(-f "$bindir/slave2", 'install + switching keeps real files installed as slave links');
 518 set_choice(1, params => ['--force']);
 519 ok(!-e "$bindir/slave2", 'forced switching w/o slave drops real files installed as slave links');
 520 check_choice(1, 'manual', 'set --force replaces files with links');