diff options
Diffstat (limited to 'gnu/usr.bin/perl')
| -rw-r--r-- | gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/MkTemp.xs | 49 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/README | 28 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/lib/OpenBSD/MkTemp.pm | 89 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/cpan/OpenBSD-MkTemp/t/OpenBSD-MkTemp.t | 115 |
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(); + |