Remove path support from perl OpenBSD::Pledge

ok guenther@ deraadt@ giovanni@

3 files changed, 31 insertions, 87 deletions

diff --git a/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/Pledge.xs b/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/Pledge.xs
index 446868fce83..c2bec57a86b 100644
--- a/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/Pledge.xs
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/Pledge.xs
@@ -1,4 +1,4 @@
-/*	$OpenBSD: Pledge.xs,v 1.1 2015/11/29 19:01:27 afresh1 Exp $	*/
+/*	$OpenBSD: Pledge.xs,v 1.2 2017/09/09 14:53:57 afresh1 Exp $	*/
 
 /*
  * Copyright (c) 2015 Andrew Fresh <afresh1@openbsd.org>
@@ -38,27 +38,8 @@ pledgenames()
 	XSRETURN(i);
 
 int
-_pledge(const char * promises, SV * paths)
-    INIT:
-	SSize_t numpaths = 0, n;
-
+_pledge(const char * promises)
     CODE:
-	if (SvOK(paths)) {
-		if (SvTYPE(SvRV(paths)) != SVt_PVAV)
-			croak("not an ARRAY reference");
-
-		numpaths = av_top_index((AV *)SvRV(paths));
-
-		const char *pledge_paths[ numpaths + 1 ];
-		pledge_paths[ numpaths + 1 ] = NULL;
-
-		for (n = 0; n <= numpaths; n++)
-			pledge_paths[n]
-			    = SvPV_nolen(*av_fetch((AV *)SvRV(paths), n, 0));
-
-		RETVAL = pledge(promises, pledge_paths) != -1;
-	}
-	else
-		RETVAL = pledge(promises, NULL) != -1;
+	RETVAL = pledge(promises, NULL) != -1;
     OUTPUT:
 	RETVAL
diff --git a/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/lib/OpenBSD/Pledge.pm b/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/lib/OpenBSD/Pledge.pm
index 0882e13c689..a1d0dbacd91 100644
--- a/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/lib/OpenBSD/Pledge.pm
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/lib/OpenBSD/Pledge.pm
@@ -1,4 +1,4 @@
-#	$OpenBSD: Pledge.pm,v 1.2 2016/07/03 01:07:57 afresh1 Exp $	#
+#	$OpenBSD: Pledge.pm,v 1.3 2017/09/09 14:53:57 afresh1 Exp $	#
 package OpenBSD::Pledge;
 
 use 5.020002;
@@ -10,7 +10,7 @@ our %EXPORT_TAGS = ( 'all' => [qw( pledge pledgenames )] );
 our @EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} } );
 our @EXPORT      = qw( pledge );                           ## no critic 'export'
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 require XSLoader;
 XSLoader::load( 'OpenBSD::Pledge', $VERSION );
@@ -19,14 +19,11 @@ sub pledge
 {
 	my (@promises) = @_;
 
-	my $paths;
-	$paths = pop @promises if @promises and ref $promises[-1] eq 'ARRAY';
-
 	my %seen;
 	my $promises = join q{ },
 	    sort grep { !$seen{$_}++ } ( 'stdio', @promises );
 
-	return _pledge( $promises, $paths );
+	return _pledge( $promises );
 }
 
 1;
@@ -41,15 +38,16 @@ OpenBSD::Pledge - Perl interface to OpenBSD pledge(2)
 =head1 SYNOPSIS
 
   use OpenBSD::Pledge;
+
   my $file = "/usr/share/dict/words";
-  pledge(qw( rpath ), [$file]) || die "Unable to pledge: $!";
+  pledge( qw( rpath ) ) || die "Unable to pledge: $!";
+  open my $fh, '<', $file or die "Unable to open $file: $!";
 
-  open my $fh, '<', $file or die "Unable to open $file: $!\n";
-  while ( readline($fh) ) {
-    print if /pledge/i;
-  }
+  pledge() || die "Unable to pledge again: $!";
+  print grep { /pledge/i } readline($fh);
   close $fh;
 
+
 =head1 DESCRIPTION
 
 This module provides a perl interface to OpenBSD's L<pledge(2)> L<syscall(2)>.
@@ -58,33 +56,31 @@ Once you promise that your program will only use certain syscalls
 the kernel will kill the program if it attempts to call any other
 interfaces.
 
-=head2 EXPORT
+=head1 EXPORT
 
 Exports L</pledge> by default.
 
 C<:all> will also export L</pledgenames>
 
-=head1 METHODS
+=head1 FUNCTIONS
 
-=head2 pledge(@promises, [\@paths])
+=head2 pledge
 
-With L<pledge(2)> you can promise what abilities your program will need.
-You can pledge multiple times with more restrictive promises,
-but abilities can never be regained.
+Perl interface to L<pledge(2)>.
 
-This interface always promises C<stdio> because L<perl(1)> itself uses some of
-the provided system calls.
+	pledge(@promises)
 
-You can supply an optional array reference of paths to be used as a whitelist,
-all other paths will appear not to exist.
-You may only limit the paths once.
+The "stdio" promise is always implied,
+as L<perl(1)> itself is useless without it.
 
-Returns true on success, returns false and sets C<$!> on failure.
+Returns true on success, returns false and sets $! on failure
 
 =head2 pledgenames
 
 Returns a list of the possible promises you can pass to L</pledge>.
 
+=back
+
 =head1 BUGS AND LIMITATIONS
 
 Perl is particularly fond of C<stdio> so that promise is always added by
diff --git a/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/t/OpenBSD-Pledge.t b/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/t/OpenBSD-Pledge.t
index 6068f774dc9..b63f9109851 100644
--- a/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/t/OpenBSD-Pledge.t
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/t/OpenBSD-Pledge.t
@@ -1,4 +1,4 @@
-#	$OpenBSD: OpenBSD-Pledge.t,v 1.2 2016/07/03 01:07:58 afresh1 Exp $	#
+#	$OpenBSD: OpenBSD-Pledge.t,v 1.3 2017/09/09 14:53:57 afresh1 Exp $	#
 ## no critic 'version'
 ## no critic 'package'
 # Before 'make install' is performed this script should be runnable with
@@ -10,6 +10,7 @@ use strict;
 use warnings;
 
 use Fcntl qw( O_RDONLY O_WRONLY );
+use File::Temp;
 
 use Config;
 my %sig_num;
@@ -47,11 +48,13 @@ sub xspledge_ok ($$)    ## no critic 'prototypes'
 
 	my $ok = 0;
 	foreach my $pledge ( q{}, $name ) {
+		my $dir = File::Temp->newdir('OpenBSD-Pledge-XXXXXXXXX');
 		my $pid = fork // die "Unable to fork for $name: $!\n";
 
 		if ( !$pid ) {
-			OpenBSD::Pledge::_pledge( "abort", undef );  # non fatal
-			OpenBSD::Pledge::_pledge( "stdio $pledge", undef )
+			chdir($dir);
+			OpenBSD::Pledge::_pledge( "abort" );  # non fatal
+			OpenBSD::Pledge::_pledge( "stdio $pledge" )
 			    || die "[$name] $!\n";
 			$code->();
 			exit;
@@ -66,8 +69,6 @@ sub xspledge_ok ($$)    ## no critic 'prototypes'
 			$ok += is $? & 127, $sig_num{ABRT},
 			    "[$name] ABRT without pledge";
 		}
-
-		unlink 'perl.core';
 	}
 	return $ok == 2;
 }
@@ -76,40 +77,6 @@ xspledge_ok wpath => sub { sysopen my $fh, 'FOO',         O_WRONLY };
 xspledge_ok cpath => sub { mkdir q{/} };
 
 #########################
-# _PLEDGE with rpath
-#########################
-
-eval { OpenBSD::Pledge::_pledge( q{}, {} ) } && fail "Should have died";
-like $@, qr/not an ARRAY reference/ms, "Correct error for non arrayref";
-
-TODO:
-{
-local $TODO = 'Path support is disabled for now';
-	my $pid = fork // die "Unable to fork: $!\n";
-
-	if ( !$pid ) {
-		OpenBSD::Pledge::_pledge( "stdio rpath",
-			[ "/tmp", "/usr/bin/perl" ] )
-		    || die "Path pledge failed: $!\n";
-
-		-e "/tmp"          or die "# Can't read /tmp\n";
-		-e "/usr"          or die "# Can't read /usr\n";
-		-e "/usr/bin"      or die "# Can't read /usr/bin\n";
-		-e "/usr/bin/perl" or die "# Can't read /usr/bin/perl\n";
-
-		-e "/usr/bin/awk" and die "# Can't read /usr/bin/awk\n";
-		-e "/usr/local"   and die "# Can read /usr/local\n";
-		-e "/var"         and die "# Can read /var\n";
-		-e "/var/log"     and die "# Can read /var/log\n";
-
-		exit;
-	}
-
-	waitpid $pid, 0;
-	is $?, 0, "OK with pledge";
-}
-
-#########################
 # PLEDGE
 #########################
 {
@@ -119,12 +86,12 @@ local $TODO = 'Path support is disabled for now';
 	use warnings 'redefine';
 
 	OpenBSD::Pledge::pledge(qw( foo bar foo baz ));
-	OpenBSD::Pledge::pledge( qw( foo qux baz quux ), ["/tmp"] );
+	OpenBSD::Pledge::pledge( qw( foo qux baz quux ));
 
 	is_deeply \@calls,
 	    [
-		[ "bar baz foo stdio", undef ],
-		[ "baz foo quux qux stdio", ["/tmp"] ],
+		[ "bar baz foo stdio" ],
+		[ "baz foo quux qux stdio" ],
 	    ],
 	    "Sorted and unique promises, plus stdio";
 }