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 b8e4d9e1790b709b78e5df0433051b76ae35aefb..9470757c433095ac5a3db6d1f2c334ab14785782 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1,7 +1,7 @@
 /**********************************************************************
  * plperl.c - perl as a procedural language for PostgreSQL
  *
- *       $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.123.2.1 2007/06/28 17:50:12 tgl Exp $
+ *       $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.123.2.2 2007/12/01 15:31:30 adunstan Exp $
  *
  **********************************************************************/
 
@@ -148,6 +148,8 @@ static HV  *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
 static SV  *newSVstring(const char *str);
 static SV **hv_store_string(HV *hv, const char *key, SV *val);
 static SV **hv_fetch_string(HV *hv, const char *key);
+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
@@ -505,6 +507,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;