[libhtml-scrubber-perl] 07/11: Removed predictable tmp file vulnerability in tests

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

