>From b3d63d2503a0325adfd04e9292f67e62f7b28e02 Mon Sep 17 00:00:00 2001
From: shak-mar <address@hidden>
Date: Thu, 11 Feb 2016 18:18:02 +0100
Subject: [PATCH 1/2] Add --stowdir option to chkstow

---
 bin/chkstow.in | 20 +++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

diff --git a/bin/chkstow.in b/bin/chkstow.in
index c35ba26..30e72b0 100755
--- a/bin/chkstow.in
+++ b/bin/chkstow.in
@@ -5,7 +5,9 @@ use warnings;
 
 require 5.006_001;
 
+use Cwd;
 use File::Find;
+use File::Spec;
 use Getopt::Long;
 
 my $DEFAULT_TARGET = '/usr/local/';
@@ -14,6 +16,8 @@ our $Wanted   = \&bad_links;
 our %Package  = ();
 our $Stow_dir = '';
 our $Target   = $DEFAULT_TARGET;
+our $Stowdir  = '/';
+our $TopCwd   = Cwd::cwd();
 
 # put the main loop into a block so that tests can load this as a module
 if ( not caller() ) {
@@ -31,7 +35,13 @@ sub process_options {
 	'a|aliens'   => sub { $Wanted = \&aliens    },
 	'l|list'     => sub { $Wanted = \&list      },
 	't|target=s' => \$Target,
+	's|stowdir=s' => \$Stowdir,
 	) or usage();
+    if ($Stowdir and $Wanted != \&bad_links) {
+        print "Only use --stowdir with --badlinks!\n";
+        usage ();
+    }
+    $Stowdir = File::Spec->rel2abs($Stowdir);
     return;
 }
 
@@ -45,6 +55,8 @@ Options:
     -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
+    -s DIR, --stowdir=DIR Ignore bad links to files outside of this directory
+                          (default is "/", so no links are ignored)
 
 --badlinks is the default mode.
 EOT
@@ -85,7 +97,13 @@ sub skip_dirs {
 
 # checking for files that do not link to anything
 sub bad_links {
-    -l && !-e && print "Bogus link: $File::Find::name\n";
+    if (-l && !-e) {
+        my $relpath = $File::Find::name;
+        my $abspath = join('/', $TopCwd, $relpath);
+        my $rel_from_stow = File::Spec->abs2rel(readlink $abspath, $Stowdir);
+        index($rel_from_stow, "..") == 0 && return;
+        print "Bogus link: $relpath\n";
+    }
 }
 
 # checking for files that are not owned by stow
-- 
2.7.0