New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
crypt() returns tainted data even when input strings are detainted #9537
Comments
From lpsolit@gmail.comThis is a bug report for perl from LpSolit@gmail.com, Run the following script as: perl -wT test.pl foo bar #!/usr/bin/perl -wT use strict; sub is_tainted { sub bz_crypt { my @saltchars = (0..9, 'A'..'Z', 'a'..'z', '.', '/'); my $salt = ''; # Crypt the password. # Return the crypted password. sub bz_crypt2 { if (!defined $salt) { $salt = ''; # Crypt the password. # Return the crypted password. my ($pwd, $salt) = ($ARGV[0], $ARGV[1]); # Tainted salt, so the encrypted password should be tainted too. # Detainted password, so the encrypted password should not be tainted. # Detainted password, so the encrypted password should not be tainted. Flags: Site configuration information for perl 5.10.0: Configured by Mandriva at Thu Sep 18 16:39:24 EDT 2008. Summary of my perl5 (revision 5 version 10 subversion 0) configuration: Locally applied patches: @INC for perl 5.10.0: Environment for perl 5.10.0: PATH=/sbin:/usr/sbin:/bin:/usr/bin:/usr/X11R6/bin:/usr/local/bin:/usr/local/sbin:/root/bin |
From @chipdudeThe test program in http://rt.perl.org/rt3/Ticket/Display.html?id=59998 ... seems to reveal that tainting is sticking in TARG SVs between function Consider this output with -Dts enabled and also a patch to flag which values (foo59998:43) nextstate As can be clearly seen, the inputs to crypt() are not tainted, but its Shirley, TARGS should be subject to SV clearing by no later than end of Anyone have any deeper thoughts? I don't know offhand how to be sure that Incidentally here is the patch to modify the dump as above. I found it Inline Patchdiff --git a/dump.c b/dump.c
index fdb8dde..724baf8 100644
--- a/dump.c
+++ b/dump.c
@@ -532,6 +532,8 @@ Perl_sv_peek(pTHX_ SV *sv)
finish:
while (unref--)
sv_catpv(t, ")");
+ if (PL_tainting && SvTAINTED(sv))
+ sv_catpv(t, " [tainted]");
return SvPV_nolen(t);
}
-- Chip Salzenberg <chip@pobox.com> |
The RT System itself - Status changed from 'new' to 'open' |
From @chipdudeOn Fri, Nov 14, 2008 at 02:29:13AM -0800, Chip Salzenberg wrote:
A thought occurs that the various GETTARGET* macros would be a good place. |
From @rgs2008/11/14 Chip Salzenberg <chip@pobox.com>:
Great bug tracing, but I have no other clue for now.
Thanks, applied. |
From @chipdudeOn Sun, Oct 19, 2008 at 01:11:22PM -0700, Frédéric Buclin wrote:
I've tracked this down to a bug in two seemingly random opcodes: crypt and The clearing of lexicals that usually is taken care of by pp_padsv is The below patch fixes the reported bug with crypt, as well sa the discovered Share and enjoy! Inline Patchdiff --git a/pp.c b/pp.c
index 739a457..166c315 100644
--- a/pp.c
+++ b/pp.c
@@ -2553,7 +2553,7 @@ PP(pp_complement)
sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL);
SvUTF8_off(TARG);
}
- SETs(TARG);
+ SETTARG;
RETURN;
}
#ifdef LIBERAL
@@ -2569,8 +2569,7 @@ PP(pp_complement)
#endif
for ( ; anum > 0; anum--, tmps++)
*tmps = ~*tmps;
-
- SETs(TARG);
+ SETTARG;
}
RETURN;
}
@@ -3514,7 +3513,7 @@ PP(pp_crypt)
# else
sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right)));
# endif
- SETs(TARG);
+ SETTARG;
RETURN;
#else
DIE(aTHX_
@@ -3899,9 +3898,7 @@ PP(pp_quotemeta)
}
else
sv_setpvn(TARG, s, len);
- SETs(TARG);
- if (SvSMAGICAL(TARG))
- mg_set(TARG);
+ SETTARG;
RETURN;
}
diff --git a/t/op/taint.t b/t/op/taint.t
index f578423..29fc436 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ use Config;
use File::Spec::Functions;
BEGIN { require './test.pl'; }
-plan tests => 267;
+plan tests => 271;
$| = 1;
@@ -1252,6 +1252,21 @@ foreach my $ord (78, 163, 256) {
ok(!tainted($1), "\\S match with chr $ord");
}
+{
+ # 59998
+ sub cr { my $x = crypt($_[0], $_[1]); $x }
+ sub co { my $x = ~$_[0]; $x }
+ my ($a, $b);
+ $a = cr('hello', 'foo' . $TAINT);
+ $b = cr('hello', 'foo');
+ ok(tainted($a), "tainted crypt");
+ ok(!tainted($b), "untainted crypt");
+ $a = co('foo' . $TAINT);
+ $b = co('foo');
+ ok(tainted($a), "tainted complement");
+ ok(!tainted($b), "untainted complement");
+}
+
# This may bomb out with the alarm signal so keep it last
SKIP: {
skip "No alarm()" unless $Config{d_alarm};
-- Chip Salzenberg <chip@pobox.com> |
@chipdude - Status changed from 'open' to 'resolved' |
From @TuxOn Sun, 16 Nov 2008 23:14:30 -0800, Chip Salzenberg <chip@pobox.com>
Thanks, applied as change #34860
-- |
Migrated from rt.perl.org#59998 (status was 'resolved')
Searchable as RT59998$
The text was updated successfully, but these errors were encountered: