stow

   1 #!/usr/bin/perl
   2
   3 # GNU Stow - manage the installation of multiple software packages
   4 # Copyright (C) 1993, 1994, 1995, 1996 by Bob Glickstein
   5 # Copyright (C) 2000,2001 Guillaume Morin
   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, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # 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, write to the Free Software
  19 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20 #
  21 # $Id: stow.in,v 1.8 2002/01/05 11:27:01 gmorin Exp $
  22 # $Source: /cvsroot/stow/stow/stow.in,v $
  23 # $Date: 2002/01/05 11:27:01 $
  24 # $Author: gmorin $
  25
  26 # Add ".dontfold" support.  A ".dontfold" file inside a package prevents its
  27 # containing directory from being folded even if no other package contributes
  28 # to that directory.  Note that the ancestor directories up to the package root
  29 # should have ".dontfold" files too or they might get folded.  One must ensure
  30 # that each directory in the target gets a ".dontfold" from at most one package,
  31 # or stow will report conflicts.
  32 # - Matt 2009-10-19
  33
  34 # Add support for poststow scripts. - Matt 2009-10-20
  35
  36 require 5.005;
  37 use POSIX;
  38 use File::Basename;
  39
  40 $ProgramName = $0;
  41 $ProgramName =~ s,.*/,,;
  42
  43 $Version = '1.3.3';
  44
  45 $Conflicts = 0;
  46 $Delete = 0;
  47 $NotReally = 0;
  48 $Verbose = 0;
  49 $ReportHelp = 0;
  50 $Stow = undef;
  51 $Target = undef;
  52 $Restow = 0;
  53 $PoststowOnly = 0;
  54
  55
  56 # FIXME: use Getopt::Long
  57 while (@ARGV && ($_ = $ARGV[0]) && /^-/) {
  58   $opt = $';
  59   shift;
  60   last if /^--$/;
  61
  62   if ($opt =~ /^-/) {
  63     $opt = $';
  64     if ($opt =~ /^no?$/i) {
  65       $NotReally = 1;
  66     } elsif ($opt =~ /^c(o(n(f(l(i(c(ts?)?)?)?)?)?)?)?$/i) {
  67       $Conflicts = 1;
  68       $NotReally = 1;
  69     } elsif ($opt =~ /^dir?/i) {
  70       $remainder = $';
  71       if ($remainder =~ /^=/) {
  72         $Stow = $';             # the stuff after the =
  73       } else {
  74         $Stow = shift;
  75       }
  76     } elsif ($opt =~ /^t(a(r(g(et?)?)?)?)?/i) {
  77       $remainder = $';
  78       if ($remainder =~ /^=/) {
  79         $Target = $';           # the stuff after the =
  80       } else {
  81         $Target = shift;
  82       }
  83     } elsif ($opt =~ /^verb(o(se?)?)?/i) {
  84       $remainder = $';
  85       if ($remainder =~ /^=(\d+)/) {
  86         $Verbose = $1;
  87       } else {
  88         ++$Verbose;
  89       }
  90     } elsif ($opt =~ /^de(l(e(te?)?)?)?$/i) {
  91       $Delete = 1;
  92     } elsif ($opt =~ /^r(e(s(t(ow?)?)?)?)?$/i) {
  93       $Restow = 1;
  94     } elsif ($opt =~ /^p(o(s(t(s(t(o(w(-(o(n(ly?)?)?)?)?)?)?)?)?)?)?)?$/i) {
  95       $PoststowOnly = 1;
  96     } elsif ($opt =~ /^vers(i(on?)?)?$/i) {
  97       &version();
  98     } else {
  99       &usage(($opt =~ /^h(e(lp?)?)?$/) ? undef :
 100              "unknown or ambiguous option: $opt");
 101     }
 102   } else {
 103     @opts = split(//, $opt);
 104     while ($_ = shift(@opts)) {
 105       if ($_ eq 'n') {
 106         $NotReally = 1;
 107       } elsif ($_ eq 'c') {
 108         $Conflicts = 1;
 109         $NotReally = 1;
 110       } elsif ($_ eq 'd') {
 111         $Stow = (join('', @opts) || shift);
 112         @opts = ();
 113       } elsif ($_ eq 't') {
 114         $Target = (join('', @opts) || shift);
 115         @opts = ();
 116       } elsif ($_ eq 'v') {
 117         ++$Verbose;
 118       } elsif ($_ eq 'D') {
 119         $Delete = 1;
 120       } elsif ($_ eq 'R') {
 121         $Restow = 1;
 122       } elsif ($_ eq 'V') {
 123         &version();
 124       } else {
 125         &usage(($_ eq 'h') ? undef : "unknown option: $_");
 126       }
 127     }
 128   }
 129 }
 130
 131 if ($PoststowOnly) {
 132   &usage("--poststow-only should be used by itself") if @ARGV;
 133 } else {
 134   &usage("No packages named") unless @ARGV;
 135 }
 136
 137 # Changing dirs helps a lot when soft links are used
 138 $current_dir = &getcwd;
 139 if ($Stow) {
 140   chdir($Stow) || die "Cannot chdir to target tree $Stow ($!)\n";
 141 }
 142
 143 # This prevents problems if $Target was supplied as a relative path
 144 $Stow = &getcwd;
 145
 146 chdir($current_dir) || die "Your directory does not seem to exist anymore ($!)\n";
 147
 148 unless ($Target) {
 149         if (basename($Stow) eq 'stow') {
 150                 $Target = &parent($Stow);
 151         } else {
 152                 die "Not using the parent of the stow directory as the target because the basename of\n"
 153                   . "the stow directory is not \`stow'.  This is a safety feature in case you\n"
 154                   . "mistakenly run this program in the target directory, to avoid trashing its\n"
 155                   . "parent.  If you are sure you have the right stow directory, specify the target\n"
 156                   . "with the --target option to bypass this check.\n";
 157         }
 158 }
 159
 160 chdir($Target) || die "Cannot chdir to target tree $Target ($!)\n";
 161 $Target = &getcwd;
 162
 163 foreach $package (@ARGV) {
 164   $package =~ s,/+$,,;          # delete trailing slashes
 165   if ($package =~ m,/,) {
 166     die "$ProgramName: slashes not permitted in package names\n";
 167   }
 168 }
 169
 170 if (!$PoststowOnly && ($Delete || $Restow)) {
 171   @Collections = @ARGV;
 172   &Unstow('', &RelativePath($Target, $Stow));
 173 }
 174
 175 if (!$PoststowOnly && (!$Delete || $Restow)) {
 176   foreach $Collection (@ARGV) {
 177     warn "Stowing package $Collection...\n" if $Verbose;
 178     &StowContents($Collection, &RelativePath($Target, $Stow));
 179   }
 180 }
 181
 182 if (!$NotReally) {
 183   &RunPoststowScripts();
 184 }
 185
 186 sub CommonParent {
 187   local($dir1, $dir2) = @_;
 188   local($result, $x);
 189   local(@d1) = split(/\/+/, $dir1);
 190   local(@d2) = split(/\/+/, $dir2);
 191
 192   while (@d1 && @d2 && (($x = shift(@d1)) eq shift(@d2))) {
 193     $result .= "$x/";
 194   }
 195   chop($result);
 196   $result;
 197 }
 198
 199 # Find the relative patch between
 200 # two paths given as arguments.
 201
 202 sub RelativePath {
 203   local($a, $b) = @_;
 204   local($c) = &CommonParent($a, $b);
 205   local(@a) = split(/\/+/, $a);
 206   local(@b) = split(/\/+/, $b);
 207   local(@c) = split(/\/+/, $c);
 208
 209   # if $c == "/something", scalar(@c) >= 2
 210   # but if $c == "/", scalar(@c) == 0
 211   # but we want 1
 212   my $length = scalar(@c) ? scalar(@c) : 1;
 213   splice(@a, 0, $length);
 214   splice(@b, 0, $length);
 215
 216   unshift(@b, (('..') x (@a + 0)));
 217   &JoinPaths(@b);
 218 }
 219
 220 # Basically concatenates the paths given
 221 # as arguments
 222
 223 sub JoinPaths {
 224   local(@paths, @parts);
 225   local ($x, $y);
 226   local($result) = '';
 227
 228   $result = '/' if ($_[0] =~ /^\//);
 229   foreach $x (@_) {
 230     @parts = split(/\/+/, $x);
 231     foreach $y (@parts) {
 232       push(@paths, $y) if ($y ne "");
 233     }
 234   }
 235   $result .= join('/', @paths);
 236 }
 237
 238 sub Unstow {
 239   local($targetdir, $stow) = @_;
 240   local(@contents);
 241   local($content);
 242   local($linktarget, $stowmember, $collection);
 243   local(@stowmember);
 244   local($pure, $othercollection) = (1, '');
 245   local($subpure, $subother);
 246   local($empty) = (1);
 247   local(@puresubdirs);
 248
 249   return (0, '') if (&JoinPaths($Target, $targetdir) eq $Stow);
 250   return (0, '') if (-e &JoinPaths($Target, $targetdir, '.stow'));
 251   warn sprintf("Unstowing in %s\n", &JoinPaths($Target, $targetdir))
 252     if ($Verbose > 1);
 253   if (!opendir(DIR, &JoinPaths($Target, $targetdir))) {
 254     warn "Warning: $ProgramName: Cannot read directory \"$dir\" ($!). Stow might leave some links. If you think, it does. Rerun Stow with appropriate rights.\n";
 255   }
 256   @contents = readdir(DIR);
 257   closedir(DIR);
 258   foreach $content (@contents) {
 259     next if (($content eq '.') || ($content eq '..'));
 260     $empty = 0;
 261     if (-l &JoinPaths($Target, $targetdir, $content)) {
 262       ($linktarget = readlink(&JoinPaths($Target,
 263                                          $targetdir,
 264                                          $content)))
 265         || die sprintf("%s: Cannot read link %s (%s)\n",
 266                        $ProgramName,
 267                        &JoinPaths($Target, $targetdir, $content),
 268                        $!);
 269       if ($stowmember = &FindStowMember(&JoinPaths($Target,
 270                                                    $targetdir),
 271                                         $linktarget)) {
 272         @stowmember = split(/\/+/, $stowmember);
 273         $collection = shift(@stowmember);
 274         if (grep(($collection eq $_), @Collections)) {
 275           &DoUnlink(&JoinPaths($Target, $targetdir, $content));
 276         } elsif ($pure) {
 277           if ($content eq '.dontfold') {
 278             $pure = 0;
 279           } elsif ($othercollection) {
 280             $pure = 0 if ($collection ne $othercollection);
 281           } else {
 282             $othercollection = $collection;
 283           }
 284         }
 285       } else {
 286         $pure = 0;
 287       }
 288     } elsif (-d &JoinPaths($Target, $targetdir, $content)) {
 289       ($subpure, $subother) = &Unstow(&JoinPaths($targetdir, $content),
 290                                       &JoinPaths('..', $stow));
 291       if ($subpure) {
 292         push(@puresubdirs, "$content/$subother");
 293       }
 294       if ($pure) {
 295         if ($subpure) {
 296           if ($othercollection) {
 297             if ($subother) {
 298               if ($othercollection ne $subother) {
 299                 $pure = 0;
 300               }
 301             }
 302           } elsif ($subother) {
 303             $othercollection = $subother;
 304           }
 305         } else {
 306           $pure = 0;
 307         }
 308       }
 309     } else {
 310       $pure = 0;
 311     }
 312   }
 313   # This directory was an initially empty directory therefore
 314   # We do not remove it.
 315   $pure = 0 if $empty;
 316   if ((!$pure || !$targetdir) && @puresubdirs) {
 317     &CoalesceTrees($targetdir, $stow, @puresubdirs);
 318   }
 319   ($pure, $othercollection);
 320 }
 321
 322 sub CoalesceTrees {
 323   local($parent, $stow, @trees) = @_;
 324   local($tree, $collection, $x);
 325
 326   foreach $x (@trees) {
 327     ($tree, $collection) = ($x =~ /^(.*)\/(.*)/);
 328     &EmptyTree(&JoinPaths($Target, $parent, $tree));
 329     &DoRmdir(&JoinPaths($Target, $parent, $tree));
 330     if ($collection) {
 331       &DoLink(&JoinPaths($stow, $collection, $parent, $tree),
 332               &JoinPaths($Target, $parent, $tree));
 333     }
 334   }
 335 }
 336
 337 sub EmptyTree {
 338   local($dir) = @_;
 339   local(@contents);
 340   local($content);
 341
 342   opendir(DIR, $dir)
 343     || die "$ProgramName: Cannot read directory \"$dir\" ($!)\n";
 344   @contents = readdir(DIR);
 345   closedir(DIR);
 346   foreach $content (@contents) {
 347     next if (($content eq '.') || ($content eq '..'));
 348     if (-l &JoinPaths($dir, $content)) {
 349       &DoUnlink(&JoinPaths($dir, $content));
 350     } elsif (-d &JoinPaths($dir, $content)) {
 351       &EmptyTree(&JoinPaths($dir, $content));
 352       &DoRmdir(&JoinPaths($dir, $content));
 353     } else {
 354       &DoUnlink(&JoinPaths($dir, $content));
 355     }
 356   }
 357 }
 358
 359 sub StowContents {
 360   local($dir, $stow) = @_;
 361   local(@contents);
 362   local($content);
 363
 364   warn "Stowing contents of $dir\n" if ($Verbose > 1);
 365   opendir(DIR, &JoinPaths($Stow, $dir))
 366     || die "$ProgramName: Cannot read directory \"$dir\" ($!)\n";
 367   @contents = readdir(DIR);
 368   closedir(DIR);
 369   foreach $content (@contents) {
 370     next if (($content eq '.') || ($content eq '..'));
 371     if (-d &JoinPaths($Stow, $dir, $content)) {
 372       &StowDir(&JoinPaths($dir, $content), $stow);
 373     } else {
 374       &StowNondir(&JoinPaths($dir, $content), $stow);
 375     }
 376   }
 377 }
 378
 379 sub StowDir {
 380   local($dir, $stow) = @_;
 381   local(@dir) = split(/\/+/, $dir);
 382   local($collection) = shift(@dir);
 383   local($subdir) = join('/', @dir);
 384   local($linktarget, $stowsubdir);
 385
 386   warn "Stowing directory $dir\n" if ($Verbose > 1);
 387   if (-l &JoinPaths($Target, $subdir)) {
 388     ($linktarget = readlink(&JoinPaths($Target, $subdir)))
 389       || die sprintf("%s: Could not read link %s (%s)\n",
 390                      $ProgramName,
 391                      &JoinPaths($Target, $subdir),
 392                      $!);
 393     ($stowsubdir =
 394      &FindStowMember(sprintf('%s/%s', $Target,
 395                              join('/', @dir[0..($#dir - 1)])),
 396                      $linktarget))
 397       || (&Conflict($dir, $subdir), return);
 398     if (-e &JoinPaths($Stow, $stowsubdir)) {
 399       if ($stowsubdir eq $dir) {
 400         warn sprintf("%s already points to %s\n",
 401                      &JoinPaths($Target, $subdir),
 402                      &JoinPaths($Stow, $dir))
 403           if ($Verbose > 2);
 404         return;
 405       }
 406       if (-d &JoinPaths($Stow, $stowsubdir)) {
 407         &DoUnlink(&JoinPaths($Target, $subdir));
 408         &DoMkdir(&JoinPaths($Target, $subdir));
 409         &StowContents($stowsubdir, &JoinPaths('..', $stow));
 410         &StowContents($dir, &JoinPaths('..', $stow));
 411       } else {
 412         (&Conflict($dir, $subdir), return);
 413       }
 414     } else {
 415       &DoUnlink(&JoinPaths($Target, $subdir));
 416       &StowNewDir($dir, $stow);
 417     }
 418   } elsif (-e &JoinPaths($Target, $subdir)) {
 419     if (-d &JoinPaths($Target, $subdir)) {
 420       &StowContents($dir, &JoinPaths('..', $stow));
 421     } else {
 422       &Conflict($dir, $subdir);
 423     }
 424   } else {
 425     &StowNewDir($dir, $stow);
 426   }
 427 }
 428
 429 sub StowNewDir {
 430   local($dir, $stow) = @_;
 431   if (-e &JoinPaths($Stow, $dir, '.dontfold')) {
 432     &DoMkdir(&JoinPaths($Target, $subdir));
 433     &StowContents($dir, &JoinPaths('..', $stow));
 434   } else {
 435     &DoLink(&JoinPaths($stow, $dir),
 436             &JoinPaths($Target, $subdir));
 437   }
 438 }
 439
 440 sub StowNondir {
 441   local($file, $stow) = @_;
 442   local(@file) = split(/\/+/, $file);
 443   local($collection) = shift(@file);
 444   local($subfile) = join('/', @file);
 445   local($linktarget, $stowsubfile);
 446
 447   if (-l &JoinPaths($Target, $subfile)) {
 448     ($linktarget = readlink(&JoinPaths($Target, $subfile)))
 449       || die sprintf("%s: Could not read link %s (%s)\n",
 450                      $ProgramName,
 451                      &JoinPaths($Target, $subfile),
 452                      $!);
 453     ($stowsubfile =
 454      &FindStowMember(sprintf('%s/%s', $Target,
 455                              join('/', @file[0..($#file - 1)])),
 456                      $linktarget))
 457       || (&Conflict($file, $subfile), return);
 458     if (-e &JoinPaths($Stow, $stowsubfile)) {
 459       (&Conflict($file, $subfile), return)
 460         unless ($stowsubfile eq $file);
 461       warn sprintf("%s already points to %s\n",
 462                    &JoinPaths($Target, $subfile),
 463                    &JoinPaths($Stow, $file))
 464         if ($Verbose > 2);
 465     } else {
 466       &DoUnlink(&JoinPaths($Target, $subfile));
 467       &DoLink(&JoinPaths($stow, $file),
 468               &JoinPaths($Target, $subfile));
 469     }
 470   } elsif (-e &JoinPaths($Target, $subfile)) {
 471     &Conflict($file, $subfile);
 472   } else {
 473     &DoLink(&JoinPaths($stow, $file),
 474             &JoinPaths($Target, $subfile));
 475   }
 476 }
 477
 478 sub DoUnlink {
 479   local($file) = @_;
 480
 481   warn "UNLINK $file\n" if $Verbose;
 482   (unlink($file) || die "$ProgramName: Could not unlink $file ($!)\n")
 483     unless $NotReally;
 484 }
 485
 486 sub DoRmdir {
 487   local($dir) = @_;
 488
 489   warn "RMDIR $dir\n" if $Verbose;
 490   (rmdir($dir) || die "$ProgramName: Could not rmdir $dir ($!)\n")
 491     unless $NotReally;
 492 }
 493
 494 sub DoLink {
 495   local($target, $name) = @_;
 496
 497   warn "LINK $name to $target\n" if $Verbose;
 498   (symlink($target, $name) ||
 499    die "$ProgramName: Could not symlink $name to $target ($!)\n")
 500     unless $NotReally;
 501 }
 502
 503 sub DoMkdir {
 504   local($dir) = @_;
 505
 506   warn "MKDIR $dir\n" if $Verbose;
 507   (mkdir($dir, 0777)
 508    || die "$ProgramName: Could not make directory $dir ($!)\n")
 509     unless $NotReally;
 510 }
 511
 512 sub Conflict {
 513   local($a, $b) = @_;
 514
 515   if ($Conflicts) {
 516     warn sprintf("CONFLICT: %s vs. %s\n", &JoinPaths($Stow, $a),
 517                  &JoinPaths($Target, $b));
 518   } else {
 519     die sprintf("%s: CONFLICT: %s vs. %s\n",
 520                 $ProgramName,
 521                 &JoinPaths($Stow, $a),
 522                 &JoinPaths($Target, $b));
 523   }
 524 }
 525
 526 sub FindStowMember {
 527   local($start, $path) = @_;
 528   local(@x) = split(/\/+/, $start);
 529   local(@path) = split(/\/+/, $path);
 530   local($x);
 531   local(@d) = split(/\/+/, $Stow);
 532
 533   while (@path) {
 534     $x = shift(@path);
 535     if ($x eq '..') {
 536       pop(@x);
 537       return '' unless @x;
 538     } elsif ($x) {
 539       push(@x, $x);
 540     }
 541   }
 542   while (@x && @d) {
 543     if (($x = shift(@x)) ne shift(@d)) {
 544       return '';
 545     }
 546   }
 547   return '' if @d;
 548   join('/', @x);
 549 }
 550
 551 sub RunPoststowScripts {
 552   local(@scripts);
 553   local($script);
 554   local($psd) = &JoinPaths($Target, 'poststow.d');
 555
 556   if (opendir(PSD, $psd)) {
 557     # good
 558   } elsif ($! eq 'No such file or directory') {
 559     # it doesn't exist, skip this step
 560     warn "Poststow script directory does not exist\n" if $Verbose;
 561     return;
 562   } else {
 563     die "$ProgramName: Cannot read poststow script directory ($!)\n";
 564   }
 565   warn "Running poststow scripts...\n" if $Verbose;
 566   @scripts = readdir(PSD); # XXX Should we define the order?
 567   closedir(PSD);
 568   foreach $script (@scripts) {
 569     next if ($script =~ m/^\./); # catches '.', '..', '.dontfold', and maybe others
 570     warn "Running poststow script '$script'...\n" if $Verbose;
 571     system(&JoinPaths($psd, $script), $Target) == 0 or
 572       warn "Poststow script '$script' failed\n";
 573   }
 574 }
 575
 576 sub parent {
 577   local($path) = join('/', @_);
 578   local(@elts) = split(/\/+/, $path);
 579   pop(@elts);
 580   join('/', @elts);
 581 }
 582
 583 sub usage {
 584   local($msg) = shift;
 585
 586   if ($msg) {
 587     print "$ProgramName: $msg\n";
 588   }
 589   print "$ProgramName (GNU Stow) version $Version\n\n";
 590   print "Usage: $ProgramName [OPTION ...] PACKAGE ...\n";
 591   print <<EOT;
 592   -n, --no              Do not actually make changes
 593   -c, --conflicts       Scan for conflicts, implies -n
 594   -d DIR, --dir=DIR     Set stow dir to DIR (default is current dir)
 595   -t DIR, --target=DIR  Set target to DIR (default is parent of stow dir)
 596   -v, --verbose[=N]     Increase verboseness (levels are 0,1,2,3;
 597                           -v or --verbose adds 1; --verbose=N sets level)
 598   -D, --delete          Unstow instead of stow
 599   -R, --restow          Restow (like stow -D followed by stow)
 600   --poststow-only       Run poststow scripts without (un)stowing any packages
 601   -V, --version         Show Stow version number
 602   -h, --help            Show this help
 603 EOT
 604   exit($msg ? 1 : 0);
 605 }
 606
 607 sub version {
 608   print "$ProgramName (GNU Stow) version $Version\n";
 609   exit(0);
 610 }
 611
 612 # Local variables:
 613 # mode: perl
 614 # End: