Change 14244 by jhi@alpha on 2002/01/13 18:27:00
Make the crypt() pickier: if downgrading doesn't work,
croak.
Affected files ...
.... //depot/perl/pod/perldiag.pod#262 edit
.... //depot/perl/pod/perlfunc.pod#293 edit
.... //depot/perl/pp.c#328 edit
.... //depot/perl/t/op/crypt.t#6 edit
Differences ...
==== //depot/perl/pod/perldiag.pod#262 (text) ====
==== //depot/perl/pod/perlfunc.pod#293 (text) ====
Index: perl/pod/perlfunc.pod
--- perl/pod/perlfunc.pod.~1~ Sun Jan 13 11:30:05 2002
+++ perl/pod/perlfunc.pod Sun Jan 13 11:30:05 2002
@@ -865,10 +865,12 @@
on your favorite CPAN mirror for a slew of potentially useful
modules.
-If using crypt() on a Unicode string (which potentially has
-characters with codepoints above 255), Perl tries to make sense of
-the situation by using only the low eight bits of the characters when
-calling crypt().
+If using crypt() on a Unicode string (which I<potentially> has
+characters with codepoints above 255), Perl tries to make sense
+of the situation by trying to downgrade (a copy of the string)
+the string back to an eight-bit byte string before calling crypt()
+(on that copy). If that works, good. If not, crypt() dies with
+C<Wide character in crypt>.
=item dbmclose HASH
==== //depot/perl/pp.c#328 (text) ====
Index: perl/pp.c
--- perl/pp.c.~1~ Sun Jan 13 11:30:05 2002
+++ perl/pp.c Sun Jan 13 11:30:05 2002
@@ -3178,26 +3178,22 @@
STRLEN n_a;
STRLEN len;
char *tmps = SvPV(left, len);
- char *t = 0;
if (DO_UTF8(left)) {
- /* If Unicode take the crypt() of the low 8 bits of
- * the characters of the string. Yes, we made this up. */
- char *s = tmps;
- char *send = tmps + len;
- STRLEN i = 0;
- Newz(688, t, len + 1, char);
- while (s < send) {
- t[i++] = utf8_to_uvchr((U8*)s, 0) & 0xFF;
- s += UTF8SKIP(s);
- }
- tmps = t;
+ /* If Unicode, try to dowgrade.
+ * If not possible, croak.
+ * Yes, we made this up. */
+ SV* tsv = sv_2mortal(newSVsv(left));
+
+ SvUTF8_on(tsv);
+ if (!sv_utf8_downgrade(tsv, FALSE))
+ Perl_croak(aTHX_ "Wide character in crypt");
+ tmps = SvPVX(tsv);
}
# ifdef FCRYPT
sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
# else
sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
# endif
- Safefree(t);
#else
DIE(aTHX_
"The crypt() function is unimplemented due to excessive paranoia.");
==== //depot/perl/t/op/crypt.t#6 (text) ====
Index: perl/t/op/crypt.t
--- perl/t/op/crypt.t.~1~ Sun Jan 13 11:30:05 2002
+++ perl/t/op/crypt.t Sun Jan 13 11:30:05 2002
@@ -14,7 +14,7 @@
skip_all("crypt unimplemented");
}
else {
- plan(tests => 2);
+ plan(tests => 4);
}
}
@@ -30,4 +30,14 @@
ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt makes a
difference");
-ok(crypt("HI", "HO") eq crypt(join("",map{chr($_+256)}unpack"C*","HI"), "HO"), "low
eight bits of Unicode");
+$a = "a\xFF\x{100}";
+
+eval {$b = crypt($a, "cd")};
+like($@, qr/Wide character in crypt/, "wide characters ungood");
+
+chop $a; # throw away the wide character
+
+eval {$b = crypt($a, "cd")};
+is($@, '', "downgrade to eight bit characters");
+is($b, crypt("a\xFF", "cd"), "downgrade results agree");
+
End of Patch.
