/usr/bin/chkstow is in stow 2.2.0-2.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | #!/usr/bin/perl
use strict;
use warnings;
require 5.6.1;
use File::Find;
use Getopt::Long;
my $DEFAULT_TARGET = '/usr/local/';
our $Wanted = \&bad_links;
our %Package = ();
our $Stow_dir = '';
our $Target = $DEFAULT_TARGET;
# put the main loop into a block so that tests can load this as a module
if ( not caller() ) {
if (@ARGV == 0) {
usage();
}
process_options();
#check_stow($Target, $Wanted);
check_stow();
}
sub process_options {
GetOptions(
'b|badlinks' => sub { $Wanted = \&bad_links },
'a|aliens' => sub { $Wanted = \&aliens },
'l|list' => sub { $Wanted = \&list },
't|target=s' => \$Target,
) or usage();
return;
}
sub usage {
print <<"EOT";
USAGE: chkstow [options]
Options:
-t DIR, --target=DIR Set the target directory to DIR
(default is $DEFAULT_TARGET)
-b, --badlinks Report symlinks that point to non-existent files
-a, --aliens Report non-symlinks in the target directory
-l, --list List packages in the target directory
--badlinks is the default mode.
EOT
exit(0);
}
sub check_stow {
#my ($Target, $Wanted) = @_;
my (%options) = (
wanted => $Wanted,
preprocess => \&skip_dirs,
);
find(\%options, $Target);
if ($Wanted == \&list) {
delete $Package{''};
delete $Package{'..'};
if (keys %Package) {
print map "$_\n", sort(keys %Package);
}
}
return;
}
sub skip_dirs {
# skip stow source and unstowed targets
if (-e ".stow" || -e ".notstowed" ) {
warn "skipping $File::Find::dir\n";
return ();
}
else {
return @_;
}
}
# checking for files that do not link to anything
sub bad_links {
-l && !-e && print "Bogus link: $File::Find::name\n";
}
# checking for files that are not owned by stow
sub aliens {
!-l && !-d && print "Unstowed file: $File::Find::name\n";
}
# just list the packages in the the target directory
# FIXME: what if the stow dir is not called 'stow'?
sub list {
if (-l) {
$_ = readlink;
s{\A(?:\.\./)+stow/}{}g;
s{/.*}{}g;
$Package{$_} = 1;
}
}
1; # Hey, it's a module!
# Local variables:
# mode: perl
# cperl-indent-level: 4
# End:
# vim: ft=perl
|