Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit7c460f0

Browse files
committed
plperl: Skip setting UTF8 flag when in SQL_ASCII encoding
When in SQL_ASCII encoding, strings passed around are not necessarilyUTF8-safe. We had already fixed this in some places, but it looks likewe missed some.I had to backpatch Peter Eisentraut'sa8b92b6 to 9.1 in order for thispatch to cherry-pick more cleanly.Patch from Alex Hunsaker, tweaked by Kyotaro HORIGUCHI and myself.Some desultory cleanup and comment addition by me, during patch review.Per bug report from Christoph Berg in20120209102116.GA14429@msgid.df7cb.de
1 parent8fc7b07 commit7c460f0

File tree

8 files changed

+163
-44
lines changed

8 files changed

+163
-44
lines changed

‎src/pl/plperl/GNUmakefile‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,7 @@ PERLCHUNKS = plc_perlboot.pl plc_trusted.pl
4444
SHLIB_LINK =$(perl_embed_ldflags)
4545

4646
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-extension=plperl --load-extension=plperlu
47-
REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu plperl_array
47+
REGRESS = plperlplperl_lcplperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu plperl_array
4848
# if Perl can support two interpreters in one backend,
4949
# test plperl-and-plperlu cases
5050
ifneq ($(PERL),)

‎src/pl/plperl/Util.xs‎

Lines changed: 19 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -67,8 +67,11 @@ static text *
6767
sv2text(SV*sv)
6868
{
6969
char*str=sv2cstr(sv);
70+
text*text;
7071

71-
returncstring_to_text(str);
72+
text=cstring_to_text(str);
73+
pfree(str);
74+
returntext;
7275
}
7376

7477
MODULE=PostgreSQL::InServer::UtilPREFIX=util_
@@ -113,8 +116,11 @@ util_quote_literal(sv)
113116
}
114117
else {
115118
text*arg=sv2text(sv);
116-
text*ret=DatumGetTextP(DirectFunctionCall1(quote_literal,PointerGetDatum(arg)));
117-
char*str=text_to_cstring(ret);
119+
text*quoted=DatumGetTextP(DirectFunctionCall1(quote_literal,PointerGetDatum(arg)));
120+
char*str;
121+
122+
pfree(arg);
123+
str=text_to_cstring(quoted);
118124
RETVAL=cstr2sv(str);
119125
pfree(str);
120126
}
@@ -132,8 +138,11 @@ util_quote_nullable(sv)
132138
else
133139
{
134140
text*arg=sv2text(sv);
135-
text*ret=DatumGetTextP(DirectFunctionCall1(quote_nullable,PointerGetDatum(arg)));
136-
char*str=text_to_cstring(ret);
141+
text*quoted=DatumGetTextP(DirectFunctionCall1(quote_nullable,PointerGetDatum(arg)));
142+
char*str;
143+
144+
pfree(arg);
145+
str=text_to_cstring(quoted);
137146
RETVAL=cstr2sv(str);
138147
pfree(str);
139148
}
@@ -145,12 +154,14 @@ util_quote_ident(sv)
145154
SV*sv
146155
PREINIT:
147156
text*arg;
148-
text*ret;
157+
text*quoted;
149158
char*str;
150159
CODE:
151160
arg=sv2text(sv);
152-
ret=DatumGetTextP(DirectFunctionCall1(quote_ident,PointerGetDatum(arg)));
153-
str=text_to_cstring(ret);
161+
quoted=DatumGetTextP(DirectFunctionCall1(quote_ident,PointerGetDatum(arg)));
162+
163+
pfree(arg);
164+
str=text_to_cstring(quoted);
154165
RETVAL=cstr2sv(str);
155166
pfree(str);
156167
OUTPUT:

