On Thu, Feb 18, 2010 at 10:50:23AM +0000, Tim Bunce wrote:
>
> The following bug has been logged online:
>
> Bug reference: 5334
> Logged by: Tim Bunce
> Email address: tim.bu...@pobox.com
> PostgreSQL version: 8.4.2
> Operating system: OS X
> Description: Version 2.22 of Perl Safe module breaks UTF8 PostgreSQL
> 8.4
> Details:
>
> Version 2.22 of the Perl Safe module breaks PostgreSQL 8.4 (and probably
> earlier versions) that have a default encoding of UTF-8.
>
> Safe 2.2x added extra security for closures created inside Safe but then
> returned and executed from outside Safe (which is what PostgreSQL does).
> These closures are now wrapped so that they are executed with Safe
> restrictions in effect.
>
> This extra security is causing the 'utf8fix' code in PostgreSQL 8.4 to die
> (with the error "'require' trapped by operation mask").
>
> I'm investigating this currently but don't yet have a complete fix. (The
> immediate problem appears to be easily fixed by switching to the simpler
> utf8fix code I added for PostgreSQL 9.0. But a failure still happens if
> warn() is called with utf8 string.)
It took a depressingly large number of intense hours to work out what
was going on and then more to try to work out a relatively clean solution.
The underlying problem is in perl and Safe but sadly there's no
reasonable way to fix Safe such that PostgreSQL would work without
changes.
The attached patch (over REL8_4_STABLE) works around the problem.
The key line is:
*PLPerl::utf8::SWASHNEW = \&utf8::SWASHNEW;
This allows the perl regex logic to call the SWASHNEW method that's
called when information from the Unicode character database is needed.
(The lack of that method was causing the regex logic to think that the
utf8 module wasn't loaded, so it would try to 'require' it but fail due
to the restrictions of the Safe compartment.)
The rest of the patch is updates the surrounding code to the same
simplified 'utf8fix' logic used in PostgreSQL 9.0, and the same Safe
version checks.
Tim.
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 73da04c..356ee42 100644
*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
*************** static SV **hv_store_string(HV *hv, cons
*** 162,167 ****
--- 162,168 ----
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);
+ static char *strip_trailing_ws(const char *msg);
/*
* This routine is a crock, and so is everyplace that calls it. The problem
*************** plperl_init_interp(void)
*** 528,549 ****
static void
plperl_safe_init(void)
{
! SV *res;
! double safe_version;
!
! res = eval_pv(SAFE_MODULE, FALSE); /* TRUE = croak if failure */
! safe_version = SvNV(res);
/*
! * We actually want to reject safe_version < 2.09, but it's risky to
! * assume that floating-point comparisons are exact, so use a slightly
! * smaller comparison value.
*/
! if (safe_version < 2.0899)
{
/* not safe, so disallow all trusted funcs */
eval_pv(SAFE_BAD, FALSE);
}
else
{
--- 529,557 ----
static void
plperl_safe_init(void)
{
! SV *safe_version_sv;
! IV safe_version_x100;
! safe_version_sv = eval_pv(SAFE_MODULE, FALSE); /* TRUE = croak if failure */
! safe_version_x100 = (int)(SvNV(safe_version_sv) * 100);
/*
! * Reject too-old versions of Safe and some others:
! * 2.20: http://rt.perl.org/rt3/Ticket/Display.html?id=72068
! * 2.21: http://rt.perl.org/rt3/Ticket/Display.html?id=72700
*/
! if (safe_version_x100 < 209 || safe_version_x100 == 220 || safe_version_x100 == 221)
{
/* not safe, so disallow all trusted funcs */
eval_pv(SAFE_BAD, FALSE);
+ if (SvTRUE(ERRSV))
+ {
+ ereport(ERROR,
+ (errcode(ERRCODE_INTERNAL_ERROR),
+ errmsg("while executing PLC_SAFE_BAD"),
+ errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
+ }
+
}
else
{
*************** plperl_safe_init(void)
*** 551,585 ****
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;
! 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;
! fmgr_info(F_TEXTOUT, &(desc.arg_out_func[0]));
!
! fcinfo.arg[0] = CStringGetTextDatum("a");
! fcinfo.argnull[0] = false;
!
! /* and make the call */
! ret = plperl_call_perl_func(&desc, &fcinfo);
}
}
--- 559,580 ----
if (GetDatabaseEncoding() == PG_UTF8)
{
/*
! * Force loading of utf8 module now to prevent errors that can
! * arise from the regex code later trying to load utf8 modules.
! * See http://rt.perl.org/rt3/Ticket/Display.html?id=47576
! * We then explicitly share the utf8::SWASHNEW method into the
! * compartment so lookups of unicode character data by regexes
! * executed within the compartment work.
! */
! eval_pv("my $a=pack('U',0xC4); $a =~ /\\xE4\\d/i;" \
! "*PLPerl::utf8::SWASHNEW = \\&utf8::SWASHNEW;", FALSE);
! if (SvTRUE(ERRSV))
! {
! ereport(ERROR,
! (errcode(ERRCODE_INTERNAL_ERROR),
! errmsg("while executing utf8fix"),
! errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
! }
}
}
--
Sent via pgsql-bugs mailing list (pgsql-bugs@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-bugs
