From: Andrew Dunstan <andrew@dunslane.net>
Date: Sat, 1 Dec 2007 15:39:49 +0000 (+0000)
Subject: Workaround for perl problem where evaluating UTF8 regexes can cause
X-Git-Url: http://git.postgresql.org/gitweb/?a=commitdiff_plain;h=2d23b67d0bc83412a5f131a5e6e54709ae496149;p=users%2Fbernd%2Fpostgres.git

Workaround for perl problem where evaluating UTF8 regexes can cause
implicit loading of modules, thereby breaking Safe rules.
We compile and call a tiny perl function on trusted interpreter init, after which
the problem does not occur.
---

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 0c5af2c910..0a0f5d1c5d 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -150,6 +150,8 @@ static plperl_proc_desc *compile_plperl_function(Oid fn_oid, bool is_trigger);
 static SV  *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
 static void plperl_init_shared_libs(pTHX);
 static HV  *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
+static SV  *plperl_create_sub(char *s, bool trusted);
+static SV  *plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo);
 
 /*
  * This routine is a crock, and so is everyplace that calls it.  The problem
@@ -396,6 +398,52 @@ plperl_safe_init(void)
 	else
 	{
 		eval_pv(SAFE_OK, FALSE);
+		if (GetDatabaseEncoding() == PG_UTF8)
+		{
+
+			/* 
+			 * Fill in just enough information to set up this perl
+			 * function in the safe container and call it.
+			 * For some reason not entirely clear, it prevents errors that
+			 * can arise from the regex code later trying to load
+			 * utf8 modules.
+			 */
+
+			plperl_proc_desc desc;			
+			FunctionCallInfoData fcinfo;
+			FmgrInfo outfunc;
+			HeapTuple   typeTup;
+			Form_pg_type typeStruct;
+			SV *ret;
+			SV *func;
+
+			/* make sure we don't call ourselves recursively */
+			plperl_safe_init_done = true;
+
+			/* compile the function */
+			func = plperl_create_sub(
+				"return shift =~ /\\xa9/i ? 'true' : 'false' ;",
+				true);
+
+
+			/* set up to call the function with a single text argument 'a' */
+			desc.reference = func;
+			desc.nargs = 1;
+			desc.arg_is_rowtype[0] = false;
+			fcinfo.argnull[0] = false;
+			fcinfo.arg[0] = 
+				DatumGetTextP(DirectFunctionCall1(textin, 
+												  CStringGetDatum("a")));
+			typeTup = SearchSysCache(TYPEOID,
+									 TEXTOID,
+									 0, 0, 0);
+			typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
+			fmgr_info(typeStruct->typoutput,&(desc.arg_out_func[0]));
+			ReleaseSysCache(typeTup);
+			
+			/* and make the call */
+			ret = plperl_call_perl_func(&desc,&fcinfo);
+		}
 	}
 
 	plperl_safe_init_done = true;