This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Part Integrate mainline
authorNick Ing-Simmons <nik@tiuk.ti.com>
Tue, 11 Sep 2001 06:23:39 +0000 (06:23 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Tue, 11 Sep 2001 06:23:39 +0000 (06:23 +0000)
p4raw-id: //depot/perlio@11995

ext/POSIX/sigaction.t [new file with mode: 0644]
lib/CGI/t/carp.t
lib/File/Find/taint.t [new file with mode: 0644]
t/op/crypt.t
t/op/utf8decode.t [changed mode: 0644->0755]

diff --git a/ext/POSIX/sigaction.t b/ext/POSIX/sigaction.t
new file mode 100644 (file)
index 0000000..1045db6
--- /dev/null
@@ -0,0 +1,133 @@
+#!./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";
+}
+
index e6a91d1..8415816 100644 (file)
@@ -164,9 +164,7 @@ my $fake_out = join '', <STDOUT>;
 untie *STDOUT;
 
 open(STDOUT, ">&REAL_STDOUT");
-my $fname = $0;
-$fname =~ tr/<>-/\253\273\255/; # _warn does this so we have to also
-is( $fake_out, "<!-- warning: There is a problem at $fname line 95. -->\n",
+is( $fake_out, "<!-- warning: There is a problem at $0 line 95. -->\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
new file mode 100644 (file)
index 0000000..3d7e236
--- /dev/null
@@ -0,0 +1,407 @@
+#!./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);
+} 
+
index 2619338..26eb06a 100644 (file)
@@ -1,5 +1,4 @@
 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)
@@ -11,10 +10,6 @@ use Config;
 # bets, given alternative encryption/hashing schemes like MD5,
 # C2 (or higher) security schemes, and non-UNIX platforms.
 
-SKIP: {
-    skip "crypt unimplemented", 2, unless $Config{d_crypt};
-    
-    ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt");
+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");
old mode 100644 (file)
new mode 100755 (executable)