extra .xs glue to use mkstemp and mkdtemp directly

written by guenther@ about a year ago.
discussed with him and millert@

4 files changed, 281 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/MkTemp.xs b/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/MkTemp.xs
new file mode 100644
index 00000000000..7174430c15c
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/MkTemp.xs
@@ -0,0 +1,49 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <unistd.h>
+
+MODULE = OpenBSD::MkTemp		PACKAGE = OpenBSD::MkTemp		
+
+
+# $tmpdir = mkdtemp( "/tmp/tmpdirXXXXXXXXXX" );
+char *
+mkdtemp(SV *template)
+	PREINIT:
+		char *path;
+	CODE:
+		if (SvTAINTED(template))
+			croak("tainted template");
+		path = savesvpv(template);
+		RETVAL = mkdtemp(path);
+		if (RETVAL == NULL)
+			Safefree(path);
+	OUTPUT:
+		RETVAL
+
+
+# $fh = mkstemps_real( $template, suffixlen )
+void
+mkstemps_real(SV *template, int suffixlen)
+	PREINIT:
+		int fd;
+	PPCODE:
+		if (suffixlen < 0)
+			croak("invalid suffixlen");
+		if (SvTAINTED(template))
+			croak("tainted template");
+		/* detect read-only SVs */
+		sv_catpv(template, "");
+		fd = mkstemps(SvPV_nolen(template), suffixlen);
+		SvSETMAGIC(template);
+		if (fd != -1) {
+			GV *gv = newGVgen("OpenBSD::MkTemp");
+			PerlIO *io = PerlIO_fdopen(fd, "w+");
+			if (do_open(gv, "+<&", 3, FALSE, 0, 0, io)) {
+				mXPUSHs(sv_bless(newRV((SV*)gv),
+				    gv_stashpv("OpenBSD::MkTemp",1)));
+				SvREFCNT_dec(gv);
+			}
+		}
+
diff --git a/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/README b/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/README
new file mode 100644
index 00000000000..5486d5d71cd
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/README
@@ -0,0 +1,28 @@
+OpenBSD-MkTemp version 0.02
+===========================
+
+A simple wrapper for libc's mkstemps() and mkdtemp().  Provides perl
+versions of those and mkstemp() that match those in File::Temp
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+None.
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2010 by Philip Guenther
+
+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.
+
+
diff --git a/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/lib/OpenBSD/MkTemp.pm b/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/lib/OpenBSD/MkTemp.pm
new file mode 100644
index 00000000000..d5c8efbe208
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/lib/OpenBSD/MkTemp.pm
@@ -0,0 +1,89 @@
+package OpenBSD::MkTemp;
+
+use 5.012002;
+use strict;
+use warnings;
+
+use Exporter 'import';
+
+our @EXPORT_OK = qw( mkstemps mkstemp mkdtemp );
+our @EXPORT = qw( mkstemp mkdtemp );
+our $VERSION = '0.02';
+
+require XSLoader;
+XSLoader::load('OpenBSD::MkTemp', $VERSION);
+
+sub mkstemp($)
+{
+	my $template = shift;
+	my $fh = mkstemps_real($template, 0);
+	return $fh && ($fh, $template)
+}
+
+sub mkstemps($$)
+{
+	my($template, $suffix) = @_;
+	$template .= $suffix;
+	my $fh = mkstemps_real($template, length($suffix));
+	return $fh && ($fh, $template)
+}
+
+
+1;
+__END__
+=head1 NAME
+
+OpenBSD::MkTemp - Perl access to mkstemps() and mkdtemp()
+
+=head1 SYNOPSIS
+
+  use OpenBSD::MkTemp;
+
+  my($fh, $file) = mkstemp("/tmp/fooXXXXXXXXXX");
+
+  use OpenBSD::MkTemp qw(mkdtemp mkstemps);
+
+  my $dir_name = mkdtemp("/tmp/dirXXXXXXXXXX");
+  my ($fh, $file) = mkstemps("/tmp/fileXXXXXXXXXX", ".tmp");
+
+
+=head1 DESCRIPTION
+
+This module provides routines for creating files and directories with
+guaranteed unique names, using the C mkstemps() and mkdtemp() routines.
+
+mkstemp() and mkstemps() must be called with a template argument
+that is writable, so that they can update it with the path of the
+generated file.
+They return normal perl IO handles.
+
+mkdtemp() simply takes the template and returns the path of the
+newly created directory.
+
+=head2 EXPORT
+
+  $fh = mkstemp($template)
+
+=head2 Exportable functions
+
+  $fh = mkstemps($template, $suffix_len)
+  $dir = mkdtemp($template);
+
+=head1 SEE ALSO
+
+mkstemp(3)
+
+=head1 AUTHOR
+
+Philip Guenther, E<lt>guenther@openbsd.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2010 by Philip Guenther
+
+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
diff --git a/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/t/OpenBSD-MkTemp.t b/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/t/OpenBSD-MkTemp.t
new file mode 100644
index 00000000000..c4fa9c35239
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/t/OpenBSD-MkTemp.t
@@ -0,0 +1,115 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl OpenBSD-MkTemp.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use strict;
+use warnings;
+
+use Test::More;
+use Errno;
+BEGIN { use_ok('OpenBSD::MkTemp') };
+
+#########################
+
+my $tmpdir = $ENV{TMPDIR} || "/tmp";
+my $top_base = "$tmpdir/test.";
+
+my $dir = OpenBSD::MkTemp::mkdtemp($top_base . "X" x 10);
+
+if (! $dir) {
+    BAIL_OUT("unable to create test directory: $!\n(is $tmpdir unwritable?)");
+}
+
+# clean things up afterwards
+eval 'END { my $ret = $?; system("rm", "-rf", $dir); $? = $ret }';
+
+like($dir, qr/^\Q$top_base\E[a-zA-Z0-9]{10}$/, "mkdtemp output format");
+ok(-d $dir, "mkdtemp created directory");
+my $mode = (stat(_))[2];
+cmp_ok($mode & 07777, '==', 0700, "mkdtemp directory mode");
+
+
+my $base = "$dir/f.";
+my $template = $base . "X" x 10;
+
+my($fh1, $file1) = mkstemp($template);
+
+like($file1, qr/^\Q$base\E[a-zA-Z0-9]{10}$/, "mkstemp output format");
+ok(-f $file1, "mkstemp created filed");
+my @stat = stat(_);
+cmp_ok($stat[2] & 07777, '==', 0600, "mkstemp file mode");
+
+my @fstat = stat($fh1);
+is_deeply(\@stat, \@fstat, "file name matches the handle");
+
+
+my($fh2, $file2) = OpenBSD::MkTemp::mkstemps($template, ".foo");
+
+like($file2, qr/^\Q$base\E[a-zA-Z0-9]{10}\.foo$/, "mkstemps output format");
+ok(-f $file2, "mkstemps created filed");
+@stat = stat(_);
+cmp_ok($stat[2] & 07777, '==', 0600, "mkstemps file mode");
+
+@fstat = stat($fh2);
+is_deeply(\@stat, \@fstat, "file name matches the handle");
+
+
+my $fileno = fileno($fh2);
+undef $fh2;
+open(F, ">$file2")		|| die "$0: unable to open $file2: $!";
+cmp_ok(fileno(F), '==', $fileno, "mkstemp file handle ref counting");
+
+
+#
+# How about some failures?
+#
+
+my $d2 = OpenBSD::MkTemp::mkdtemp($file1 . "/fXXXXXXXXXX");
+my $err = $!;
+subtest "mkdtemp failed on bad prefix" => sub {
+    plan tests => 2;
+    ok(! defined($d2),				"no directory name");
+    cmp_ok($err, '==', Errno::ENOTDIR,		"right errno");
+};
+
+if ($> != 0) {
+    $d2 = OpenBSD::MkTemp::mkdtemp("/fXXXXXXXXXX");
+    $err = $!;
+    subtest "mkdtemp failed on no access" => sub {
+	plan tests => 2;
+	ok(! defined($d2),			"no directory name");
+	cmp_ok($err, '==', Errno::EACCES,	"right errno");
+    };
+}
+
+my($fh3, $file3) = mkstemp($file1 . "/fXXXXXXXXXX");
+$err = $!;
+subtest "mkstemp failed on bad prefix" => sub {
+    plan tests => 3;
+    ok(! defined($fh3),				"no filehandle");
+    ok(! defined($file3),			"no filename");
+    cmp_ok($err, '==', Errno::ENOTDIR,		"right errno");
+};
+
+if ($> != 0) {
+    ($fh3, $file3) = mkstemp("/fXXXXXXXXXX");
+    $err = $!;
+    subtest "mkstemp failed on no access" => sub {
+	plan tests => 3;
+	ok(! defined($fh3),			"no filehandle");
+	ok(! defined($file3),			"no filename");
+	cmp_ok($err, '==', Errno::EACCES,	"right errno");
+    };
+}
+
+eval { OpenBSD::MkTemp::mkstemps_real("foo", 0) };
+like($@, qr/read-only value/, "unwritable template");
+
+eval { my $f = "foo"; OpenBSD::MkTemp::mkstemps_real($f, -3) };
+like($@, qr/invalid suffix/, "invalid suffix");
+
+done_testing();
+