‎src/pl/plperl/expected/plperl.out‎

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -650,16 +650,6 @@ CONTEXT: PL/Perl anonymous code block
650650
DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl;
651651
ERROR: Useless use of sort in scalar context at line 1.
652652
CONTEXT: PL/Perl anonymous code block
653-
--
654-
-- Make sure strings are validated
655-
-- Should fail for all encodings, as nul bytes are never permitted.
656-
--
657-
CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$
658-
return "abcd\0efg";
659-
$$ LANGUAGE plperl;
660-
SELECT perl_zerob();
661-
ERROR: invalid byte sequence for encoding "UTF8": 0x00
662-
CONTEXT: PL/Perl function "perl_zerob"
663653
-- make sure functions marked as VOID without an explicit return work
664654
CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$
665655
$_SHARED{myquote} = sub {
Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
--
2+
-- Make sure strings are validated
3+
-- Should fail for all encodings, as nul bytes are never permitted.
4+
--
5+
CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$
6+
return "abcd\0efg";
7+
$$ LANGUAGE plperl;
8+
SELECT perl_zerob();
9+
ERROR: invalid byte sequence for encoding "UTF8": 0x00
10+
CONTEXT: PL/Perl function "perl_zerob"
11+
CREATE OR REPLACE FUNCTION perl_0x80_in(text) RETURNS BOOL AS $$
12+
return ($_[0] eq "abc\x80de" ? "true" : "false");
13+
$$ LANGUAGE plperl;
14+
SELECT perl_0x80_in(E'abc\x80de');
15+
ERROR: invalid byte sequence for encoding "UTF8": 0x80
16+
CREATE OR REPLACE FUNCTION perl_0x80_out() RETURNS TEXT AS $$
17+
return "abc\x80de";
18+
$$ LANGUAGE plperl;
19+
SELECT perl_0x80_out() = E'abc\x80de';
20+
ERROR: invalid byte sequence for encoding "UTF8": 0x80
21+
CREATE OR REPLACE FUNCTION perl_utf_inout(text) RETURNS TEXT AS $$
22+
$str = $_[0]; $code = "NotUTF8:"; $match = "ab\xe5\xb1\xb1cd";
23+
if (utf8::is_utf8($str)) {
24+
$code = "UTF8:"; utf8::decode($str); $match="ab\x{5c71}cd";
25+
}
26+
return ($str ne $match ? $code."DIFFER" : $code."ab\x{5ddd}cd");
27+
$$ LANGUAGE plperl;
28+
SELECT encode(perl_utf_inout(E'ab\xe5\xb1\xb1cd')::bytea, 'escape')
29+
encode
30+
-----------------------
31+
UTF8:ab\345\267\235cd
32+
(1 row)
33+
Lines changed: 41 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,41 @@
1+
--
2+
-- Make sure strings are validated
3+
-- Should fail for all encodings, as nul bytes are never permitted.
4+
--
5+
CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$
6+
return "abcd\0efg";
7+
$$ LANGUAGE plperl;
8+
SELECT perl_zerob();
9+
ERROR: invalid byte sequence for encoding "SQL_ASCII": 0x00
10+
CONTEXT: PL/Perl function "perl_zerob"
11+
CREATE OR REPLACE FUNCTION perl_0x80_in(text) RETURNS BOOL AS $$
12+
return ($_[0] eq "abc\x80de" ? "true" : "false");
13+
$$ LANGUAGE plperl;
14+
SELECT perl_0x80_in(E'abc\x80de');
15+
perl_0x80_in
16+
--------------
17+
t
18+
(1 row)
19+
20+
CREATE OR REPLACE FUNCTION perl_0x80_out() RETURNS TEXT AS $$
21+
return "abc\x80de";
22+
$$ LANGUAGE plperl;
23+
SELECT perl_0x80_out() = E'abc\x80de';
24+
?column?
25+
----------
26+
t
27+
(1 row)
28+
29+
CREATE OR REPLACE FUNCTION perl_utf_inout(text) RETURNS TEXT AS $$
30+
$str = $_[0]; $code = "NotUTF8:"; $match = "ab\xe5\xb1\xb1cd";
31+
if (utf8::is_utf8($str)) {
32+
$code = "UTF8:"; utf8::decode($str); $match="ab\x{5c71}cd";
33+
}
34+
return ($str ne $match ? $code."DIFFER" : $code."ab\x{5ddd}cd");
35+
$$ LANGUAGE plperl;
36+
SELECT encode(perl_utf_inout(E'ab\xe5\xb1\xb1cd')::bytea, 'escape')
37+
encode
38+
--------------------------
39+
NotUTF8:ab\345\267\235cd
40+
(1 row)
41+

‎src/pl/plperl/plperl_helpers.h‎

Lines changed: 45 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -3,21 +3,29 @@
33

44
/*
55
* convert from utf8 to database encoding
6+
*
7+
* Returns a palloc'ed copy of the original string
68
*/
79
staticinlinechar*
8-
utf_u2e(constchar*utf8_str,size_tlen)
10+
utf_u2e(char*utf8_str,size_tlen)
911
{
1012
intenc=GetDatabaseEncoding();
11-
12-
char*ret= (char*)pg_do_encoding_conversion((unsignedchar*)utf8_str,len,PG_UTF8,enc);
13+
char*ret;
1314

1415
/*
15-
* when we are a PG_UTF8 or SQL_ASCII database pg_do_encoding_conversion()
16-
* will not do any conversion or verification. we need to do it manually
17-
* instead.
16+
* When we are in a PG_UTF8 or SQL_ASCII database
17+
* pg_do_encoding_conversion() will not do any conversion (which is good)
18+
* or verification (not so much), so we need to run the verification step
19+
* separately.
1820
*/
1921
if (enc==PG_UTF8||enc==PG_SQL_ASCII)
20-
pg_verify_mbstr_len(PG_UTF8,utf8_str,len, false);
22+
{
23+
pg_verify_mbstr_len(enc,utf8_str,len, false);
24+
ret=utf8_str;
25+
}
26+
else
27+
ret= (char*)pg_do_encoding_conversion((unsignedchar*)utf8_str,
28+
len,PG_UTF8,enc);
2129

2230
if (ret==utf8_str)
2331
ret=pstrdup(ret);
@@ -27,11 +35,15 @@ utf_u2e(const char *utf8_str, size_t len)
2735

2836
/*
2937
* convert from database encoding to utf8
38+
*
39+
* Returns a palloc'ed copy of the original string
3040
*/
3141
staticinlinechar*
3242
utf_e2u(constchar*str)
3343
{
34-
char*ret= (char*)pg_do_encoding_conversion((unsignedchar*)str,strlen(str),GetDatabaseEncoding(),PG_UTF8);
44+
char*ret=
45+
(char*)pg_do_encoding_conversion((unsignedchar*)str,strlen(str),
46+
GetDatabaseEncoding(),PG_UTF8);
3547

3648
if (ret==str)
3749
ret=pstrdup(ret);
@@ -41,6 +53,8 @@ utf_e2u(const char *str)
4153

4254
/*
4355
* Convert an SV to a char * in the current database encoding
56+
*
57+
* Returns a palloc'ed copy of the original string
4458
*/
4559
staticinlinechar*
4660
sv2cstr(SV*sv)
@@ -51,7 +65,9 @@ sv2cstr(SV *sv)
5165

5266
/*
5367
* get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
54-
*
68+
*/
69+
70+
/*
5571
* SvPVutf8() croaks nastily on certain things, like typeglobs and
5672
* readonly objects such as $^V. That's a perl bug - it's not supposed to
5773
* happen. To avoid crashing the backend, we make a copy of the sv before
@@ -63,18 +79,27 @@ sv2cstr(SV *sv)
6379
(SvTYPE(sv)>SVt_PVLV&&SvTYPE(sv)!=SVt_PVFM))
6480
sv=newSVsv(sv);
6581
else
66-
82+
{
6783
/*
6884
* increase the reference count so we can just SvREFCNT_dec() it when
6985
* we are done
7086
*/
7187
SvREFCNT_inc_simple_void(sv);
88+
}
7289

73-
val=SvPVutf8(sv,len);
90+
/*
91+
* Request the string from Perl, in UTF-8 encoding; but if we're in a
92+
* SQL_ASCII database, just request the byte soup without trying to make it
93+
* UTF8, because that might fail.
94+
*/
95+
if (GetDatabaseEncoding()==PG_SQL_ASCII)
96+
val=SvPV(sv,len);
97+
else
98+
val=SvPVutf8(sv,len);
7499

75100
/*
76-
*weuse perl's length in the event we had an embedded null byte to
77-
* ensure we error out properly
101+
*Now convert to database encoding. Weuse perl's length in the event we
102+
*had an embedded null byte toensure we error out properly.
78103
*/
79104
res=utf_u2e(val,len);
80105

@@ -88,16 +113,20 @@ sv2cstr(SV *sv)
88113
* Create a new SV from a string assumed to be in the current database's
89114
* encoding.
90115
*/
91-
92116
staticinlineSV*
93117
cstr2sv(constchar*str)
94118
{
95119
SV*sv;
96-
char*utf8_str=utf_e2u(str);
120+
char*utf8_str;
121+
122+
/* no conversion when SQL_ASCII */
123+
if (GetDatabaseEncoding()==PG_SQL_ASCII)
124+
returnnewSVpv(str,0);
125+
126+
utf8_str=utf_e2u(str);
97127

98128
sv=newSVpv(utf8_str,0);
99129
SvUTF8_on(sv);
100-
101130
pfree(utf8_str);
102131

103132
returnsv;

‎src/pl/plperl/sql/plperl.sql‎

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -423,15 +423,6 @@ DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl;
423423
-- yields "ERROR: Useless use of sort in scalar context."
424424
DO $do$ use warnings FATAL=> qw(void) ; my @y; my $x= sort @y;1; $do$ LANGUAGE plperl;
425425

426-
--
427-
-- Make sure strings are validated
428-
-- Should fail for all encodings, as nul bytes are never permitted.
429-
--
430-
CREATE OR REPLACEFUNCTIONperl_zerob() RETURNSTEXTAS $$
431-
return"abcd\0efg";
432-
$$ LANGUAGE plperl;
433-
SELECT perl_zerob();
434-
435426
-- make sure functions marked as VOID without an explicit return work
436427
CREATE OR REPLACEFUNCTIONmyfuncs() RETURNS voidAS $$
437428
$_SHARED{myquote}= sub {

‎src/pl/plperl/sql/plperl_lc.sql‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
--
2+
-- Make sure strings are validated
3+
-- Should fail for all encodings, as nul bytes are never permitted.
4+
--
5+
CREATE OR REPLACEFUNCTIONperl_zerob() RETURNSTEXTAS $$
6+
return"abcd\0efg";
7+
$$ LANGUAGE plperl;
8+
SELECT perl_zerob();
9+
CREATE OR REPLACEFUNCTIONperl_0x80_in(text) RETURNS BOOLAS $$
10+
return ($_[0] eq"abc\x80de" ?"true" :"false");
11+
$$ LANGUAGE plperl;
12+
SELECT perl_0x80_in(E'abc\x80de');
13+
CREATE OR REPLACEFUNCTIONperl_0x80_out() RETURNSTEXTAS $$
14+
return"abc\x80de";
15+
$$ LANGUAGE plperl;
16+
SELECT perl_0x80_out()= E'abc\x80de';
17+
CREATE OR REPLACEFUNCTIONperl_utf_inout(text) RETURNSTEXTAS $$
18+
$str= $_[0]; $code="NotUTF8:"; $match="ab\xe5\xb1\xb1cd";
19+
if (utf8::is_utf8($str)) {
20+
$code="UTF8:"; utf8::decode($str); $match="ab\x{5c71}cd";
21+
}
22+
return ($str ne $match ? $code."DIFFER" : $code."ab\x{5ddd}cd");
23+
$$ LANGUAGE plperl;
24+
SELECT encode(perl_utf_inout(E'ab\xe5\xb1\xb1cd')::bytea,'escape')

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp