Ensure plperl strings are always correctly UTF8 encoded.

Amit Khandekar and Alex Hunsaker.

Backpatched to 9.1 where the problem first occurred.

src/pl/plperl/GNUmakefile

@@ -57,7 +57,7 @@ PSQLDIR = $(bindir)
 
 include $(top_srcdir)/src/Makefile.shlib
 
-plperl.o: perlchunks.h plperl_opmask.h
+plperl.o: perlchunks.h plperl_opmask.h plperl_helpers.h
 
 plperl_opmask.h: plperl_opmask.pl
 	@if [ x"$(perl_privlibexp)" = x"" ]; then echo "configure switch --with-perl was not specified."; exit 1; fi

src/pl/plperl/expected/plperl.out

@@ -650,6 +650,16 @@ CONTEXT:  PL/Perl anonymous code block
 DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl;
 ERROR:  Useless use of sort in scalar context at line 1.
 CONTEXT:  PL/Perl anonymous code block
+--
+-- Make sure strings are validated
+-- Should fail for all encodings, as nul bytes are never permitted.
+--
+CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$
+  return "abcd\0efg";
+$$ LANGUAGE plperlu;
+SELECT perl_zerob();
+ERROR:  invalid byte sequence for encoding "UTF8": 0x00
+CONTEXT:  PL/Perl function "perl_zerob"
 -- make sure functions marked as VOID without an explicit return work
 CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$
    $_SHARED{myquote} = sub {

src/pl/plperl/plperl_helpers.h

@@ -7,10 +7,21 @@
 static inline char *
 utf_u2e(const char *utf8_str, size_t len)
 {
-	char	   *ret = (char *) pg_do_encoding_conversion((unsigned char *) utf8_str, len, PG_UTF8, GetDatabaseEncoding());
+	int 	    enc = GetDatabaseEncoding();
+
+	char	   *ret = (char *) pg_do_encoding_conversion((unsigned char *) utf8_str, len, PG_UTF8, enc);
+
+	/*
+	* when we are a PG_UTF8 or SQL_ASCII database
+	* pg_do_encoding_conversion() will not do any conversion or
+	* verification. we need to do it manually instead.
+	*/
+	if (enc == PG_UTF8 || enc == PG_SQL_ASCII)
+		pg_verify_mbstr_len(PG_UTF8, utf8_str, len, false);
 
 	if (ret == utf8_str)
 		ret = pstrdup(ret);
+
 	return ret;
 }
 

src/pl/plperl/sql/plperl.sql

@@ -423,6 +423,15 @@ DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl;
 -- yields "ERROR:  Useless use of sort in scalar context."
 DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl;
 
+--
+-- Make sure strings are validated
+-- Should fail for all encodings, as nul bytes are never permitted.
+--
+CREATE OR REPLACE FUNCTION perl_zerob() RETURNS TEXT AS $$
+  return "abcd\0efg";
+$$ LANGUAGE plperlu;
+SELECT perl_zerob();
+
 -- make sure functions marked as VOID without an explicit return work
 CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$
    $_SHARED{myquote} = sub {