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 <[email protected]> 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 _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
