From: Nick Ing-Simmons Date: Tue, 11 Sep 2001 06:25:27 +0000 (+0000) Subject: Integrate mainline X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=27e4dad07483235e869104f9b196d7a67912fac0;hp=c9b8d07a63ebe36e22cf35e83f7d6beac85bca88;p=p5sagit%2Fp5-mst-13.2.git Integrate mainline p4raw-id: //depot/perlio@11996 --- diff --git a/ext/POSIX/sigaction.t b/ext/POSIX/sigaction.t deleted file mode 100644 index 1045db6..0000000 --- a/ext/POSIX/sigaction.t +++ /dev/null @@ -1,133 +0,0 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - unshift @INC, '../lib'; -} - -BEGIN{ - # Don't do anything if POSIX is missing, or sigaction missing. - eval { use POSIX; }; - if($@ || $^O eq 'MSWin32' || $^O eq 'NetWare') { - print "1..0\n"; - exit 0; - } -} - -use strict; -use vars qw/$bad7 $ok10 $bad18 $ok/; - -$^W=1; - -print "1..18\n"; - -sub IGNORE { - $bad7=1; -} - -sub DEFAULT { - $bad18=1; -} - -sub foo { - $ok=1; -} - -my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0); -my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0); - -{ - my $bad; - local($SIG{__WARN__})=sub { $bad=1; }; - sigaction(SIGHUP, $newaction, $oldaction); - if($bad) { print "not ok 1\n" } else { print "ok 1\n"} -} - -if($oldaction->{HANDLER} eq 'DEFAULT' || - $oldaction->{HANDLER} eq 'IGNORE') - { print "ok 2\n" } else { print "not ok 2 # ", $oldaction->{HANDLER}, "\n"} -print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n"; - -sigaction(SIGHUP, $newaction, $oldaction); -if($oldaction->{HANDLER} eq '::foo') - { print "ok 4\n" } else { print "not ok 4\n"} -if($oldaction->{MASK}->ismember(SIGUSR1)) - { print "ok 5\n" } else { print "not ok 5\n"} -if($oldaction->{FLAGS}) { - if ($^O eq 'linux' || $^O eq 'unicos') { - print "ok 6 # Skip: sigaction() thinks different in $^O\n"; - } else { - print "not ok 6\n"; - } -} else { - print "ok 6\n"; -} - -$newaction=POSIX::SigAction->new('IGNORE'); -sigaction(SIGHUP, $newaction); -kill 'HUP', $$; -print $bad7 ? "not ok 7\n" : "ok 7\n"; - -print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n"; -sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT')); -print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n"; - -$newaction=POSIX::SigAction->new(sub { $ok10=1; }); -sigaction(SIGHUP, $newaction); -{ - local($^W)=0; - kill 'HUP', $$; -} -print $ok10 ? "ok 10\n" : "not ok 10\n"; - -print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n"; - -sigaction(SIGHUP, POSIX::SigAction->new('::foo')); -# Make sure the signal mask gets restored after sigaction croak()s. -eval { - my $act=POSIX::SigAction->new('::foo'); - delete $act->{HANDLER}; - sigaction(SIGINT, $act); -}; -kill 'HUP', $$; -print $ok ? "ok 12\n" : "not ok 12\n"; - -undef $ok; -# Make sure the signal mask gets restored after sigaction returns early. -my $x=defined sigaction(SIGKILL, $newaction, $oldaction); -kill 'HUP', $$; -print !$x && $ok ? "ok 13\n" : "not ok 13\n"; - -$SIG{HUP}=sub {}; -sigaction(SIGHUP, $newaction, $oldaction); -print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n"; - -eval { - sigaction(SIGHUP, undef, $oldaction); -}; -print $@ ? "not ok 15\n" : "ok 15\n"; - -eval { - sigaction(SIGHUP, 0, $oldaction); -}; -print $@ ? "not ok 16\n" : "ok 16\n"; - -eval { - sigaction(SIGHUP, bless({},'Class'), $oldaction); -}; -print $@ ? "ok 17\n" : "not ok 17\n"; - -if ($^O eq 'VMS') { - print "ok 18 # Skip: SIGCONT not trappable in $^O\n"; -} else { - $newaction=POSIX::SigAction->new(sub { $ok10=1; }); - if (eval { SIGCONT; 1 }) { - sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT')); - { - local($^W)=0; - kill 'CONT', $$; - } - } - print $bad18 ? "not ok 18\n" : "ok 18\n"; -} - diff --git a/lib/CGI/t/carp.t b/lib/CGI/t/carp.t index 8415816..e6a91d1 100644 --- a/lib/CGI/t/carp.t +++ b/lib/CGI/t/carp.t @@ -164,7 +164,9 @@ my $fake_out = join '', ; untie *STDOUT; open(STDOUT, ">&REAL_STDOUT"); -is( $fake_out, "\n", +my $fname = $0; +$fname =~ tr/<>-/\253\273\255/; # _warn does this so we have to also +is( $fake_out, "\n", 'warningsToBrowser() on' ); is($CGI::Carp::EMIT_WARNINGS, 1, "Warnings turned off"); diff --git a/lib/File/Find/taint.t b/lib/File/Find/taint.t deleted file mode 100644 index 3d7e236..0000000 --- a/lib/File/Find/taint.t +++ /dev/null @@ -1,407 +0,0 @@ -#!./perl -T - - -my %Expect_File = (); # what we expect for $_ -my %Expect_Name = (); # what we expect for $File::Find::name/fullname -my %Expect_Dir = (); # what we expect for $File::Find::dir -my $symlink_exists = eval { symlink("",""); 1 }; -my $cwd; -my $cwd_untainted; - -use Config; - -BEGIN { - chdir 't' if -d 't'; - unshift @INC => '../lib'; - - for (keys %ENV) { # untaint ENV - ($ENV{$_}) = $ENV{$_} =~ /(.*)/; - } - - # Remove insecure directories from PATH - my @path; - my $sep = $Config{path_sep}; - foreach my $dir (split(/\Q$sep/,$ENV{'PATH'})) - { - ## - ## Match the directory taint tests in mg.c::Perl_magic_setenv() - ## - push(@path,$dir) unless (length($dir) >= 256 - or - substr($dir,0,1) ne "/" - or - (stat $dir)[2] & 002); - } - $ENV{'PATH'} = join($sep,@path); -} - - -if ( $symlink_exists ) { print "1..45\n"; } -else { print "1..27\n"; } - -use File::Find; -use File::Spec; -use Cwd; - - -cleanup(); - -find({wanted => sub { print "ok 1\n" if $_ eq 'commonsense.t'; }, - untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir); - -finddepth({wanted => sub { print "ok 2\n" if $_ eq 'commonsense.t'; }, - untaint => 1, untaint_pattern => qr|^(.+)$|}, - File::Spec->curdir); - -my $case = 2; -my $FastFileTests_OK = 0; - -sub cleanup { - if (-d dir_path('for_find')) { - chdir(dir_path('for_find')); - } - if (-d dir_path('fa')) { - unlink file_path('fa', 'fa_ord'), - file_path('fa', 'fsl'), - file_path('fa', 'faa', 'faa_ord'), - file_path('fa', 'fab', 'fab_ord'), - file_path('fa', 'fab', 'faba', 'faba_ord'), - file_path('fb', 'fb_ord'), - file_path('fb', 'fba', 'fba_ord'); - rmdir dir_path('fa', 'faa'); - rmdir dir_path('fa', 'fab', 'faba'); - rmdir dir_path('fa', 'fab'); - rmdir dir_path('fa'); - rmdir dir_path('fb', 'fba'); - rmdir dir_path('fb'); - chdir File::Spec->updir; - rmdir dir_path('for_find'); - } -} - -END { - cleanup(); -} - -sub Check($) { - $case++; - if ($_[0]) { print "ok $case\n"; } - else { print "not ok $case\n"; } - -} - -sub CheckDie($) { - $case++; - if ($_[0]) { print "ok $case\n"; } - else { print "not ok $case\n"; exit 0; } -} - -sub Skip($) { - $case++; - print "ok $case # skipped: ",$_[0],"\n"; -} - -sub touch { - CheckDie( open(my $T,'>',$_[0]) ); -} - -sub MkDir($$) { - CheckDie( mkdir($_[0],$_[1]) ); -} - -sub wanted_File_Dir { - print "# \$File::Find::dir => '$File::Find::dir'\n"; - print "# \$_ => '$_'\n"; - s#\.$## if ($^O eq 'VMS' && $_ ne '.'); - Check( $Expect_File{$_} ); - if ( $FastFileTests_OK ) { - delete $Expect_File{ $_} - unless ( $Expect_Dir{$_} && ! -d _ ); - } else { - delete $Expect_File{$_} - unless ( $Expect_Dir{$_} && ! -d $_ ); - } -} - -sub wanted_File_Dir_prune { - &wanted_File_Dir; - $File::Find::prune=1 if $_ eq 'faba'; -} - - -sub simple_wanted { - print "# \$File::Find::dir => '$File::Find::dir'\n"; - print "# \$_ => '$_'\n"; -} - - -# Use dir_path() to specify a directory path that's expected for -# $File::Find::dir (%Expect_Dir). Also use it in file operations like -# chdir, rmdir etc. -# -# dir_path() concatenates directory names to form a _relative_ -# directory path, independant from the platform it's run on, although -# there are limitations. Don't try to create an absolute path, -# because that may fail on operating systems that have the concept of -# volume names (e.g. Mac OS). Be careful when you want to create an -# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory -# names will work best. As a special case, you can pass it a "." as -# first argument, to create a directory path like "./fa/dir" on -# operating systems other than Mac OS (actually, Mac OS will ignore -# the ".", if it's the first argument). If there's no second argument, -# this function will return the empty string on Mac OS and the string -# "./" otherwise. - -sub dir_path { - my $first_item = shift @_; - - if ($first_item eq '.') { - if ($^O eq 'MacOS') { - return '' unless @_; - # ignore first argument; return a relative path - # with leading ":" and with trailing ":" - return File::Spec->catdir("", @_); - } else { # other OS - return './' unless @_; - my $path = File::Spec->catdir(@_); - # add leading "./" - $path = "./$path"; - return $path; - } - - } else { # $first_item ne '.' - return $first_item unless @_; # return plain filename - if ($^O eq 'MacOS') { - # relative path with leading ":" and with trailing ":" - return File::Spec->catdir("", $first_item, @_); - } else { # other OS - return File::Spec->catdir($first_item, @_); - } - } -} - - -# Use topdir() to specify a directory path that you want to pass to -#find/finddepth Basically, topdir() does the same as dir_path() (see -#above), except that there's no trailing ":" on Mac OS. - -sub topdir { - my $path = dir_path(@_); - $path =~ s/:$// if ($^O eq 'MacOS'); - return $path; -} - - -# Use file_path() to specify a file path that's expected for $_ (%Expect_File). -# Also suitable for file operations like unlink etc. - -# file_path() concatenates directory names (if any) and a filename to -# form a _relative_ file path (the last argument is assumed to be a -# file). It's independant from the platform it's run on, although -# there are limitations (see the warnings for dir_path() above). As a -# special case, you can pass it a "." as first argument, to create a -# file path like "./fa/file" on operating systems other than Mac OS -# (actually, Mac OS will ignore the ".", if it's the first -# argument). If there's no second argument, this function will return -# the empty string on Mac OS and the string "./" otherwise. - -sub file_path { - my $first_item = shift @_; - - if ($first_item eq '.') { - if ($^O eq 'MacOS') { - return '' unless @_; - # ignore first argument; return a relative path - # with leading ":", but without trailing ":" - return File::Spec->catfile("", @_); - } else { # other OS - return './' unless @_; - my $path = File::Spec->catfile(@_); - # add leading "./" - $path = "./$path"; - return $path; - } - - } else { # $first_item ne '.' - return $first_item unless @_; # return plain filename - if ($^O eq 'MacOS') { - # relative path with leading ":", but without trailing ":" - return File::Spec->catfile("", $first_item, @_); - } else { # other OS - return File::Spec->catfile($first_item, @_); - } - } -} - - -# Use file_path_name() to specify a file path that's expected for -# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1 -# option is in effect, $_ is the same as $File::Find::Name. In that -# case, also use this function to specify a file path that's expected -# for $_. -# -# Basically, file_path_name() does the same as file_path() (see -# above), except that there's always a leading ":" on Mac OS, even for -# plain file/directory names. - -sub file_path_name { - my $path = file_path(@_); - $path = ":$path" if (($^O eq 'MacOS') && ($path !~ /:/)); - return $path; -} - - - -MkDir( dir_path('for_find'), 0770 ); -CheckDie(chdir( dir_path('for_find'))); - -$cwd = cwd(); # save cwd -( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it - -MkDir( dir_path('fa'), 0770 ); -MkDir( dir_path('fb'), 0770 ); -touch( file_path('fb', 'fb_ord') ); -MkDir( dir_path('fb', 'fba'), 0770 ); -touch( file_path('fb', 'fba', 'fba_ord') ); -if ($^O eq 'MacOS') { - CheckDie( symlink(':fb',':fa:fsl') ) if $symlink_exists; -} else { - CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists; -} -touch( file_path('fa', 'fa_ord') ); - -MkDir( dir_path('fa', 'faa'), 0770 ); -touch( file_path('fa', 'faa', 'faa_ord') ); -MkDir( dir_path('fa', 'fab'), 0770 ); -touch( file_path('fa', 'fab', 'fab_ord') ); -MkDir( dir_path('fa', 'fab', 'faba'), 0770 ); -touch( file_path('fa', 'fab', 'faba', 'faba_ord') ); - -print "# check untainting (no follow)\n"; - -# untainting here should work correctly - -%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => - 1,file_path('fa_ord') => 1, file_path('fab') => 1, - file_path('fab_ord') => 1, file_path('faba') => 1, - file_path('faa') => 1, file_path('faa_ord') => 1); -delete $Expect_File{ file_path('fsl') } unless $symlink_exists; -%Expect_Name = (); - -%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1, - dir_path('fab') => 1, dir_path('faba') => 1, - dir_path('fb') => 1, dir_path('fba') => 1); - -delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists; - -File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1, - untaint_pattern => qr|^(.+)$|}, topdir('fa') ); - -Check( scalar(keys %Expect_File) == 0 ); - - -# don't untaint at all, should die -%Expect_File = (); -%Expect_Name = (); -%Expect_Dir = (); -undef $@; -eval {File::Find::find( {wanted => \&simple_wanted}, topdir('fa') );}; -Check( $@ =~ m|Insecure dependency| ); -chdir($cwd_untainted); - - -# untaint pattern doesn't match, should die -undef $@; - -eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, - untaint_pattern => qr|^(NO_MATCH)$|}, - topdir('fa') );}; - -Check( $@ =~ m|is still tainted| ); -chdir($cwd_untainted); - - -# untaint pattern doesn't match, should die when we chdir to cwd -print "# check untaint_skip (No follow)\n"; -undef $@; - -eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, - untaint_skip => 1, untaint_pattern => - qr|^(NO_MATCH)$|}, topdir('fa') );}; - -print "# $@" if $@; -#$^D = 8; -Check( $@ =~ m|insecure cwd| ); - -chdir($cwd_untainted); - - -if ( $symlink_exists ) { - print "# --- symbolic link tests --- \n"; - $FastFileTests_OK= 1; - - print "# check untainting (follow)\n"; - - # untainting here should work correctly - # no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File - - %Expect_File = (file_path_name('fa') => 1, - file_path_name('fa','fa_ord') => 1, - file_path_name('fa', 'fsl') => 1, - file_path_name('fa', 'fsl', 'fb_ord') => 1, - file_path_name('fa', 'fsl', 'fba') => 1, - file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, - file_path_name('fa', 'fab') => 1, - file_path_name('fa', 'fab', 'fab_ord') => 1, - file_path_name('fa', 'fab', 'faba') => 1, - file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, - file_path_name('fa', 'faa') => 1, - file_path_name('fa', 'faa', 'faa_ord') => 1); - - %Expect_Name = (); - - %Expect_Dir = (dir_path('fa') => 1, - dir_path('fa', 'faa') => 1, - dir_path('fa', 'fab') => 1, - dir_path('fa', 'fab', 'faba') => 1, - dir_path('fb') => 1, - dir_path('fb', 'fba') => 1); - - File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1, - no_chdir => 1, untaint => 1, untaint_pattern => - qr|^(.+)$| }, topdir('fa') ); - - Check( scalar(keys %Expect_File) == 0 ); - - - # don't untaint at all, should die - undef $@; - - eval {File::Find::find( {wanted => \&simple_wanted, follow => 1}, - topdir('fa') );}; - - Check( $@ =~ m|Insecure dependency| ); - chdir($cwd_untainted); - - # untaint pattern doesn't match, should die - undef $@; - - eval {File::Find::find( {wanted => \&simple_wanted, follow => 1, - untaint => 1, untaint_pattern => - qr|^(NO_MATCH)$|}, topdir('fa') );}; - - Check( $@ =~ m|is still tainted| ); - chdir($cwd_untainted); - - # untaint pattern doesn't match, should die when we chdir to cwd - print "# check untaint_skip (Follow)\n"; - undef $@; - - eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, - untaint_skip => 1, untaint_pattern => - qr|^(NO_MATCH)$|}, topdir('fa') );}; - Check( $@ =~ m|insecure cwd| ); - - chdir($cwd_untainted); -} - diff --git a/t/op/crypt.t b/t/op/crypt.t index 26eb06a..2619338 100644 --- a/t/op/crypt.t +++ b/t/op/crypt.t @@ -1,4 +1,5 @@ use Test::More tests => 2; +use Config; # Can't assume too much about the string returned by crypt(), # and about how many bytes of the encrypted (really, hashed) @@ -10,6 +11,10 @@ use Test::More tests => 2; # bets, given alternative encryption/hashing schemes like MD5, # C2 (or higher) security schemes, and non-UNIX platforms. -ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt"); +SKIP: { + skip "crypt unimplemented", 2, unless $Config{d_crypt}; + + ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt"); -ok(crypt("HI", "HO") eq crypt(v4040.4041, "HO"), "Unicode"); + ok(crypt("HI", "HO") eq crypt(v4040.4041, "HO"), "Unicode"); +}