chiark - git - mdw - dpkg/blob - src/t/dpkg_divert.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::File;
  24 use Dpkg::IPC;
  25
  26 # Cleanup environment from variables that pollute the test runs.
  27 delete $ENV{DPKG_MAINTSCRIPT_PACKAGE};
  28 delete $ENV{DPKG_MAINTSCRIPT_ARCH};
  29
  30 my $srcdir = $ENV{srcdir} || '.';
  31 my $builddir = $ENV{builddir} || '.';
  32 my $tmpdir = 't.tmp/dpkg_divert';
  33 my $admindir = File::Spec->rel2abs("$tmpdir/admindir");
  34 my $testdir = File::Spec->rel2abs("$tmpdir/testdir");
  35
  36 my @dd = ("$builddir/../src/dpkg-divert");
  37
  38 if (! -x "@dd") {
  39     plan skip_all => 'dpkg-divert not available';
  40     exit(0);
  41 }
  42
  43 plan tests => 257;
  44
  45 sub cleanup {
  46     # On FreeBSD «rm -rf» cannot traverse a directory with mode 000.
  47     system("test -d $testdir/nadir && rmdir $testdir/nadir");
  48     system("rm -rf $tmpdir && mkdir -p $testdir");
  49     system("mkdir -p $admindir/updates");
  50     system("rm -f $admindir/status && touch $admindir/status");
  51     system("rm -rf $admindir/info && mkdir -p $admindir/info");
  52 }
  53
  54 sub install_diversions {
  55     my ($txt) = @_;
  56     open(my $db_fh, '>', "$admindir/diversions")
  57         or die "cannot create $admindir/diversions";
  58     print { $db_fh } $txt;
  59     close($db_fh);
  60 }
  61
  62 sub install_filelist {
  63     my ($pkg, $arch, @files) = @_;
  64     open(my $fileslist_fh, '>', "$admindir/info/$pkg.list")
  65         or die "cannot create $admindir/info/$pkg.list";
  66     for my $file (@files) {
  67         print { $fileslist_fh } "$file\n";
  68     }
  69     close($fileslist_fh);
  70     # Only installed packages have their files list considered.
  71     open(my $status_fh, '>>', "$admindir/status")
  72         or die "cannot append to $admindir/status";
  73     print { $status_fh } <<"EOF";
  74 Package: $pkg
  75 Status: install ok installed
  76 Version: 0
  77 Architecture: $arch
  78 Maintainer: dummy
  79 Description: dummy
  80
  81 EOF
  82     close($status_fh);
  83 }
  84
  85 sub call {
  86     my ($prog, $args, %opts) = @_;
  87
  88     my ($output, $error);
  89     spawn(exec => [@$prog, @$args], wait_child => 1, nocheck => 1,
  90           to_pipe => \$output, error_to_pipe => \$error, %opts);
  91
  92     if ($opts{expect_failure}) {
  93         ok($? != 0, "@$args should fail");
  94     } else  {
  95         ok($? == 0, "@$args should not fail");
  96     }
  97
  98     if (defined $opts{expect_stdout}) {
  99         my (@output) = <$output>;
 100         my (@expect) = split(/^/, $opts{expect_stdout});
 101         if (defined $opts{expect_sorted_stdout}) {
 102             @output = sort @output;
 103             @expect = sort @expect;
 104         }
 105         is(join('', @output), join('', @expect), "@$args stdout");
 106     }
 107     if (defined $opts{expect_stdout_like}) {
 108         like(file_slurp($output), $opts{expect_stdout_like}, "@$args stdout");
 109     }
 110     if (defined $opts{expect_stderr}) {
 111         is(file_slurp($error), $opts{expect_stderr}, "@$args stderr");
 112     }
 113     if (defined $opts{expect_stderr_like}) {
 114         like(file_slurp($error), $opts{expect_stderr_like}, "@$args stderr");
 115     }
 116
 117     close($output);
 118     close($error);
 119 }
 120
 121 sub call_divert {
 122     my ($params, %opts) = @_;
 123     call([@dd, '--admindir', $admindir], $params, %opts);
 124 }
 125
 126 sub call_divert_sort {
 127     my ($params, %opts) = @_;
 128     $opts{expect_sorted_stdout} = 1;
 129     call_divert($params, %opts);
 130 }
 131
 132 sub diversions_pack {
 133     my (@data) = @_;
 134     my @data_packed;
 135
 136     ## no critic (ControlStructures::ProhibitCStyleForLoops)
 137     for (my ($i) = 0; $i < $#data; $i += 3) {
 138         push @data_packed, [ @data[$i .. $i + 2] ];
 139     }
 140     ## use critic
 141     my @list = sort { $a->[0] cmp $b->[0] } @data_packed;
 142
 143     return @list;
 144 }
 145
 146 sub diversions_eq {
 147     my (@expected) = split /^/, shift;
 148     open(my $db_fh, '<', "$admindir/diversions")
 149         or die "cannot open $admindir/diversions";
 150     my (@contents) = <$db_fh>;
 151     close($db_fh);
 152
 153     my (@expected_pack) = diversions_pack(@expected);
 154     my (@contents_pack) = diversions_pack(@contents);
 155
 156     is_deeply(\@contents_pack, \@expected_pack, 'diversions contents');
 157 }
 158
 159 ### Tests
 160
 161 cleanup();
 162
 163 note('Command line parsing testing');
 164
 165 my $usagere = qr/.*Usage.*dpkg-divert.*Commands.*Options.*/s;
 166
 167 sub call_divert_badusage {
 168     my ($args, $err) = @_;
 169     call_divert($args, expect_failure => 1, expect_stderr_like => $err);
 170 }
 171
 172 call_divert(['--help'], expect_stdout_like => $usagere,
 173             expect_stderr => '');
 174 call_divert(['--version'], expect_stdout_like => qr/.*dpkg-divert.*free software.*/s,
 175             expect_stderr => '');
 176
 177 call_divert_badusage(['--jachsmitbju'], qr/unknown option/);
 178 call_divert_badusage(['--add', '--remove'], qr/(conflicting|two).*remove.*add.*/s);
 179 call_divert_badusage(['--divert'], qr/(takes a value|needs.*argument)/);
 180 call_divert_badusage(['--divert', 'foo'], qr/absolute/);
 181 call_divert_badusage(['--divert', "/foo\nbar"], qr/newline/);
 182 call_divert_badusage(['--package'], qr/(takes a value|needs.*argument)/);
 183 call_divert_badusage(['--package', "foo\nbar"], qr/newline/);
 184
 185 install_diversions('');
 186
 187 call_divert_badusage(['--add',], qr/needs a single argument/);
 188 call_divert_badusage(['--add', 'foo'], qr/absolute/);
 189 call_divert_badusage(['--add', "/foo\nbar"], qr/newline/);
 190 call_divert_badusage(['--add', "$testdir"], qr/director(y|ies)/);
 191 call_divert_badusage(['--add', '--divert', 'bar', '/foo/bar'], qr/absolute/);
 192 call_divert_badusage(['--remove'], qr/needs a single argument/);
 193 call_divert_badusage(['--remove', 'foo'], qr/absolute/);
 194 call_divert_badusage(['--remove', "/foo\nbar"], qr/newline/);
 195 call_divert_badusage(['--listpackage'], qr/needs a single argument/);
 196 call_divert_badusage(['--listpackage', 'foo'], qr/absolute/);
 197 call_divert_badusage(['--listpackage', "/foo\nbar"], qr/newline/);
 198 call_divert_badusage(['--truename'], qr/needs a single argument/);
 199 call_divert_badusage(['--truename', 'foo'], qr/absolute/);
 200 call_divert_badusage(['--truename', "/foo\nbar"], qr/newline/);
 201 call([@dd, '--admindir'], [],
 202      expect_failure => 1, expect_stderr_like => qr/(takes a value|needs.*argument)/);
 203
 204 cleanup();
 205
 206 note('Querying information from diverts db (empty one)');
 207
 208 install_diversions('');
 209
 210 call_divert_sort(['--list'], expect_stdout => '', expect_stderr => '');
 211 call_divert_sort(['--list', '*'], expect_stdout => '', expect_stderr => '');
 212 call_divert_sort(['--list', 'baz'], expect_stdout => '', expect_stderr => '');
 213
 214 cleanup();
 215
 216 note('Querying information from diverts db (1)');
 217
 218 install_diversions(<<'EOF');
 219 /bin/sh
 220 /bin/sh.distrib
 221 dash
 222 /usr/share/man/man1/sh.1.gz
 223 /usr/share/man/man1/sh.distrib.1.gz
 224 dash
 225 /usr/bin/nm
 226 /usr/bin/nm.single
 227 binutils-multiarch
 228 EOF
 229
 230 my $di_dash = "diversion of /bin/sh to /bin/sh.distrib by dash\n";
 231 my $di_dashman = "diversion of /usr/share/man/man1/sh.1.gz to /usr/share/man/man1/sh.distrib.1.gz by dash\n";
 232 my $di_nm = "diversion of /usr/bin/nm to /usr/bin/nm.single by binutils-multiarch\n";
 233
 234 my $all_di = $di_dash . $di_dashman . $di_nm;
 235
 236 call_divert_sort(['--list'], expect_stdout => $all_di, expect_stderr => '');
 237 call_divert_sort(['--list', '*'], expect_stdout => $all_di, expect_stderr => '');
 238 call_divert_sort(['--list', ''], expect_stdout => '', expect_stderr => '');
 239
 240 call_divert_sort(['--list', '???????'], expect_stdout => $di_dash, expect_stderr => '');
 241 call_divert_sort(['--list', '*/sh'], expect_stdout => $di_dash, expect_stderr => '');
 242 call_divert_sort(['--list', '/bin/*'], expect_stdout => $di_dash, expect_stderr => '');
 243 call_divert_sort(['--list', 'binutils-multiarch'], expect_stdout => $di_nm, expect_stderr => '');
 244 call_divert_sort(['--list', '/bin/sh'], expect_stdout => $di_dash, expect_stderr => '');
 245 call_divert_sort(['--list', '--', '/bin/sh'], expect_stdout => $di_dash, expect_stderr => '');
 246 call_divert_sort(['--list', '/usr/bin/nm.single'], expect_stdout => $di_nm, expect_stderr => '');
 247 call_divert_sort(['--list', '/bin/sh', '/usr/share/man/man1/sh.1.gz'], expect_stdout => $di_dash . $di_dashman,
 248             expect_stderr => '');
 249
 250 cleanup();
 251
 252 note('Querying information from diverts db (2)');
 253
 254 install_diversions(<<'EOF');
 255 /bin/sh
 256 /bin/sh.distrib
 257 dash
 258 /bin/true
 259 /bin/true.coreutils
 260 :
 261 EOF
 262
 263 call_divert(['--listpackage', 'foo', 'bar'], expect_failure => 1);
 264 call_divert(['--listpackage', '/bin/sh'], expect_stdout => "dash\n", expect_stderr => '');
 265 call_divert(['--listpackage', '/bin/true'], expect_stdout => "LOCAL\n", expect_stderr => '');
 266 call_divert(['--listpackage', '/bin/false'], expect_stdout => '', expect_stderr => '');
 267
 268 call_divert(['--truename', '/bin/sh'], expect_stdout => "/bin/sh.distrib\n", expect_stderr => '');
 269 call_divert(['--truename', '/bin/sh.distrib'], expect_stdout => "/bin/sh.distrib\n", expect_stderr => '');
 270 call_divert(['--truename', '/bin/something'], expect_stdout => "/bin/something\n", expect_stderr => '');
 271
 272 cleanup();
 273
 274 note('Adding diversion');
 275
 276 my $diversions_added_foo_local = <<"EOF";
 277 $testdir/foo
 278 $testdir/foo.distrib
 279 :
 280 EOF
 281
 282 install_diversions('');
 283
 284 system("touch $testdir/foo");
 285 call_divert(['--rename', '--add', "$testdir/foo"],
 286             expect_stdout_like => qr{
 287                 Adding.*local.*diversion.*
 288                 \Q$testdir\E/foo.*
 289                 \Q$testdir\E/foo.distrib
 290             }x,
 291             expect_stderr => '');
 292 ok(-e "$testdir/foo.distrib", 'foo diverted');
 293 ok(!-e "$testdir/foo", 'foo diverted');
 294 diversions_eq($diversions_added_foo_local);
 295
 296 cleanup();
 297
 298 note('Adding diversion (2)');
 299
 300 install_diversions('');
 301
 302 system("touch $testdir/foo");
 303 call_divert(['--add', "$testdir/foo"],
 304             expect_stdout_like => qr{
 305                 Adding.*local.*diversion.*
 306                 \Q$testdir\E/foo.*
 307                 \Q$testdir\E/foo.distrib
 308             }x,
 309             expect_stderr => '');
 310 ok(!-e "$testdir/foo.distrib", 'foo diverted');
 311 ok(-e "$testdir/foo", 'foo diverted');
 312 diversions_eq($diversions_added_foo_local);
 313
 314 cleanup();
 315
 316 note('Adding diversion (3)');
 317
 318 install_diversions('');
 319
 320 system("touch $testdir/foo");
 321 call_divert(['--quiet', '--rename', '--add', "$testdir/foo"],
 322             expect_stdout => '', expect_stderr => '');
 323 ok(-e "$testdir/foo.distrib", 'foo diverted');
 324 ok(!-e "$testdir/foo", 'foo diverted');
 325 diversions_eq($diversions_added_foo_local);
 326
 327 cleanup();
 328
 329 note('Adding diversion (4)');
 330
 331 install_diversions('');
 332 system("touch $testdir/foo");
 333 call_divert(['--quiet', '--rename', '--test', "$testdir/foo"],
 334             expect_stdout => '', expect_stderr => '');
 335 ok(-e "$testdir/foo", 'foo not diverted');
 336 ok(!-e "$testdir/foo.distrib", 'foo diverted');
 337 diversions_eq('');
 338
 339 cleanup();
 340
 341 note('Adding diversion (5)');
 342
 343 install_diversions('');
 344 call_divert(['--quiet', '--rename', "$testdir/foo"],
 345             expect_stdout => '', expect_stderr => '');
 346 ok(!-e "$testdir/foo", 'foo does not exist');
 347 ok(!-e "$testdir/foo.distrib", 'foo was not created out of thin air');
 348
 349 cleanup();
 350
 351 note('Adding diversion (6)');
 352
 353 install_diversions('');
 354 system("touch $testdir/foo");
 355 call_divert(['--quiet', '--local', '--rename', "$testdir/foo"],
 356             expect_stdout => '', expect_stderr => '');
 357
 358 ok(-e "$testdir/foo.distrib", 'foo diverted');
 359 ok(!-e "$testdir/foo", 'foo diverted');
 360 diversions_eq($diversions_added_foo_local);
 361
 362 cleanup();
 363
 364 note('Adding diversion (7)');
 365
 366 install_diversions('');
 367 call_divert(['--quiet', '--rename', '--package', 'bash', "$testdir/foo"],
 368             expect_stdout => '', expect_stderr => '');
 369 diversions_eq(<<"EOF");
 370 $testdir/foo
 371 $testdir/foo.distrib
 372 bash
 373 EOF
 374
 375 note('Adding diversion (8)');
 376
 377 install_diversions('');
 378 system("touch $testdir/foo; ln $testdir/foo $testdir/foo.distrib");
 379 call_divert(['--rename', "$testdir/foo"]);
 380 diversions_eq($diversions_added_foo_local);
 381 ok(!-e "$testdir/foo", 'foo diverted');
 382 ok(-e "$testdir/foo.distrib", 'foo diverted');
 383
 384 cleanup();
 385
 386 note('Adding diversion (9)');
 387
 388 install_diversions('');
 389 system("touch $testdir/foo $testdir/foo.distrib");
 390 call_divert(['--rename', "$testdir/foo"], expect_failure => 1,
 391             expect_stderr_like => qr/overwriting/);
 392 diversions_eq('');
 393
 394 cleanup();
 395
 396 note('Adding second diversion');
 397
 398 install_diversions('');
 399 call_divert(["$testdir/foo"]);
 400
 401 call_divert(["$testdir/foo"], expect_stdout_like => qr/Leaving/);
 402 call_divert(['--quiet', "$testdir/foo"], expect_stdout => '');
 403 call_divert(['--divert', "$testdir/foo.bar", "$testdir/foo"],
 404             expect_failure => 1, expect_stderr_like => qr/clashes/);
 405 call_divert(['--package', 'foobar', "$testdir/foo"], expect_failure => 1,
 406             expect_stderr_like => qr/clashes/);
 407 call_divert(['--divert', "$testdir/foo.distrib", "$testdir/bar"],
 408             expect_failure => 1, expect_stderr_like => qr/clashes/);
 409 call_divert(["$testdir/foo.distrib"],
 410             expect_failure => 1, expect_stderr_like => qr/clashes/);
 411 call_divert(['--divert', "$testdir/foo", "$testdir/bar"],
 412             expect_failure => 1, expect_stderr_like => qr/clashes/);
 413
 414 cleanup();
 415
 416 note('Adding third diversion');
 417
 418 install_diversions('');
 419 call_divert(["$testdir/foo"]);
 420 call_divert(["$testdir/bar"]);
 421
 422 call_divert(['--quiet', "$testdir/foo"], expect_stdout => '');
 423 call_divert(['--package', 'foobar', "$testdir/bar"], expect_failure => 1,
 424            expect_stderr_like => qr/clashes/);
 425
 426 cleanup();
 427
 428 note('Adding diversion in non-existing directory');
 429
 430 install_diversions('');
 431
 432 call_divert(['--quiet', '--rename', '--add', "$testdir/zoo/foo"],
 433             expect_stderr => '', expect_stdout => '');
 434 diversions_eq(<<"EOF");
 435 $testdir/zoo/foo
 436 $testdir/zoo/foo.distrib
 437 :
 438 EOF
 439
 440 cleanup();
 441
 442 note('Adding diversion of file owned by --package');
 443
 444 install_filelist('coreutils', 'i386', "$testdir/foo");
 445 install_diversions('');
 446 system("touch $testdir/foo");
 447
 448 call_divert(['--quiet', '--rename', '--add', '--package', 'coreutils', "$testdir/foo"],
 449             expect_stderr => '', expect_stdout => '');
 450 ok(-e "$testdir/foo", 'foo not renamed');
 451 ok(!-e "$testdir/foo.distrib", 'foo renamed');
 452 diversions_eq(<<"EOF");
 453 $testdir/foo
 454 $testdir/foo.distrib
 455 coreutils
 456 EOF
 457
 458 cleanup();
 459
 460 note('Remove diversions');
 461
 462 install_diversions('');
 463
 464 call_divert(['--remove', '/bin/sh'], expect_stdout_like => qr/No diversion/, expect_stderr => '');
 465 call_divert(['--remove', '--quiet', '/bin/sh'], expect_stdout => '', expect_stderr => '');
 466
 467 cleanup();
 468
 469 note('Remove diversion (2)');
 470
 471 install_diversions('');
 472 call_divert(["$testdir/foo"]);
 473 call_divert(["$testdir/bar"]);
 474 call_divert(["$testdir/baz"]);
 475
 476 call_divert(['--divert', "$testdir/foo.my", '--remove', "$testdir/foo"],
 477            expect_failure => 1, expect_stderr_like => qr/mismatch on divert-to/);
 478 call_divert(['--package', 'baz', '--remove', "$testdir/foo"],
 479             expect_failure => 1, expect_stderr_like => qr/mismatch on package/);
 480 call_divert(['--package', 'baz', '--divert', "$testdir/foo.my", '--remove', "$testdir/foo"],
 481             expect_failure => 1, expect_stderr_like => qr/mismatch on (package|divert-to)/);
 482
 483 call_divert(['--divert', "$testdir/foo.distrib", '--remove', "$testdir/foo"],
 484             expect_stdout_like => qr{Removing.*\Q$testdir\E/foo});
 485 diversions_eq(<<"EOF");
 486 $testdir/bar
 487 $testdir/bar.distrib
 488 :
 489 $testdir/baz
 490 $testdir/baz.distrib
 491 :
 492 EOF
 493
 494 cleanup();
 495
 496 note('Remove diversion (3)');
 497
 498 install_diversions('');
 499
 500 call_divert(["$testdir/foo"]);
 501 call_divert(["$testdir/bar"]);
 502 call_divert(["$testdir/baz"]);
 503
 504 call_divert(['--remove', "$testdir/bar"],
 505             expect_stdout_like => qr{Removing.*\Q$testdir\E/bar});
 506 diversions_eq(<<"EOF");
 507 $testdir/foo
 508 $testdir/foo.distrib
 509 :
 510 $testdir/baz
 511 $testdir/baz.distrib
 512 :
 513 EOF
 514
 515 cleanup();
 516
 517 note('Remove diversion (4)');
 518
 519 install_diversions('');
 520
 521 call_divert(["$testdir/foo"]);
 522 call_divert(["$testdir/bar"]);
 523 call_divert(['--package', 'bash', "$testdir/baz"]);
 524
 525 call_divert(['--quiet', '--package', 'bash', '--remove', "$testdir/baz"],
 526             expect_stdout => '', expect_stderr => '');
 527 diversions_eq(<<"EOF");
 528 $testdir/foo
 529 $testdir/foo.distrib
 530 :
 531 $testdir/bar
 532 $testdir/bar.distrib
 533 :
 534 EOF
 535
 536 cleanup();
 537
 538 note('Remove diversion(5)');
 539
 540 install_diversions('');
 541 system("touch $testdir/foo");
 542 call_divert(['--rename', "$testdir/foo"]);
 543
 544 call_divert(['--test', '--rename', '--remove', "$testdir/foo"],
 545             expect_stdout_like => qr{Removing.*\Q$testdir\E/foo}, expect_stderr => '');
 546 ok(-e "$testdir/foo.distrib", 'foo diversion not removed');
 547 ok(!-e "$testdir/foo", 'foo diversion not removed');
 548 diversions_eq($diversions_added_foo_local);
 549
 550 call_divert(['--quiet', '--rename', '--remove', "$testdir/foo"],
 551             expect_stdout => '', expect_stderr => '');
 552 ok(-e "$testdir/foo", 'foo diversion removed');
 553 ok(!-e "$testdir/foo.distrib", 'foo diversion removed');
 554 diversions_eq('');
 555
 556 cleanup();
 557
 558 note('Corrupted diversions db handling');
 559
 560 SKIP: {
 561     skip 'running as root or similar', 3, if (defined($ENV{FAKEROOTKEY}) or $> == 0);
 562
 563     # An inexistent diversions db file should not be considered a failure,
 564     # but a failure to open it should be.
 565     install_diversions('');
 566     system("chmod 000 $admindir/diversions");
 567     call_divert_sort(['--list'], expect_failure => 1,
 568                 expect_stderr_like => qr/(cannot|failed).*open/, expect_stdout => '');
 569     system("chmod 644 $admindir/diversions");
 570 }
 571
 572 install_diversions(<<'EOF');
 573 /bin/sh
 574 EOF
 575
 576 call_divert_sort(['--list'], expect_failure => 1,
 577                  expect_stderr_like => qr/(corrupt|unexpected end of file)/,
 578                  expect_stdout => '');
 579
 580 install_diversions(<<'EOF');
 581 /bin/sh
 582 bash
 583 EOF
 584
 585 call_divert_sort(['--list'], expect_failure => 1,
 586                  expect_stderr_like => qr/(corrupt|unexpected end of file)/,
 587                  expect_stdout => '');
 588
 589 cleanup();
 590
 591 SKIP: {
 592     skip 'running as root or similar', 10, if (defined($ENV{FAKEROOTKEY}) or $> == 0);
 593
 594     note('R/O directory');
 595
 596     install_diversions('');
 597     system("mkdir $testdir/rodir && touch $testdir/rodir/foo $testdir/bar && chmod 500 $testdir/rodir");
 598     call_divert(['--rename', '--add', "$testdir/rodir/foo"],
 599                 expect_failure => 1, expect_stderr_like => qr/error/);
 600     call_divert(['--rename', '--divert', "$testdir/rodir/bar", '--add', "$testdir/bar"],
 601                 expect_failure => 1, expect_stderr_like => qr/error/);
 602     diversions_eq('');
 603
 604     system("chmod 755 $testdir/rodir");
 605     cleanup();
 606
 607     note('Unavailable file');
 608
 609     install_diversions('');
 610     system("mkdir $testdir/nadir && chmod 000 $testdir/nadir");
 611     call_divert(['--rename', '--add', "$testdir/nadir/foo"],
 612                 expect_failure => 1, expect_stderr_like => qr/Permission denied/);
 613     system("touch $testdir/foo");
 614     call_divert(['--rename', '--divert', "$testdir/nadir/foo", '--add', "$testdir/foo"],
 615                 expect_failure => 1, expect_stderr_like => qr/Permission denied/);
 616     diversions_eq('');
 617
 618     cleanup();
 619 }
 620
 621 note('Errors during saving diversions db');
 622
 623 install_diversions('');
 624
 625 SKIP: {
 626     skip 'running as root or similar', 4, if (defined($ENV{FAKEROOTKEY}) or $> == 0);
 627
 628     system("chmod 500 $admindir");
 629     call_divert(["$testdir/foo"], expect_failure => 1, expect_stderr_like => qr/create.*new/);
 630
 631     system("chmod 755 $admindir");
 632
 633     SKIP: {
 634         skip 'device /dev/full is not available', 2 if not -c '/dev/full';
 635
 636         system("ln -s /dev/full $admindir/diversions-new");
 637         call_divert(["$testdir/foo"], expect_failure => 1,
 638                     expect_stderr_like => qr/(write|flush|close).*new/);
 639     }
 640 }
 641
 642 system("rm -f $admindir/diversions-new; mkdir $admindir/diversions-old");
 643 call_divert(["$testdir/foo"], expect_failure => 1, expect_stderr_like => qr/remov.*old/);