I wrote up a tiny unveil(2) wrapper for perl, similar to the pledge(2) wrapper we have in tree. It passes the tests I wrote, but it's entirely possible I'm doing something terrible wrong.
But, I think it could be useful, OK to commit, comments? l8rZ, -- andrew - http://afresh1.com Speed matters. Almost as much as some things, and nowhere near as much as others. -- Nick Holland
Index: gnu/usr.bin/perl/MANIFEST =================================================================== RCS file: /tmp/perl/cvs/src/gnu/usr.bin/perl/MANIFEST,v retrieving revision 1.52 diff -u -p -u -p -r1.52 MANIFEST --- gnu/usr.bin/perl/MANIFEST 24 May 2019 21:33:50 -0000 1.52 +++ gnu/usr.bin/perl/MANIFEST 6 Jul 2019 22:00:52 -0000 @@ -1558,6 +1558,9 @@ cpan/OpenBSD-MkTemp/t/OpenBSD-MkTemp.t O cpan/OpenBSD-Pledge/lib/OpenBSD/Pledge.pm OpenBSD::Pledge cpan/OpenBSD-Pledge/Pledge.xs OpenBSD::Pledge cpan/OpenBSD-Pledge/t/OpenBSD-Pledge.t OpenBSD::Pledge test file +cpan/OpenBSD-Unveil/lib/OpenBSD/Unveil.pm OpenBSD::Unveil +cpan/OpenBSD-Unveil/t/OpenBSD-Unveil.t OpenBSD::Unveil test file +cpan/OpenBSD-Unveil/Unveil.xs OpenBSD::Unveil cpan/Params-Check/lib/Params/Check.pm Params::Check cpan/Params-Check/t/01_Params-Check.t Params::Check tests cpan/parent/lib/parent.pm Establish an ISA relationship with base classes at compile time Index: gnu/usr.bin/perl/cpan/OpenBSD-Unveil/Unveil.xs =================================================================== RCS file: gnu/usr.bin/perl/cpan/OpenBSD-Unveil/Unveil.xs diff -N gnu/usr.bin/perl/cpan/OpenBSD-Unveil/Unveil.xs --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ gnu/usr.bin/perl/cpan/OpenBSD-Unveil/Unveil.xs 6 Jul 2019 22:00:53 -0000 @@ -0,0 +1,33 @@ +/* $OpenBSD$ */ + +/* + * Copyright (c) 2019 Andrew Hewus Fresh <[email protected]> + * + * 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 Index: gnu/usr.bin/perl/cpan/OpenBSD-Unveil/lib/OpenBSD/Unveil.pm =================================================================== RCS file: gnu/usr.bin/perl/cpan/OpenBSD-Unveil/lib/OpenBSD/Unveil.pm diff -N gnu/usr.bin/perl/cpan/OpenBSD-Unveil/lib/OpenBSD/Unveil.pm --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ gnu/usr.bin/perl/cpan/OpenBSD-Unveil/lib/OpenBSD/Unveil.pm 6 Jul 2019 22:00:53 -0000 @@ -0,0 +1,95 @@ +# $OpenBSD$ # +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 Hewus Fresh, E<lt>[email protected]<gt> + +=head1 LICENSE AND COPYRIGHT + +Copyright (C) 2019 by Andrew Hewus Fresh E<lt>[email protected]<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 Index: gnu/usr.bin/perl/cpan/OpenBSD-Unveil/t/OpenBSD-Unveil.t =================================================================== RCS file: gnu/usr.bin/perl/cpan/OpenBSD-Unveil/t/OpenBSD-Unveil.t diff -N gnu/usr.bin/perl/cpan/OpenBSD-Unveil/t/OpenBSD-Unveil.t --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ gnu/usr.bin/perl/cpan/OpenBSD-Unveil/t/OpenBSD-Unveil.t 6 Jul 2019 22:00:53 -0000 @@ -0,0 +1,157 @@ +# $OpenBSD$ # +## 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
