On 6/22/23 03:26, Heikki Linnakangas wrote:
On 21/06/2023 01:02, Joe Conway wrote:
On 6/19/23 19:30, Heikki Linnakangas wrote:
I think we should call "uselocale(LC_GLOBAL_LOCALE)" immediately after
returning from the perl interpreter, instead of before setlocale()
calls, if we want all Postgres code to run with the global locale. Not
sure how much performance overhead that would have.
I don't see how that is practical, or at least it does not really
address the issue. I think any loaded shared library could cause the
same problem by running newlocale() + uselocale() on init. Perhaps I
should go test that theory though.
Any shared library could do that, that's true. Any shared library could
also call 'chdir'. But most shared libraries don't. I think it's the
responsibility of the extension that loads the shared library, plperl in
this case, to make sure it doesn't mess up the environment for the
postgres backend.
Ok, fair enough.
The attached fixes all of the issues raised on this thread by
specifically patching plperl.
8<------------
create or replace function finnish_to_number()
returns numeric as
$$
select to_number('1,23', '9D99')
$$ language sql set lc_numeric to 'fi_FI.utf8';
pl_regression=# show lc_monetary;
lc_monetary
-------------
C
(1 row)
DO LANGUAGE 'plperlu'
$$
use POSIX qw(setlocale LC_NUMERIC);
use locale;
setlocale LC_NUMERIC, "fi_FI.utf8";
$n = 5/2; # Assign numeric 2.5 to $n
spi_exec_query('SELECT finnish_to_number()');
# Locale-dependent conversion to string
$a = " $n";
# Locale-dependent output
elog(NOTICE, "half five is $n");
$$;
NOTICE: half five is 2,5
DO
set lc_messages ='sv_SE.UTF8';
this prints syntax error in Swedish;
FEL: syntaxfel vid eller nära "this"
LINE 1: this prints syntax error in Swedish;
^
set lc_messages ='en_GB.utf8';
this *should* print syntax error in English;
ERROR: syntax error at or near "this"
LINE 1: this *should* print syntax error in English;
^
set lc_monetary ='sv_SE.UTF8';
SELECT 12.34::money AS price;
price
----------
12,34 kr
(1 row)
set lc_monetary ='en_GB.UTF8';
SELECT 12.34::money AS price;
price
--------
£12.34
(1 row)
set lc_monetary ='en_US.UTF8';
SELECT 12.34::money AS price;
price
--------
$12.34
(1 row)
8<------------
This works correctly from what I can see -- tested against pg16beta1 on
Linux Mint with perl v5.34.0 as well as against pg15.2 on RHEL 7 with
perl v5.16.3.
Although I have not looked yet, presumably we could have similar
problems with plpython. I would like to get agreement on this approach
against plperl before diving into that though.
Thoughts?
--
Joe Conway
PostgreSQL Contributors Team
RDS Open Source Databases
Amazon Web Services: https://aws.amazon.com
Ensure correct locale is used when executing plperl
Newer versions of libperl, via plperl, call uselocale() which
has the effect of changing the current locale away from the
global locale underneath postgres. This can result in, among other
infelicities, localeconv() grabbing the wrong locale for
numeric and monetary symbols and formatting. Fix that by arranging
to capture the perl locale and swapping with the global locale
as appropriate when entering and exiting libperl. Importantly,
this dance is also needed when exiting perl via SPI calls made
while executing perl.
Backpatch to all supported versions.
Author: Joe Conway
Reviewed-By: Tom Lane and Heikki Linnakangas
Reported by: Guido Brugnara
Discussion: https://postgr.es/m/flat/17946-3e84cb577e9551c3%40postgresql.org
Backpatch-through: 11
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 8638642..9831361 100644
*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
*************** typedef struct plperl_array_info
*** 223,228 ****
--- 223,233 ----
static HTAB *plperl_interp_hash = NULL;
static HTAB *plperl_proc_hash = NULL;
static plperl_interp_desc *plperl_active_interp = NULL;
+ /*
+ * Newer versions of perl call uselocale() to switch away from
+ * the global locale used by the backend. Store that here.
+ */
+ static locale_t perl_locale_obj = LC_GLOBAL_LOCALE;
/* If we have an unassigned "held" interpreter, it's stored here */
static PerlInterpreter *plperl_held_interp = NULL;
*************** static char *setlocale_perl(int category
*** 302,307 ****
--- 307,314 ----
#define setlocale_perl(a,b) Perl_setlocale(a,b)
#endif /* defined(WIN32) && PERL_VERSION_LT(5, 28, 0) */
+ static void plperl_xact_callback(XactEvent event, void *arg);
+
/*
* Decrement the refcount of the given SV within the active Perl interpreter
*
*************** _PG_init(void)
*** 482,487 ****
--- 489,508 ----
*/
plperl_held_interp = plperl_init_interp();
+ /*
+ * Grab a copy of perl locale in use, and switch back
+ * to the global one. We will need to switch back and
+ * forth, such that the current locale is perl's whenever
+ * we are about to evaluate perl code, and the global
+ * locale whenever we return to Postgres. Note that using
+ * SPI to execute SQL counts as returning to Postgres,
+ * albeit recursively.
+ */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
+
+ /* Arrange to restore the global locale in case of ERROR */
+ RegisterXactCallback(plperl_xact_callback, NULL);
+
inited = true;
}
*************** plperl_trusted_init(void)
*** 962,967 ****
--- 983,991 ----
char *key;
I32 klen;
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/* use original require while we set up */
PL_ppaddr[OP_REQUIRE] = pp_require_orig;
PL_ppaddr[OP_DOFILE] = pp_require_orig;
*************** plperl_trusted_init(void)
*** 1028,1033 ****
--- 1052,1060 ----
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
errcontext("while executing plperl.on_plperl_init")));
}
+
+ /* switch back to the global locale */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
}
*************** plperl_untrusted_init(void)
*** 1039,1044 ****
--- 1066,1074 ----
{
dTHX;
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/*
* Nothing to do except execute plperl.on_plperlu_init
*/
*************** plperl_untrusted_init(void)
*** 1051,1056 ****
--- 1081,1089 ----
errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))),
errcontext("while executing plperl.on_plperlu_init")));
}
+
+ /* switch back to the global locale */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
}
*************** plperl_call_handler(PG_FUNCTION_ARGS)
*** 1856,1861 ****
--- 1889,1897 ----
plperl_interp_desc *volatile oldinterp = plperl_active_interp;
plperl_call_data this_call_data;
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/* Initialize current-call status record */
MemSet(&this_call_data, 0, sizeof(this_call_data));
this_call_data.fcinfo = fcinfo;
*************** plperl_call_handler(PG_FUNCTION_ARGS)
*** 1882,1887 ****
--- 1918,1926 ----
}
PG_END_TRY();
+ /* switch back to the global locale */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
+
return retval;
}
*************** plperl_inline_handler(PG_FUNCTION_ARGS)
*** 1902,1907 ****
--- 1941,1949 ----
plperl_call_data this_call_data;
ErrorContextCallback pl_error_context;
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/* Initialize current-call status record */
MemSet(&this_call_data, 0, sizeof(this_call_data));
*************** plperl_inline_handler(PG_FUNCTION_ARGS)
*** 1975,1980 ****
--- 2017,2025 ----
error_context_stack = pl_error_context.previous;
+ /* switch back to the global locale */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
+
PG_RETURN_VOID();
}
*************** plperl_validator(PG_FUNCTION_ARGS)
*** 2045,2051 ****
--- 2090,2102 ----
/* Postpone body checks if !check_function_bodies */
if (check_function_bodies)
{
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
(void) compile_plperl_function(funcoid, is_trigger, is_event_trigger);
+
+ /* switch back to the global locale */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
}
/* the result of a validator is ignored */
*************** plperl_spi_exec(char *query, int limit)
*** 3153,3160 ****
--- 3204,3218 ----
pg_verifymbstr(query, strlen(query), false);
+ /* switch back to the global locale */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
+
spi_rv = SPI_execute(query, current_call_data->prodesc->fn_readonly,
limit);
+
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
spi_rv);
*************** plperl_spi_exec(char *query, int limit)
*** 3177,3182 ****
--- 3235,3243 ----
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/* Punt the error to Perl */
croak_cstr(edata->message);
*************** plperl_spi_query(char *query)
*** 3426,3431 ****
--- 3487,3495 ----
/* Make sure the query is validly encoded */
pg_verifymbstr(query, strlen(query), false);
+ /* switch back to the global locale */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
+
/* Create a cursor for the query */
plan = SPI_prepare(query, 0, NULL);
if (plan == NULL)
*************** plperl_spi_query(char *query)
*** 3441,3446 ****
--- 3505,3513 ----
PinPortal(portal);
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/* Commit the inner transaction, return to outer xact context */
ReleaseCurrentSubTransaction();
MemoryContextSwitchTo(oldcontext);
*************** plperl_spi_query(char *query)
*** 3460,3465 ****
--- 3527,3535 ----
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/* Punt the error to Perl */
croak_cstr(edata->message);
*************** plperl_spi_prepare(char *query, int argc
*** 3640,3645 ****
--- 3710,3718 ----
/* Make sure the query is validly encoded */
pg_verifymbstr(query, strlen(query), false);
+ /* switch back to the global locale */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
+
/************************************************************
* Prepare the plan and check for errors
************************************************************/
*************** plperl_spi_prepare(char *query, int argc
*** 3649,3654 ****
--- 3722,3730 ----
elog(ERROR, "SPI_prepare() failed:%s",
SPI_result_code_string(SPI_result));
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/************************************************************
* Save the plan into permanent memory (right now it's in the
* SPI procCxt, which will go away at function end).
*************** plperl_spi_prepare(char *query, int argc
*** 3697,3702 ****
--- 3773,3781 ----
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/* Punt the error to Perl */
croak_cstr(edata->message);
*************** plperl_spi_exec_prepared(char *query, HV
*** 3798,3807 ****
--- 3877,3893 ----
/************************************************************
* go
************************************************************/
+ /* switch back to the global locale */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
+
spi_rv = SPI_execute_plan(qdesc->plan, argvalues, nulls,
current_call_data->prodesc->fn_readonly, limit);
ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
spi_rv);
+
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
if (argc > 0)
{
pfree(argvalues);
*************** plperl_spi_exec_prepared(char *query, HV
*** 3827,3832 ****
--- 3913,3921 ----
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/* Punt the error to Perl */
croak_cstr(edata->message);
*************** plperl_spi_query_prepared(char *query, i
*** 3911,3918 ****
--- 4000,4014 ----
/************************************************************
* go
************************************************************/
+ /* switch back to the global locale */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
+
portal = SPI_cursor_open(NULL, qdesc->plan, argvalues, nulls,
current_call_data->prodesc->fn_readonly);
+
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
if (argc > 0)
{
pfree(argvalues);
*************** plperl_spi_query_prepared(char *query, i
*** 3945,3950 ****
--- 4041,4049 ----
MemoryContextSwitchTo(oldcontext);
CurrentResourceOwner = oldowner;
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/* Punt the error to Perl */
croak_cstr(edata->message);
*************** plperl_util_elog(int level, SV *msg)
*** 4064,4070 ****
--- 4163,4177 ----
PG_TRY();
{
cmsg = sv2cstr(msg);
+
+ /* switch back to the global locale */
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
+
elog(level, "%s", cmsg);
+
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
pfree(cmsg);
}
PG_CATCH();
*************** plperl_util_elog(int level, SV *msg)
*** 4079,4084 ****
--- 4186,4194 ----
if (cmsg)
pfree(cmsg);
+ /* ensure the perl locale is in use */
+ uselocale(perl_locale_obj);
+
/* Punt the error to Perl */
croak_cstr(edata->message);
}
*************** setlocale_perl(int category, char *local
*** 4245,4247 ****
--- 4355,4368 ----
return RETVAL;
}
#endif /* defined(WIN32) && PERL_VERSION_LT(5, 28, 0) */
+
+ /*
+ * plperl_xact_callback --- cleanup at main-transaction end.
+ */
+ static void
+ plperl_xact_callback(XactEvent event, void *arg)
+ {
+ /* ensure global locale is the current locale */
+ if (uselocale((locale_t) 0) != LC_GLOBAL_LOCALE)
+ perl_locale_obj = uselocale(LC_GLOBAL_LOCALE);
+ }
