On Sat, Jul 06, 2019 at 03:27:04PM -0700, Andrew Hewus Fresh wrote:
> 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?

I think this is cool, and could be helpful for some perl scripts, same
as OpenBSD::Pledge(3p), perhaps more so.

ok brynet@

> 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 <afre...@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
> 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>afre...@openbsd.orge<gt>
> +
> +=head1 LICENSE AND COPYRIGHT
> +
> +Copyright (C) 2019 by Andrew Hewus Fresh E<lt>afre...@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
> 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

Reply via email to