This allows tame(2) to be used from perl. I almost never write perl and
this is my first time using perl-XS, so apologies if anything is wrong.
I'm not sure how generally useful this will be currently in the base
system, so this may be premature, but if we want it later this should
hopefully give us a good base to start.
Thanks to guenther@, most of the perl-XS specific stuff is taken from his
work on OpenBSD::MkTemp.
Thoughts?
Thanks,
Jeremy
Index: gnu/usr.bin/perl/cpan/OpenBSD-Tame/README
===================================================================
RCS file: gnu/usr.bin/perl/cpan/OpenBSD-Tame/README
diff -N gnu/usr.bin/perl/cpan/OpenBSD-Tame/README
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ gnu/usr.bin/perl/cpan/OpenBSD-Tame/README 21 Jul 2015 17:01:16 -0000
@@ -0,0 +1,28 @@
+OpenBSD-Tame version 0.01
+===========================
+
+A simple wrapper for the tame(2) system call for restricting
+system operations.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+None.
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2015 by Jeremy Evans
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.12.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+
Index: gnu/usr.bin/perl/cpan/OpenBSD-Tame/Tame.xs
===================================================================
RCS file: gnu/usr.bin/perl/cpan/OpenBSD-Tame/Tame.xs
diff -N gnu/usr.bin/perl/cpan/OpenBSD-Tame/Tame.xs
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ gnu/usr.bin/perl/cpan/OpenBSD-Tame/Tame.xs 21 Jul 2015 18:26:52 -0000
@@ -0,0 +1,39 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <sys/tame.h>
+
+MODULE = OpenBSD::Tame PACKAGE = OpenBSD::Tame
+
+# result = tame_real(0);
+int
+tame_real(int flags)
+ CODE:
+ RETVAL = tame(flags | TAME_MALLOC);
+ OUTPUT:
+ RETVAL
+
+# %fh = tame_flags_map( )
+SV *
+tame_flags_map()
+ INIT:
+ HV * rh;
+ rh = (HV *)sv_2mortal((SV *)newHV());
+ CODE:
+ hv_store(rh, "abort", 5, newSVnv(TAME_ABORT), 0);
+ hv_store(rh, "cmsg", 4, newSVnv(TAME_CMSG), 0);
+ hv_store(rh, "cpath", 5, newSVnv(TAME_CPATH), 0);
+ hv_store(rh, "dns", 3, newSVnv(TAME_DNS), 0);
+ hv_store(rh, "getpw", 5, newSVnv(TAME_GETPW), 0);
+ hv_store(rh, "inet", 4, newSVnv(TAME_INET), 0);
+ hv_store(rh, "ioctl", 5, newSVnv(TAME_IOCTL), 0);
+ hv_store(rh, "proc", 4, newSVnv(TAME_PROC), 0);
+ hv_store(rh, "rpath", 5, newSVnv(TAME_RPATH), 0);
+ hv_store(rh, "rw", 2, newSVnv(TAME_RW), 0);
+ hv_store(rh, "tmppath", 7, newSVnv(TAME_TMPPATH), 0);
+ hv_store(rh, "unix", 4, newSVnv(TAME_UNIX), 0);
+ hv_store(rh, "wpath", 5, newSVnv(TAME_WPATH), 0);
+ RETVAL = newRV((SV *)rh);
+ OUTPUT:
+ RETVAL
Index: gnu/usr.bin/perl/cpan/OpenBSD-Tame/lib/OpenBSD/Tame.pm
===================================================================
RCS file: gnu/usr.bin/perl/cpan/OpenBSD-Tame/lib/OpenBSD/Tame.pm
diff -N gnu/usr.bin/perl/cpan/OpenBSD-Tame/lib/OpenBSD/Tame.pm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ gnu/usr.bin/perl/cpan/OpenBSD-Tame/lib/OpenBSD/Tame.pm 21 Jul 2015
17:52:39 -0000
@@ -0,0 +1,81 @@
+package OpenBSD::Tame;
+
+use 5.012002;
+use strict;
+use warnings;
+
+use Exporter 'import';
+use Carp;
+
+our @EXPORT_OK = qw( tame );
+our @EXPORT = qw( tame );
+our $VERSION = '0.01';
+
+require XSLoader;
+XSLoader::load('OpenBSD::Tame', $VERSION);
+
+my $flags_map = tame_flags_map();
+
+sub tame
+{
+ my $tame_flags = 0;
+
+ foreach my $flag (@_) {
+ $tame_flags |= $flags_map->{$flag} || croak("invalid tame option: $flag");
+ }
+
+ tame_real($tame_flags) >= 0 || croak("attempt to raise tame permissions");
+}
+
+1;
+__END__
+=head1 NAME
+
+OpenBSD::Tame - Perl access to tame()
+
+=head1 SYNOPSIS
+
+ use OpenBSD::Tame;
+
+ tame("abort", "rpath")
+ tame("rpath", "cpath", "wpath")
+ tame("dns", "unix", "inet")
+
+
+=head1 DESCRIPTION
+
+This module provides access to the tame(2) system call for restricting
+system operations.
+
+tame() must be called with arguments specifying which tame(2) options
+should be allowed. The only tame(2) option allowed by default is
+TAME_MALLOC, all other tame(2) options must be specified explicitly.
+The available options are: abort, cmsg, dns, getpw, inet, ioctl,
+proc, rpath, rw, tmppath, unix, wpath.
+
+=head2 EXPORT
+
+ tame("abort", "rpath")
+
+=head2 Exportable functions
+
+ tame("abort", "rpath")
+
+=head1 SEE ALSO
+
+tame(2)
+
+=head1 AUTHOR
+
+Jeremy Evans, E<lt>jer...@openbsd.orge<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2015 by Jeremy Evans
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.12.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
Index: gnu/usr.bin/perl/cpan/OpenBSD-Tame/t/OpenBSD-Tame.t
===================================================================
RCS file: gnu/usr.bin/perl/cpan/OpenBSD-Tame/t/OpenBSD-Tame.t
diff -N gnu/usr.bin/perl/cpan/OpenBSD-Tame/t/OpenBSD-Tame.t
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ gnu/usr.bin/perl/cpan/OpenBSD-Tame/t/OpenBSD-Tame.t 21 Jul 2015 19:10:19
-0000
@@ -0,0 +1,72 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl OpenBSD-Tame.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use strict;
+use warnings;
+
+use Test::More;
+BEGIN { use_ok('OpenBSD::Tame') };
+
+#########################
+
+sub tamed {
+ my ($msg, $status, $args, $code) = @_;
+ my $res = system("perl", '-I', 'lib', '-e', "use OpenBSD::Tame; tame($args);
$code");
+ cmp_ok($res, ($status > 0 ? '>=' : '=='), $status, $msg);
+}
+
+system("rm -f *.core");
+tamed("open works with rpath", 0, "'rpath'", 'open(my $fh, "<", __FILE__)');
+my @cores = glob '*.core';
+cmp_ok(scalar(@cores), "==", 0, "no cores after success");
+
+tamed("open fails without rpath", 1, "'abort'", 'open(my $fh, "<", __FILE__)');
+@cores = glob '*.core';
+cmp_ok(scalar(@cores), "==", 1, "1 core after failure with abort");
+unlink($cores[0]);
+
+tamed("open fails without rpath", 1, "", 'open(my $fh, "<", __FILE__)');
+@cores = glob '*.core';
+cmp_ok(scalar(@cores), "==", 0, "0 core after failure without abort");
+
+my $success = eval { tame("foo") };
+ok !$success, "dies if given invalid argument";
+
+tamed("open for writing new file fails without cpath and wpath", 1, "",
'open(my $fh, ">", "_test")');
+tamed("open for writing new file fails without cpath and wpath", 1, "'cpath'",
'open(my $fh, ">", "_test")');
+tamed("open for writing new file fails without cpath and wpath", 1, "'wpath'",
'open(my $fh, ">", "_test")');
+tamed("open for writing new file works with cpath and wpath", 0, "'cpath',
'wpath'", 'open(my $fh, ">", "_test")');
+
+tamed("open for writing existing file fails without wpath", 1, "", 'open(my
$fh, "+<", "_test")');
+tamed("open for writing existing file works with wpath", 0, "'wpath'",
'open(my $fh, "+<", "_test")');
+unlink("_test");
+
+tamed("dns lookups fail without dns and inet", 1, "",
'gethostbyname("google.com")');
+tamed("dns lookups fail without dns and inet", 1, "'dns'",
'gethostbyname("google.com")');
+tamed("dns lookups fail without dns and inet", 1, "'inet'",
'gethostbyname("google.com")');
+tamed("dns lookups works with dns and rpath and inet", 0, "'dns', 'inet'",
'gethostbyname("google.com")');
+
+tamed("internet access fails without inet", 1, "", 'socket(my $socket,
PF_INET, SOCK_STREAM, 0)');
+tamed("internet access works inet", 0, "'inet'", 'socket(my $socket, PF_INET,
SOCK_STREAM, 0)');
+
+tamed("unix socket access fails without unix", 1, "", 'socket(my $socket,
PF_UNIX, SOCK_STREAM, 0)');
+tamed("unix socket access works unix", 0, "'unix'", 'socket(my $socket,
PF_UNIX, SOCK_STREAM, 0)');
+
+tamed("killing procs fails without proc", 1, "", 'kill("INFO", $$)');
+tamed("killing procs works with proc", 0, "'proc'", 'kill("INFO", $$)');
+
+tamed("temp files fail without tmppath and wpath", 1, "", 'sysopen(my $fh,
"/tmp/_test", O_RDWR|O_CREAT|O_EXCL, 0600);');
+tamed("temp files work with tmppath and wpath", 0, "'tmppath', 'wpath'",
'sysopen(my $fh, "/tmp/_test", O_RDWR|O_CREAT|O_EXCL, 0600);');
+
+tamed("stdio fails without rw", 1, "", 'print("a");');
+tamed("stdio works with rw", 0, "'rw'", 'print("a");');
+
+tamed("tame dies if attempting to raise permissions", 1, "'rpath', 'rw'", 'use
OpenBSD::Tame; tame("wpath")');
+tamed("tame does not dies if attempting to reduce permissions", 0, "'rw',
'rpath'", 'use OpenBSD::Tame; tame("rw")');
+
+done_testing();
+
