Add OpenBSD::Unveil, a perl interface to unveil(2)

OK brynet@, bluhm@

3 files changed, 285 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/cpan/OpenBSD-Unveil/Unveil.xs b/gnu/usr.bin/perl/cpan/OpenBSD-Unveil/Unveil.xs
new file mode 100644
index 00000000000..2e5bb7db1a3
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-Unveil/Unveil.xs
@@ -0,0 +1,33 @@
+/*	$OpenBSD: Unveil.xs,v 1.1 2019/07/09 20:41:54 afresh1 Exp $	*/
+
+/*
+ * Copyright (c) 2019 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"
+
+#include <sys/unistd.h>
+
+MODULE = OpenBSD::Unveil		PACKAGE = OpenBSD::Unveil
+
+int
+_unveil(const char * path = NULL, const char * permissions = NULL)
+    CODE:
+	RETVAL = unveil(path, permissions) != -1;
+    OUTPUT:
+	RETVAL
diff --git a/gnu/usr.bin/perl/cpan/OpenBSD-Unveil/lib/OpenBSD/Unveil.pm b/gnu/usr.bin/perl/cpan/OpenBSD-Unveil/lib/OpenBSD/Unveil.pm
new file mode 100644
index 00000000000..e167df0e4e2
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-Unveil/lib/OpenBSD/Unveil.pm
@@ -0,0 +1,95 @@
+#	$OpenBSD: Unveil.pm,v 1.1 2019/07/09 20:41:54 afresh1 Exp $	#
+package OpenBSD::Unveil;
+
+use 5.028;
+use strict;
+use warnings;
+
+use Carp;
+
+use parent 'Exporter';
+our %EXPORT_TAGS = ( 'all' => [qw( unveil )] );
+our @EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} } );
+our @EXPORT      = qw( unveil );                           ## no critic 'export'
+
+our $VERSION = '0.02';
+
+require XSLoader;
+XSLoader::load( 'OpenBSD::Unveil', $VERSION );
+
+sub unveil
+{       ## no critic 'unpack'
+	croak("Usage: OpenBSD::Unveil::unveil([path, permissions])")
+	    unless @_ == 0 || @_ == 2; ## no critic 'postfix'
+	return _unveil(@_);
+}
+
+1;
+
+## no critic 'pod sections'
+__END__
+
+=head1 NAME
+
+OpenBSD::Unveil - Perl interface to OpenBSD unveil(2)
+
+=head1 SYNOPSIS
+
+  use OpenBSD::Unveil;
+
+  my $file = "/usr/share/dict/words";
+  unveil( $file, "r" ) || die "Unable to unveil: $!";
+  unveil() || die "Unable to lock unveil: $!";
+  open my $fh, '<', $file or die "Unable to open $file: $!";
+
+  print grep { /unveil/i } readline($fh);
+  close $fh;
+
+
+=head1 DESCRIPTION
+
+This module provides a perl interface to OpenBSD's L<unveil(2)> L<syscall(2)>.
+
+=head1 EXPORT
+
+Exports L</unveil> by default.
+
+=head1 FUNCTIONS
+
+=head2 unveil
+
+Perl interface to L<unveil(2)>.
+
+	unveil($paths, $permissions)
+	unveil() # to lock
+
+Returns true on success, returns false and sets $! on failure.
+Throws an exception on incorrect number of parameters.
+
+=head1 SEE ALSO
+
+L<unveil(2)>
+
+L<http://man.openbsd.org/unveil.2>
+
+=head1 AUTHOR
+
+Andrew Fresh, E<lt>afresh1@OpenBSD.orgE<gt>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (C) 2019 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-Unveil/t/OpenBSD-Unveil.t b/gnu/usr.bin/perl/cpan/OpenBSD-Unveil/t/OpenBSD-Unveil.t
new file mode 100644
index 00000000000..6fd3c2fdb21
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-Unveil/t/OpenBSD-Unveil.t
@@ -0,0 +1,157 @@
+#	$OpenBSD: OpenBSD-Unveil.t,v 1.1 2019/07/09 20:41:54 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-Unveil.t'
+
+#########################
+
+use strict;
+use warnings;
+
+use Test2::IPC;
+use Test::More;
+
+use Fcntl qw< O_RDONLY O_WRONLY >;
+use File::Temp;
+
+use POSIX qw< :errno_h >;
+
+BEGIN { use_ok('OpenBSD::Unveil') }
+
+#########################
+# UNVEIL
+#########################
+{
+	my @calls;
+	no warnings 'redefine';    ## no critic 'warnings';
+	local *OpenBSD::Unveil::_unveil = sub { push @calls, \@_; return 1 };
+	use warnings 'redefine';
+
+	{
+		local $@;
+		eval { local $SIG{__DIE__};
+		    OpenBSD::Unveil::unveil(qw< ab cx yz >) };
+ 		my $at = sprintf "at %s line %d.\n", __FILE__, __LINE__ - 1;
+		is $@,
+		    "Usage: OpenBSD::Unveil::unveil([path, permissions]) $at",
+		    "Expected exception when too many params"
+	}
+
+	{
+		local $@;
+		eval { local $SIG{__DIE__};
+		    OpenBSD::Unveil::unveil(qw< ab >) };
+ 		my $at = sprintf "at %s line %d.\n", __FILE__, __LINE__ - 1;
+		is $@,
+		    "Usage: OpenBSD::Unveil::unveil([path, permissions]) $at",
+		    "Expected exception when not enough params"
+	}
+
+	ok OpenBSD::Unveil::unveil( qw< foo bar > ), "Used two args";
+	ok OpenBSD::Unveil::unveil(),                "Used zero args";
+
+	is_deeply \@calls, [ [ qw< foo bar > ], [] ],
+	    "No modification to params";
+}
+
+## no critic 'private'
+## no critic 'punctuation'
+#########################
+# _UNVEIL
+#########################
+
+sub xsunveil_ok ($$)    ## no critic 'prototypes'
+{
+	my ( $name, $code ) = @_;
+	local $Test::Builder::Level =
+	    $Test::Builder::Level + 1;    ## no critic 'package variable'
+
+	my $pid = fork // die "Unable to fork for $name: $!\n";
+
+	if ( !$pid ) {
+		# for Test2::IPC
+		OpenBSD::Unveil::_unveil('/tmp', 'rwc') || die $!;
+		subtest $name, $code;
+		exit 0;
+	}
+
+	waitpid $pid, 0;
+	return $? >> 8;
+}
+
+
+xsunveil_ok "Basic Usage" => sub {
+	ok OpenBSD::Unveil::_unveil('/dev/random', 'r'),
+	    "Unveiled /dev/random r";
+	ok OpenBSD::Unveil::_unveil('/dev/null',   'wc'),
+	    "Unvailed /dev/null wc";
+
+	ok !-e '/dev/zero',   "Can't see /dev/zero";
+	ok !-w '/dev/random', "Can't write to /dev/random";
+	ok !-r '/dev/null',   "Can't read from /dev/null";
+
+	ok open(my $rfh, '<', '/dev/random'), "Opened /dev/random for reading";
+	ok read( $rfh, my $data, 64),         "Read from /dev/random";
+	ok close($rfh),                       "Closed /dev/random";
+
+	{
+		ok open(my $wfh, '>', '/dev/null'),
+		                              "Opened /dev/null for writing";
+		ok print($wfh $data),         "Printed to /dev/null";
+		ok close($wfh),               "Closed /dev/null";
+	}
+
+	ok OpenBSD::Unveil::_unveil('/dev/null',   'w'),
+	    "Unvailed /dev/null w";
+	ok OpenBSD::Unveil::_unveil(),
+		"locked unveil";
+
+	{
+		ok sysopen(my $wfh, '/dev/null', O_WRONLY),
+		                              "Sysopened /dev/null for writing";
+		ok syswrite($wfh, $data),     "Wrote to /dev/null";
+		ok close($wfh),               "Closed /dev/null";
+	}
+
+	{
+		ok !open(my $wfh, '>', '/dev/null'),
+			"Unable to 'open' without 'create'";
+	}
+};
+
+xsunveil_ok "Invalid Path" => sub {
+	chdir "/tmp" or die "Unable to chdir to /tmp";
+	my $dir = File::Temp->newdir('OpenBSD-Unveil-XXXXXXXXX');
+	ok !OpenBSD::Unveil::_unveil("$dir/nonexist/file", 'r'),
+	    "Unable to unveil with incorrect permissions";
+	is $!, 'No such file or directory', "Expected ERRNO from _unveil";
+};
+
+xsunveil_ok "Invalid Permissions" => sub {
+	ok !OpenBSD::Unveil::_unveil('/dev/null', 'abc'),
+	    "Unable to unveil with incorrect permissions";
+	is $!, 'Invalid argument', "Expected ERRNO from _unveil";
+};
+
+xsunveil_ok "Try to increase permissions" => sub {
+	ok OpenBSD::Unveil::_unveil('/dev/null', 'r'),
+	    "Set /dev/null to r";
+	TODO: { local $TODO = "Not sure why this fails";
+	ok !OpenBSD::Unveil::_unveil('/dev/null', 'rwc'),
+	    "Unable to increase permissions on /dev/null";
+	is $!, 'Operation not permitted', "Expected ERRNO from _unveil";
+	}
+};
+
+xsunveil_ok "Try to change veil after lock" => sub {
+	ok OpenBSD::Unveil::_unveil(), "Locked unveil";
+	ok !OpenBSD::Unveil::_unveil('/dev/null', 'r'),
+	    "Unable to unveil after lock";
+	is $!, 'Operation not permitted', "Expected ERRNO from _unveil";
+};
+
+#########################
+done_testing;
+
+1;    # to shut up critic