Matt McCutchen's Web Site / utils / utils.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Import updates to some utilities that were sitting in my personal bin
[utils/utils.git] / stow
CommitLineData
273c3903
MM		 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
36require 5.005;
37use POSIX;
38use 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
57while (@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
131if ($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;
139if ($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
146chdir($current_dir) || die "Your directory does not seem to exist anymore ($!)\n";
147
148unless ($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
160chdir($Target) || die "Cannot chdir to target tree $Target ($!)\n";
161$Target = &getcwd;
162
163foreach $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
170if (!$PoststowOnly && ($Delete || $Restow)) {
171 @Collections = @ARGV;
172 &Unstow('', &RelativePath($Target, $Stow));
173}
174
175if (!$PoststowOnly && (!$Delete || $Restow)) {
176 foreach $Collection (@ARGV) {
177 warn "Stowing package $Collection...\n" if $Verbose;
178 &StowContents($Collection, &RelativePath($Target, $Stow));
179 }
180}
181
182if (!$NotReally) {
183 &RunPoststowScripts();
184}
185
186sub 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
202sub 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
223sub 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
238sub 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
322sub 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
337sub 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
359sub 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
379sub 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
429sub 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
440sub 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
478sub 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
486sub 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
494sub 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
503sub 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
512sub 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
526sub 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
551sub 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
576sub parent {
577 local($path) = join('/', @_);
578 local(@elts) = split(/\/+/, $path);
579 pop(@elts);
580 join('/', @elts);
581}
582
583sub 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
603EOT
604 exit($msg ? 1 : 0);
605}
606
607sub version {
608 print "$ProgramName (GNU Stow) version $Version\n";
609 exit(0);
610}
611
612# Local variables:
613# mode: perl
614# End:
Matt McCutchen's assorted Linux utilities