#!/usr/local/bin/perl -w
###########################################
# dir-traverse - directory traversal
# Mike Schilli, 2015 (m@perlmeister.com)
###########################################
use strict;
use Test::More;
use Test::Exception;
use File::Temp qw( tempdir );
use Sysadm::Install qw( blurt slurp 
  cd cdback );

my $ROOT_DIR = tempdir( CLEANUP => 1 );

# Read via a relative path while the abso-
# lute path doesn't have traversal rights.
dirmk( "top", 0700 );
dirmk( "top/sub", 0700 );
dirmk( "top/sub/sub1", 0700 );
dirmk( "top/sub/sub2", 0700 );

blurt "content", 
  "$ROOT_DIR/top/sub/sub1/file";
cd "$ROOT_DIR/top/sub/sub2";
chmod 0600, "$ROOT_DIR/top";

throws_ok 
 { slurp( "$ROOT_DIR/top/sub/sub1/file" ) } 
 qr/Permission denied/, "abs path fails";

is slurp( "../sub1/file" ), 
  "content", "rel path ok";

cdback;
done_testing();

###########################################
sub dirmk {
###########################################
  my( $dir, $perm ) = @_;

  my $path = "$ROOT_DIR/$dir";
  mkdir $path or die "$!";
  chmod $perm, $path or die "$!";
}