OpenBSD::Pledge - perl interface to pledge(2)

okay espie@ "we should be wary" deraadt@

3 files changed, 316 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/Pledge.xs b/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/Pledge.xs
new file mode 100644
index 00000000000..446868fce83
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/Pledge.xs
@@ -0,0 +1,64 @@
+/*	$OpenBSD: Pledge.xs,v 1.1 2015/11/29 19:01:27 afresh1 Exp $	*/
+
+/*
+ * Copyright (c) 2015 Andrew Fresh <afresh1@openbsd.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+
+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define PLEDGENAMES
+#include <sys/pledge.h>
+
+MODULE = OpenBSD::Pledge		PACKAGE = OpenBSD::Pledge
+
+AV *
+pledgenames()
+    INIT:
+	int i;
+    CODE:
+	for (i = 0; pledgenames[i].bits != 0; i++)
+		XPUSHs( sv_2mortal(
+		     newSVpv(pledgenames[i].name, strlen(pledgenames[i].name))
+		) );
+	XSRETURN(i);
+
+int
+_pledge(const char * promises, SV * paths)
+    INIT:
+	SSize_t numpaths = 0, n;
+
+    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;
+    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
new file mode 100644
index 00000000000..129a77d2a0c
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/lib/OpenBSD/Pledge.pm
@@ -0,0 +1,119 @@
+#	$OpenBSD: Pledge.pm,v 1.1 2015/11/29 19:01:27 afresh1 Exp $	#
+package OpenBSD::Pledge;
+
+use 5.020002;
+use strict;
+use warnings;
+
+use parent 'Exporter';
+our %EXPORT_TAGS = ( 'all' => [qw( pledge pledgenames )] );
+our @EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} } );
+our @EXPORT      = qw( pledge );                           ## no critic 'export'
+
+our $VERSION = '0.01';
+
+require XSLoader;
+XSLoader::load( 'OpenBSD::Pledge', $VERSION );
+
+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 );
+}
+
+1;
+
+## no critic 'pod sections'
+__END__
+
+=head1 NAME
+
+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: $!";
+
+  open my $fh, '<', $file or die "Unable to open $file: $!\n";
+  while ( readline($fh) ) {
+    print if /pledge/i;
+  }
+  close $fh;
+
+=head1 DESCRIPTION
+
+This module provides a perl interface to OpenBSD's L<pledge(2)> L<syscall(2)>.
+
+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
+
+Exports L</pledge> by default.
+
+C<:all> will also export L</pledgenames>
+
+=head1 METHODS
+
+=head2 pledge(@promises, [\@paths])
+
+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.
+
+This interface always promises C<stdio> because L<perl(1)> itself uses some of
+the provided system calls.
+
+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.
+
+Returns true on success, returns false and sets C<$!> on failure.
+
+=head2 pledgenames
+
+Returns a list of the possible promises you can pass to L</pledge>.
+
+=head1 BUGS AND LIMITATIONS
+
+Perl is particularly fond of C<stdio> so that promise is always added by
+L</pledge>.
+
+=head1 SEE ALSO
+
+L<pledge(2)>
+
+L<http://www.openbsd.org/cgi-bin/man.cgi/OpenBSD-current/man2/pledge.2>
+
+=head1 AUTHOR
+
+Andrew Fresh, E<lt>afresh1@OpenBSD.orgE<gt>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (C) 2015 by Andrew Fresh E<lt>afresh1@OpenBSD.orgE<gt>
+
+Permission to use, copy, modify, and distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+=cut
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
new file mode 100644
index 00000000000..1a3791a7998
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-Pledge/t/OpenBSD-Pledge.t
@@ -0,0 +1,133 @@
+#	$OpenBSD: OpenBSD-Pledge.t,v 1.1 2015/11/29 19:01:27 afresh1 Exp $	#
+## no critic 'version'
+## no critic 'package'
+# Before 'make install' is performed this script should be runnable with
+# 'make test'. After 'make install' it should work as 'perl OpenBSD-Pledge.t'
+
+#########################
+
+use strict;
+use warnings;
+
+use Fcntl qw( O_RDONLY O_WRONLY );
+
+use Config;
+my %sig_num;
+@sig_num{ split q{ }, $Config{sig_name} } = split q{ }, $Config{sig_num};
+
+use Test::More;
+BEGIN { use_ok('OpenBSD::Pledge') }
+
+## no critic 'private'
+## no critic 'punctuation'
+#########################
+# PLEDGENAMES
+#########################
+
+# Here we just test that we get a small subset of names back
+# because there is no point in failing if someone adds new names.
+
+my %names = map { $_ => 1 } OpenBSD::Pledge::pledgenames();
+ok $names{$_}, "$_ pledge name exists" for qw(
+    stdio
+    rpath
+    wpath
+    cpath
+);
+
+#########################
+# _PLEDGE
+#########################
+
+sub xspledge_ok ($$)    ## no critic 'prototypes'
+{
+	my ( $name, $code ) = @_;
+	local $Test::Builder::Level =
+	    $Test::Builder::Level + 1;    ## no critic 'package variable'
+
+	my $ok = 0;
+	foreach my $pledge ( q{}, $name ) {
+		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 )
+			    || die "[$name] $!\n";
+			$code->();
+			exit;
+		}
+
+		waitpid $pid, 0;
+
+		if ($pledge) {
+			$ok += is $?, 0, "[$name] OK with pledge";
+		} else {
+			## no critic 'numbers'
+			$ok += is $? & 127, $sig_num{ABRT},
+			    "[$name] ABRT without pledge";
+		}
+
+		unlink 'perl.core';
+	}
+	return $ok == 2;
+}
+xspledge_ok rpath => sub { sysopen my $fh, '/dev/random', O_RDONLY };
+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";
+
+{
+	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
+#########################
+{
+	my @calls;
+	no warnings 'redefine';    ## no critic 'warnings';
+	local *OpenBSD::Pledge::_pledge = sub { push @calls, \@_; return 1 };
+	use warnings 'redefine';
+
+	OpenBSD::Pledge::pledge(qw( foo bar foo baz ));
+	OpenBSD::Pledge::pledge( qw( foo qux baz quux ), ["/tmp"] );
+
+	is_deeply \@calls,
+	    [
+		[ "bar baz foo stdio", undef ],
+		[ "baz foo quux qux stdio", ["/tmp"] ],
+	    ],
+	    "Sorted and unique promises, plus stdio";
+}
+
+#########################
+done_testing;
+
+1;    # to shut up critic