[libhtml-scrubber-perl] 07/11: Removed predictable tmp file vulnerability in tests
Florian Schlichting
fsfs at moszumanska.debian.org
Sat Nov 11 13:46:03 UTC 2017
This is an automated email from the git hooks/post-receive script.
fsfs pushed a commit to annotated tag release/0.09
in repository libhtml-scrubber-perl.
commit 4fc658d3a8126bdaaeb2931d5cd474ebe11fb09d
Author: Nigel Metheringham <nigelm at cpan.org>
Date: Fri Apr 1 15:53:23 2011 +0100
Removed predictable tmp file vulnerability in tests
See CPAN RT #26538, #39043, #39042
Uses File::Temp to avoid predictable/clashable file test files
---
t/06_scrub_file.t | 48 ++++++++++++++++++++++++------------------------
1 file changed, 24 insertions(+), 24 deletions(-)
diff --git a/t/06_scrub_file.t b/t/06_scrub_file.t
index 75faa6a..5a9612b 100644
--- a/t/06_scrub_file.t
+++ b/t/06_scrub_file.t
@@ -1,57 +1,57 @@
# perl Makefile.PL && nmake realclean && cls && perl Makefile.PL && nmake test
use strict;
-use File::Spec;
+use File::Temp qw/ tempfile tempdir /;
use Test::More tests => 10;
BEGIN { $^W = 1 }
- use_ok( 'HTML::Scrubber' );
+use_ok('HTML::Scrubber');
-my $s = HTML::Scrubber->new;
+my $s = HTML::Scrubber->new;
my $html = q[<html><body><p>hi<br>start <!--comment--> mid1 <?html pi> mid2 <?xml pi?> end</body></html>];
- isa_ok($s, 'HTML::Scrubber');
+isa_ok( $s, 'HTML::Scrubber' );
-my $tmpdir = File::Spec->tmpdir();
+my $tmpdir = tempdir( CLEANUP => 1 );
SKIP: {
skip "no writable temporary directory found", 6
unless length $tmpdir
and -d $tmpdir;
- my $tmpfile = File::Spec->catfile($tmpdir,"html-scrubber.test.html");
- my $r = $s->scrub($html,$tmpfile);
+ my $template = 'html-scrubber-XXXX';
+ my ( $tfh, $tmpfile ) = tempfile( $template, DIR => $tmpdir, SUFFIX => '.html' );
+ my $r = $s->scrub( $html, $tmpfile );
$r = "Error: \$@=$@ \$!=$!" unless $r;
- is($r, 1, "scrub(\$html,\$tmpfile=$tmpfile)");
-
-# use Data::Dumper;die Dumper($s);
+ is( $r, 1, "scrub(\$html,\$tmpfile=$tmpfile)" );
local *FILIS;
open FILIS, "+>$tmpfile" or die "can't write to $tmpfile";
- $r = $s->scrub($html,\*FILIS);
+ $r = $s->scrub( $html, \*FILIS );
$r = "Error: \$@=$@ \$!=$!" unless $r;
- is($r, 1, q[scrub($html,\*FILIS)]);
+ is( $r, 1, q[scrub($html,\*FILIS)] );
- seek *FILIS,0,0;
+ seek *FILIS, 0, 0;
$r = join '', readline *FILIS;
- is($r,"histart mid1 mid2 end","FILIS has the right stuff");
- is(close(FILIS),1,q[close(FILIS)]);
+ is( $r, "histart mid1 mid2 end", "FILIS has the right stuff" );
+ is( close(FILIS), 1, q[close(FILIS)] );
- $r = $s->scrub_file($tmpfile,"$tmpfile.html");
+ my ( $tfh2, $tmpfile2 ) = tempfile( $template, DIR => $tmpdir, SUFFIX => '.html' );
+ $r = $s->scrub_file( $tmpfile, "$tmpfile2" );
$r = "Error: \$@=$@ \$!=$!" unless $r;
- is($r, 1, qq[scrub_file(\$tmpfile,"\$tmpfile.html"=$tmpfile.html)]);
+ is( $r, 1, qq[scrub_file(\$tmpfile,"\$tmpfile2"=$tmpfile2)] );
- open FILIS, "+>$tmpfile.html" or die "can't write to $tmpfile";
- $r = $s->scrub_file($tmpfile,\*FILIS);
+ open FILIS, "+>$tmpfile2" or die "can't write to $tmpfile";
+ $r = $s->scrub_file( $tmpfile, \*FILIS );
$r = "Error: \$@=$@ \$!=$!" unless $r;
- is($r, 1, q[scrub_file($tmpfile,\*FILIS)]);
- seek *FILIS,0,0;
+ is( $r, 1, q[scrub_file($tmpfile,\*FILIS)] );
+ seek *FILIS, 0, 0;
$r = join '', readline *FILIS;
- is($r,"histart mid1 mid2 end","FILIS has the right stuff");
- is(close(FILIS),1,q[close(FILIS)]);
+ is( $r, "histart mid1 mid2 end", "FILIS has the right stuff" );
+ is( close(FILIS), 1, q[close(FILIS)] );
-};
+}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libhtml-scrubber-perl.git
More information about the Pkg-perl-cvs-commits
mailing list