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/GNUmakefile b/src/pl/plperl/GNUmakefile
index 3e1e0487bb242bfaf1afa72fba07ecce9dd4779e..383d479218ad2f669d8db0be6f4cab8f0d8b8180 100644 (file)
--- a/src/pl/plperl/GNUmakefile
+++ b/src/pl/plperl/GNUmakefile
@@ -1,5 +1,5 @@
 # Makefile for PL/Perl
-# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.31 2007/07/25 10:17:46 mha Exp $
+# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.32 2007/12/01 15:20:34 adunstan Exp $
 
 subdir = src/pl/plperl
 top_builddir = ../../..
@@ -27,6 +27,7 @@ override CFLAGS += -Wno-comment
 endif
 
 override CPPFLAGS := -I$(srcdir) $(CPPFLAGS) -I$(perl_archlibexp)/CORE
+override CFLAGS += -fPIC
 
 rpathdir = $(perl_archlibexp)/CORE
 

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 936bbcc08288e7e1e66af2d1d09096d9dab4b54b..5f4677c360ec5fafd6bbf55d439efecb18c9158d 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.132 2007/11/15 22:25:17 momjian Exp $
+ *   $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.133 2007/12/01 15:20:34 adunstan Exp $
  *
  **********************************************************************/
 
@@ -149,6 +149,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 *proname, 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
@@ -504,6 +506,53 @@ 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(
+               "utf8fix",
+               "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;