scripts/dpkg-fsys-usrunmess.pl

   1 #!/usr/bin/perl
   2 #
   3 # dpkg-fsys-usrunmess - Undoes the merged-/usr-via-aliased-dirs mess
   4 #
   5 # Copyright © 2020-2021 Guillem Jover <guillem@debian.org>
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 2 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, see <https://www.gnu.org/licenses/>
  19
  20 use strict;
  21 use warnings;
  22 use feature qw(state);
  23
  24 our ($PROGNAME) = $0 =~ m{(?:.*/)?([^/]*)};
  25 our $PROGVERSION = '1.22.x';
  26 our $ADMINDIR = '/var/lib/dpkg/';
  27
  28 use POSIX;
  29 use File::Temp qw(tempdir);
  30 use File::Find;
  31 use Getopt::Long qw(:config posix_default bundling_values no_ignorecase);
  32
  33 eval q{
  34     use File::FcntlLock;
  35 };
  36 if ($@) {
  37     fatal('missing File::FcntlLock module; please install libfile-fcntllock-perl');
  38 }
  39
  40 my $opt_noact = length $ENV{DPKG_USRUNMESS_NOACT} ? 1 : 0;
  41 my $opt_prompt = 0;
  42 my $opt_prevent = -1;
  43
  44 my @options_spec = (
  45     'help|?' => sub { usage(); exit 0; },
  46     'version' => sub { version(); exit 0; },
  47     'dry-run|no-act|n' => \$opt_noact,
  48     'prompt|p' => \$opt_prompt,
  49     'prevention!' => \$opt_prevent,
  50 );
  51
  52 {
  53     local $SIG{__WARN__} = sub { usageerr($_[0]) };
  54     GetOptions(@options_spec);
  55 }
  56
  57 # Set a known umask.
  58 umask 0022;
  59
  60 my @aliased_dirs;
  61
  62 #
  63 # Scan all dirs under / and check whether any are aliased to /usr.
  64 #
  65
  66 foreach my $path (glob '/*') {
  67     debug("checking symlink? $path");
  68     next unless -l $path;
  69     debug("checking merged-usr symlink? $path");
  70     my $symlink = readlink $path;
  71     next unless $symlink eq "usr$path" or $symlink eq "/usr$path";
  72     debug("merged-usr breakage, queueing $path");
  73     push @aliased_dirs, $path;
  74 }
  75
  76 if (@aliased_dirs == 0) {
  77     print "System is fine, no aliased directories found, congrats!\n";
  78     exit 0;
  79 }
  80
  81 #
  82 # dpkg consistency checks
  83 #
  84
  85 debug('checking dpkg database consistency');
  86 system(qw(dpkg --audit)) == 0
  87     or fatal("cannot audit the dpkg database: $!");
  88
  89 debug('checking whether dpkg has been interrupted');
  90 if (glob "$ADMINDIR/updates/*") {
  91     fatal('dpkg is in an inconsistent state, please fix that');
  92 }
  93
  94 $opt_prevent = prompt('Generate and install a regression prevention package')
  95     if $opt_prevent < 0;
  96
  97 if ($opt_prevent) {
  98     debug('building regression prevention measures');
  99     my $tmpdir = tempdir(CLEANUP => 1, TMPDIR => 1);
 100     my $pkgdir = "$tmpdir/pkg";
 101     my $pkgfile = "$tmpdir/dpkg-fsys-usrunmess.deb";
 102
 103     mkdir "$pkgdir" or fatal('cannot create temporary package directory');
 104     mkdir "$pkgdir/DEBIAN" or fatal('cannot create temporary directory');
 105     open my $ctrl_fh, '>', "$pkgdir/DEBIAN/control"
 106         or fatal('cannot create temporary control file');
 107     print { $ctrl_fh } <<"CTRL";
 108 Package: dpkg-fsys-usrunmess
 109 Version: $PROGVERSION
 110 Architecture: all
 111 Protected: yes
 112 Multi-Arch: foreign
 113 Section: admin
 114 Priority: optional
 115 Maintainer: Dpkg Developers <debian-dpkg\@lists.debian.org>
 116 Installed-Size: 5
 117 Conflicts: usrmerge
 118 Provides: usrmerge (= 25)
 119 Replaces: usrmerge
 120 Description: prevention measure to avoid unsuspected filesystem breakage
 121  This package will prevent automatic migration of the filesystem to the
 122  broken merge-/usr-via-aliased-dirs via the usrmerge package.
 123  .
 124  This package was generated and installed by the dpkg-fsys-usrunmess(8)
 125  program.
 126
 127 CTRL
 128     close $ctrl_fh or fatal('cannot write temporary control file');
 129
 130     system(('dpkg-deb', '-b', $pkgdir, $pkgfile)) == 0
 131         or fatal('cannot create prevention package');
 132
 133     if (not $opt_noact) {
 134         system(('dpkg', '-GBi', $pkgfile)) == 0
 135             or fatal('cannot install prevention package');
 136     }
 137 } else {
 138     print "Will not generate and install a regression prevention package.\n";
 139 }
 140
 141 my $aliased_regex = '^(' . join('|', @aliased_dirs) . ')/';
 142
 143 #
 144 # Get a list of all paths (including diversion) under the aliased dirs.
 145 #
 146
 147 my @search_args;
 148 my %aliased_pathnames;
 149 foreach my $dir (@aliased_dirs) {
 150     push @search_args, "$dir/*";
 151 }
 152
 153 # We also need to track /usr/lib/modules to then be able to compute its
 154 # complement when looking for untracked kernel module files under aliased
 155 # dirs.
 156 my %usr_mod_pathnames;
 157 push @search_args, '/usr/lib/modules/*';
 158
 159 open my $fh_paths, '-|', 'dpkg-query', '--search', @search_args
 160     or fatal("cannot execute dpkg-query --search: $!");
 161 while (<$fh_paths>) {
 162     if (m/^diversion by [^ ]+ from: .*$/) {
 163         # Ignore.
 164     } elsif (m/^diversion by [^ ]+ to: (.*)$/) {
 165         if (-e $1) {
 166             add_pathname($1, 'diverted pathname');
 167         }
 168     } elsif (m/^.*: (.*)$/) {
 169         add_pathname($1, 'pathname');
 170     }
 171 }
 172 close $fh_paths;
 173
 174 #
 175 # Get a list of all update-alternatives under the aliased dirs.
 176 #
 177
 178 my @selections = qx(update-alternatives --get-selections);
 179 foreach my $selection (@selections) {
 180     my $name = (split(' ', $selection))[0];
 181     my $slaves = 0;
 182
 183     open my $fh_alts, '-|', 'update-alternatives', '--query', $name
 184         or fatal("cannot execute update-alternatives --query: $!");
 185     while (<$fh_alts>) {
 186         if (m/^\s*$/) {
 187             last;
 188         } elsif (m/^Link: (.*)$/) {
 189             add_pathname($1, 'alternative link');
 190         } elsif (m/^Slaves:\s*$/) {
 191             $slaves = 1;
 192         } elsif ($slaves and m/^\s\S+\s(\S+)$/) {
 193             add_pathname($1, 'alternative slave');
 194         } else {
 195             $slaves = 0;
 196         }
 197     }
 198     close $fh_alts;
 199 }
 200
 201 #
 202 # Unfortunately we need to special case untracked kernel module files,
 203 # as these are required for system booting. To reduce potentially moving
 204 # undesired non-kernel module files (such as apache, python or ruby ones),
 205 # we only look for sub-dirs starting with a digit, which should match for
 206 # both Linux and kFreeBSD modules, and also for the modprobe.conf filename.
 207 #
 208
 209 find({
 210     no_chdir => 1,
 211     wanted => sub {
 212         my $path = $_;
 213
 214         if (exists $aliased_pathnames{$path}) {
 215             # Ignore pathname already handled.
 216         } elsif (exists $usr_mod_pathnames{"/usr$path"}) {
 217             # Ignore pathname owned elsewhere.
 218         } elsif ($path eq '/lib/modules' or
 219                  $path eq '/lib/modules/modprobe.conf' or
 220                  $path =~ m{^/lib/modules/[0-9]}) {
 221             add_pathname($path, 'untracked modules');
 222         }
 223     },
 224 }, '/lib/modules');
 225
 226
 227 my $sroot = '/.usrunmess';
 228 my @relabel;
 229
 230 #
 231 # Create a shadow hierarchy under / for the new unmessed dir:
 232 #
 233
 234 debug("creating shadow dir = $sroot");
 235 mkdir $sroot
 236     or sysfatal("cannot create directory $sroot");
 237 foreach my $dir (@aliased_dirs) {
 238     debug("creating shadow dir = $sroot$dir");
 239     mkdir "$sroot$dir"
 240         or sysfatal("cannot create directory $sroot$dir");
 241     chmod 0755, "$sroot$dir"
 242         or sysfatal("cannot chmod 0755 $sroot$dir");
 243     chown 0, 0, "$sroot$dir"
 244         or sysfatal("cannot chown 0 0 $sroot$dir");
 245     push @relabel, "$sroot$dir";
 246 }
 247
 248 #
 249 # Populate the split dirs with hardlinks or copies of the objects from
 250 # their counter-parts in /usr.
 251 #
 252
 253 foreach my $pathname (sort keys %aliased_pathnames) {
 254     my (@meta) = lstat $pathname
 255         or sysfatal("cannot lstat object $pathname for shadow hierarchy");
 256
 257     if (-d _) {
 258         my $mode = $meta[2];
 259         my ($uid, $gid) = @meta[4, 5];
 260         my ($atime, $mtime, $ctime) = @meta[8, 9, 10];
 261
 262         debug("creating shadow dir = $sroot$pathname");
 263         mkdir "$sroot$pathname"
 264             or sysfatal("cannot mkdir $sroot$pathname");
 265         chmod $mode, "$sroot$pathname"
 266             or sysfatal("cannot chmod $mode $sroot$pathname");
 267         chown $uid, $gid, "$sroot$pathname"
 268             or sysfatal("cannot chown $uid $gid $sroot$pathname");
 269         utime $atime, $mtime, "$sroot$pathname"
 270             or sysfatal("cannot utime $atime $mtime $sroot$pathname");
 271         push @relabel, "$sroot$pathname";
 272     } elsif (-f _) {
 273         debug("creating shadow file = $sroot$pathname");
 274         copy("/usr$pathname", "$sroot$pathname");
 275     } elsif (-l _) {
 276         my $target = readlink "/usr$pathname";
 277
 278         debug("creating shadow symlink = $sroot$pathname");
 279         symlink $target, "$sroot$pathname"
 280             or sysfatal("cannot symlink $target to $sroot$pathname");
 281         push @relabel, "$sroot$pathname";
 282     } else {
 283         fatal("unhandled object type for '$pathname'");
 284     }
 285 }
 286
 287 #
 288 # Prompt at the point of no return, if the user requested it.
 289 #
 290
 291 if ($opt_prompt) {
 292     if (!prompt("Shadow hierarchy created at '$sroot', ready to proceed")) {
 293         print "Aborting migration, shadow hierarchy left in place.\n";
 294         exit 0;
 295     }
 296 }
 297
 298 #
 299 # Mark all packages as half-configured so that we can force a mass
 300 # reconfiguration, to trigger any code in maintainer scripts that might
 301 # create files.
 302 #
 303 # XXX: We do this manually by editing the status file.
 304 # XXX: We do this for packages that might not have maintscripts, or might
 305 #      not involve affected directories.
 306 #
 307
 308 debug('marking all dpkg packages as half-configured');
 309 if (not $opt_noact) {
 310     open my $fh_lock, '>', "$ADMINDIR/lock"
 311         or sysfatal('cannot open dpkg database lock file');
 312     my $fs = File::FcntlLock->new(l_type => F_WRLCK);
 313     $fs->lock($fh_lock, F_SETLKW)
 314         or sysfatal('cannot get a write lock on dpkg database');
 315
 316     my $file_db = "$ADMINDIR/status";
 317     my $file_dbnew = $file_db . '.new';
 318
 319     open my $fh_dbnew, '>', $file_dbnew
 320         or sysfatal('cannot open new dpkg database');
 321     open my $fh_db, '<', $file_db
 322         or sysfatal('cannot open dpkg database');
 323     while (<$fh_db>) {
 324         if (m/^Status: /) {
 325             s/ installed$/ half-configured/;
 326         }
 327         print { $fh_dbnew } $_;
 328     }
 329     close $fh_db;
 330     $fh_dbnew->flush() or sysfatal('cannot flush new dpkg database');
 331     $fh_dbnew->sync() or sysfatal('cannot fsync new dpkg database');
 332     close $fh_dbnew or sysfatal('cannot close new dpkg database');
 333
 334     rename $file_dbnew, $file_db
 335         or sysfatal('cannot rename new dpkg database');
 336 }
 337
 338 #
 339 # Replace things as quickly as possible:
 340 #
 341
 342 foreach my $dir (@aliased_dirs) {
 343     debug("making dir backup = $dir.aliased");
 344     if (not $opt_noact) {
 345         rename $dir, "$dir.aliased"
 346             or sysfatal("cannot make backup directory $dir.aliased");
 347     }
 348
 349     debug("renaming $sroot$dir to $dir");
 350     if (not $opt_noact) {
 351         rename "$sroot$dir", $dir
 352             or sysfatal("cannot install fixed directory $dir");
 353     }
 354 }
 355
 356 mac_relabel();
 357
 358 #
 359 # Cleanup backup directories.
 360 #
 361
 362 foreach my $dir (@aliased_dirs) {
 363     debug("removing backup = $dir.aliased");
 364     if (not $opt_noact) {
 365         unlink "$dir.aliased"
 366             or sysfatal("cannot cleanup backup directory $dir.aliased");
 367     }
 368 }
 369
 370 my %deferred_dirnames;
 371
 372 #
 373 # Cleanup moved objects.
 374 #
 375
 376 foreach my $pathname (sort keys %aliased_pathnames) {
 377     my (@meta) = lstat $pathname
 378         or sysfatal("cannot lstat object $pathname for cleanup");
 379
 380     if (-d _) {
 381         # Skip directories as this might be shared by a proper path under the
 382         # aliased hierearchy. And so that we can remove them in reverse order.
 383         debug("deferring merged dir cleanup = /usr$pathname");
 384         $deferred_dirnames{"/usr$pathname"} = 1;
 385     } else {
 386         debug("cleaning up pathname = /usr$pathname");
 387         next if $opt_noact;
 388         unlink "/usr$pathname"
 389             or sysfatal("cannot unlink object /usr$pathname");
 390     }
 391 }
 392
 393 #
 394 # Cleanup deferred directories.
 395 #
 396
 397 debug("cleaning up shadow deferred dir = $sroot");
 398 my $arg_max = POSIX::sysconf(POSIX::_SC_ARG_MAX) // POSIX::_POSIX_ARG_MAX;
 399 my @batch_dirs;
 400 my $batch_size = 0;
 401
 402 foreach my $dir (keys %deferred_dirnames) {
 403     my $dir_size = length($dir) + 1;
 404     if ($batch_size + $dir_size < $arg_max) {
 405         $batch_size += length($dir) + 1;
 406         push @batch_dirs, $dir;
 407
 408     } else {
 409         next;
 410     }
 411     next if length $batch_size == 0;
 412
 413     open my $fh_dirs, '-|', 'dpkg-query', '--search', @batch_dirs
 414         or fatal("cannot execute dpkg-query --search: $!");
 415     while (<$fh_dirs>) {
 416         if (m/^.*: (.*)$/) {
 417             # If the directory is known by its aliased name, it should not be
 418             # cleaned up.
 419             if (exists $deferred_dirnames{$1}) {
 420                 delete $deferred_dirnames{$1};
 421             }
 422         }
 423     }
 424     close $fh_dirs;
 425
 426     @batch_dirs = ();
 427     $batch_size = 0;
 428 }
 429
 430 my @dirs_linger;
 431
 432 if (not $opt_noact) {
 433     foreach my $dirname (reverse sort keys %deferred_dirnames) {
 434         next if rmdir $dirname;
 435         warning("cannot remove shadow directory $dirname: $!");
 436
 437         push @dirs_linger, $dirname;
 438     }
 439 }
 440
 441 if (not $opt_noact) {
 442     debug("cleaning up shadow root dir = $sroot");
 443     rmdir $sroot
 444         or warning("cannot remove shadow directory $sroot: $!");
 445 }
 446
 447 #
 448 # Re-configure all packages, so that postinst maintscripts are executed.
 449 #
 450
 451 my $policypath = '/usr/sbin/dpkg-fsys-usrunmess-policy-rc.d';
 452
 453 debug('installing local policy-rc.d');
 454 if (not $opt_noact) {
 455     open my $policyfh, '>', $policypath
 456         or sysfatal("cannot create $policypath");
 457     print { $policyfh } <<'POLICYRC';
 458 #!/bin/sh
 459 echo "$0: Denied action $2 for service $1"
 460 exit 101
 461 POLICYRC
 462     close $policyfh or fatal("cannot write $policypath");
 463
 464     my @alt = (qw(/usr/sbin/policy-rc.d policy-rc.d), $policypath, qw(1000));
 465     system(qw(update-alternatives --install), @alt) == 0
 466         or fatal("cannot register $policypath");
 467
 468     system(qw(update-alternatives --set policy-rc.d), $policypath) == 0
 469         or fatal("cannot select alternative $policypath");
 470 }
 471
 472 debug('reconfiguring all packages');
 473 if (not $opt_noact) {
 474     local $ENV{DEBIAN_FRONTEND} = 'noninteractive';
 475     system(qw(dpkg --configure --pending)) == 0
 476         or fatal("cannot reconfigure packages: $!");
 477 }
 478
 479 debug('removing local policy-rc.d');
 480 if (not $opt_noact) {
 481     system(qw(update-alternatives --remove policy-rc.d), $policypath) == 0
 482         or fatal("cannot unregister $policypath: $!");
 483
 484     unlink $policypath
 485         or warning("cannot remove $policypath");
 486
 487     # Restore the selections we saved initially.
 488     open my $altfh, '|-', qw(update-alternatives --set-selections)
 489         or fatal('cannot restore alternatives state');
 490     print { $altfh } $_ foreach @selections;
 491     close $altfh or fatal('cannot restore alternatives state');
 492 }
 493
 494 print "\n";
 495
 496 if (@dirs_linger) {
 497     warning('lingering directories that could not be removed:');
 498     foreach my $dir (@dirs_linger) {
 499         warning("  $dir");
 500     }
 501 }
 502
 503 print "Done, hierarchy unmessed, congrats!\n";
 504 print "Rebooting now is very strongly advised.\n";
 505
 506 print "(Note: you might need to run 'hash -r' in your shell.)\n";
 507
 508 ##
 509 ## Functions
 510 ##
 511
 512 sub debug
 513 {
 514     my $msg = shift;
 515
 516     print { *STDERR } "D: $msg\n";
 517 }
 518
 519 sub warning
 520 {
 521     my $msg = shift;
 522
 523     warn "warning: $msg\n";
 524 }
 525
 526 sub fatal
 527 {
 528     my $msg = shift;
 529
 530     die "error: $msg\n";
 531 }
 532
 533 sub sysfatal
 534 {
 535     my $msg = shift;
 536
 537     fatal("$msg: $!");
 538 }
 539
 540 sub copy
 541 {
 542     my ($src, $dst) = @_;
 543
 544     # Try to hardlink first.
 545     return if link $src, $dst;
 546
 547     # If we are on different filesystems, try a copy.
 548     if ($! == POSIX::EXDEV) {
 549         # XXX: This will not preserve hardlinks, these would get restored
 550         # after the next package upgrade.
 551         system('cp', '-a', $src, $dst) == 0
 552             or fatal("cannot copy file $src to $dst: $?");
 553     } else {
 554         sysfatal("cannot link file $src to $dst");
 555     }
 556 }
 557
 558 sub mac_relabel
 559 {
 560     my $has_cmd = 0;
 561     foreach my $path (split /:/, $ENV{PATH}) {
 562         if (-x "$path/restorecon") {
 563             $has_cmd = 1;
 564             last;
 565         }
 566     }
 567     return unless $has_cmd;
 568
 569     foreach my $pathname (@relabel) {
 570         system('restorecon', $pathname) == 0
 571             or fatal("cannot restore MAC context for $pathname: $?");
 572     }
 573 }
 574
 575 sub add_pathname
 576 {
 577     my ($pathname, $origin) = @_;
 578
 579     if ($pathname =~ m{^/usr/lib/modules/}) {
 580         debug("tracking $origin = $pathname");
 581         $usr_mod_pathnames{$pathname} = 1;
 582     } elsif ($pathname =~ m/$aliased_regex/) {
 583         debug("adding $origin = $pathname");
 584         $aliased_pathnames{$pathname} = 1;
 585     }
 586 }
 587
 588 sub prompt
 589 {
 590     my $query = shift;
 591
 592     print "$query (y/N)? ";
 593     my $reply = <STDIN>;
 594     chomp $reply;
 595
 596     return 0 if $reply ne 'y' and $reply ne 'yes';
 597     return 1;
 598 }
 599
 600 sub version()
 601 {
 602     printf "Debian %s version %s.\n", $PROGNAME, $PROGVERSION;
 603 }
 604
 605 sub usage
 606 {
 607     printf
 608 'Usage: %s [<option>...]'
 609     . "\n\n" .
 610 'Options:
 611   -p, --prompt         prompt before the point of no return.
 612       --prevention     enable regression prevention package installation.
 613       --no-prevention  disable regression prevention package installation.
 614   -n, --no-act         just check and create the new structure, no switch.
 615       --dry-run        ditto.
 616   -?, --help           show this help message.
 617       --version        show the version.'
 618     . "\n", $PROGNAME;
 619 }
 620
 621 sub usageerr
 622 {
 623     my ($msg, @args) = @_;
 624
 625     state $printforhelp = 'Use --help for program usage information.';
 626
 627     $msg = sprintf $msg, @args if @args;
 628     warn "$PROGNAME: error: $msg\n";
 629     warn "$printforhelp\n";
 630     exit 2;
 631 }