On Sat, Aug 27, 2022 at 10:02 AM Tom Lane <t...@sss.pgh.pa.us> wrote: > > John Naylor <john.nay...@enterprisedb.com> writes: > > On Sat, Aug 27, 2022 at 4:15 AM Andres Freund <and...@anarazel.de> wrote: > >> I think it'd also be needed in hstore_plperl.c, jsonb_plperl.c. Putting the > >> include in plperl.h would keep that aspect transparent, because > >> plperl_utils.h > >> includes plperl.h. > > > Since plperl_helpers.h already includes plperl.h, I'm not sure why > > both are included everywhere the former is. If .c/.xs files didn't > > include plperl.h directly, we could keep pg_wchar.h in > > plperl_helpers.h. Not sure if that's workable or any better... > > Maybe we should flush the separate plperl_helpers.h header and just > put those static-inline functions in plperl.h.
Here's a patch with that idea, not tested on Windows yet. -- John Naylor EDB: http://www.enterprisedb.com
From b9fba2229b064ab3d7971917cf9bfc1f95bc2d6f Mon Sep 17 00:00:00 2001 From: John Naylor <john.nay...@postgresql.org> Date: Sat, 27 Aug 2022 11:17:36 +0700 Subject: [PATCH v1] Be more careful to avoid including system headers after perl.h Commit 121d2d3d70 included simd.h into pg_wchar.h, which lead to perl.h's free() being redefined, at least on Windows. To fix, move the static inline function definitions from plperl_helpers.h, into plperl.h, where we already document the necessary inclusion order. Since those functions were the only reason for the existence of plperl_helpers.h, remove it. First reported by Justin Pryzby Diagnosis by Andres Freund, patch by myself per suggestion from Tom Lane Discussion: https://www.postgresql.org/message-id/20220826115546.GE2342%40telsasoft.com --- contrib/hstore_plperl/hstore_plperl.c | 1 - contrib/jsonb_plperl/jsonb_plperl.c | 1 - src/pl/plperl/GNUmakefile | 4 +- src/pl/plperl/SPI.xs | 1 - src/pl/plperl/Util.xs | 1 - src/pl/plperl/plperl.c | 2 - src/pl/plperl/plperl.h | 170 ++++++++++++++++++++++++- src/pl/plperl/plperl_helpers.h | 171 -------------------------- 8 files changed, 171 insertions(+), 180 deletions(-) delete mode 100644 src/pl/plperl/plperl_helpers.h diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c index c72785d99e..4a1629cad5 100644 --- a/contrib/hstore_plperl/hstore_plperl.c +++ b/contrib/hstore_plperl/hstore_plperl.c @@ -3,7 +3,6 @@ #include "fmgr.h" #include "hstore/hstore.h" #include "plperl.h" -#include "plperl_helpers.h" PG_MODULE_MAGIC; diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c index 22e90afe1b..2af1e0c02a 100644 --- a/contrib/jsonb_plperl/jsonb_plperl.c +++ b/contrib/jsonb_plperl/jsonb_plperl.c @@ -4,7 +4,6 @@ #include "fmgr.h" #include "plperl.h" -#include "plperl_helpers.h" #include "utils/fmgrprotos.h" #include "utils/jsonb.h" diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile index a2e6410f53..1ebf3c9ba2 100644 --- a/src/pl/plperl/GNUmakefile +++ b/src/pl/plperl/GNUmakefile @@ -72,7 +72,7 @@ XSUBPPDIR = $(shell $(PERL) -e 'use List::Util qw(first); print first { -r "$$_/ include $(top_srcdir)/src/Makefile.shlib -plperl.o: perlchunks.h plperl_opmask.h plperl_helpers.h +plperl.o: perlchunks.h plperl_opmask.h plperl_opmask.h: plperl_opmask.pl @if [ x"$(perl_privlibexp)" = x"" ]; then echo "configure switch --with-perl was not specified."; exit 1; fi @@ -103,7 +103,7 @@ uninstall: uninstall-lib uninstall-data install-data: installdirs $(INSTALL_DATA) $(addprefix $(srcdir)/, $(DATA)) '$(DESTDIR)$(datadir)/extension/' - $(INSTALL_DATA) $(srcdir)/plperl.h $(srcdir)/ppport.h $(srcdir)/plperl_helpers.h '$(DESTDIR)$(includedir_server)' + $(INSTALL_DATA) $(srcdir)/plperl.h $(srcdir)/ppport.h '$(DESTDIR)$(includedir_server)' uninstall-data: rm -f $(addprefix '$(DESTDIR)$(datadir)/extension'/, $(notdir $(DATA))) diff --git a/src/pl/plperl/SPI.xs b/src/pl/plperl/SPI.xs index b2db3bd694..e81432e634 100644 --- a/src/pl/plperl/SPI.xs +++ b/src/pl/plperl/SPI.xs @@ -13,7 +13,6 @@ /* perl stuff */ #define PG_NEED_PERL_XSUB_H #include "plperl.h" -#include "plperl_helpers.h" MODULE = PostgreSQL::InServer::SPI PREFIX = spi_ diff --git a/src/pl/plperl/Util.xs b/src/pl/plperl/Util.xs index 47eba59415..bb4580ebfa 100644 --- a/src/pl/plperl/Util.xs +++ b/src/pl/plperl/Util.xs @@ -20,7 +20,6 @@ /* perl stuff */ #define PG_NEED_PERL_XSUB_H #include "plperl.h" -#include "plperl_helpers.h" static text * diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index af354a68cc..5d192a0ce5 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -23,7 +23,6 @@ #include "commands/trigger.h" #include "executor/spi.h" #include "funcapi.h" -#include "mb/pg_wchar.h" #include "miscadmin.h" #include "nodes/makefuncs.h" #include "parser/parse_type.h" @@ -47,7 +46,6 @@ /* string literal macros defining chunks of perl code */ #include "perlchunks.h" #include "plperl.h" -#include "plperl_helpers.h" /* defines PLPERL_SET_OPMASK */ #include "plperl_opmask.h" diff --git a/src/pl/plperl/plperl.h b/src/pl/plperl/plperl.h index c662d17509..0c196ea046 100644 --- a/src/pl/plperl/plperl.h +++ b/src/pl/plperl/plperl.h @@ -3,7 +3,8 @@ * plperl.h * Common include file for PL/Perl files * - * This should be included _AFTER_ postgres.h and system include files + * This should be included _AFTER_ postgres.h and system include files, as + * well as headers that could in turn include system headers. * * Portions Copyright (c) 1996-2022, PostgreSQL Global Development Group * Portions Copyright (c) 1995, Regents of the University of California @@ -14,6 +15,9 @@ #ifndef PL_PERL_H #define PL_PERL_H +/* defines free() by way of system headers, so must be included before perl.h */ +#include "mb/pg_wchar.h" + /* stop perl headers from hijacking stdio and other stuff on Windows */ #ifdef WIN32 #define WIN32IO_IS_STDIO @@ -213,4 +217,168 @@ void plperl_spi_rollback(void); char *plperl_sv_to_literal(SV *, char *); void plperl_util_elog(int level, SV *msg); + +/* helper functions */ + +/* + * convert from utf8 to database encoding + * + * Returns a palloc'ed copy of the original string + */ +static inline char * +utf_u2e(char *utf8_str, size_t len) +{ + char *ret; + + ret = pg_any_to_server(utf8_str, len, PG_UTF8); + + /* ensure we have a copy even if no conversion happened */ + if (ret == utf8_str) + ret = pstrdup(ret); + + return ret; +} + +/* + * convert from database encoding to utf8 + * + * Returns a palloc'ed copy of the original string + */ +static inline char * +utf_e2u(const char *str) +{ + char *ret; + + ret = pg_server_to_any(str, strlen(str), PG_UTF8); + + /* ensure we have a copy even if no conversion happened */ + if (ret == str) + ret = pstrdup(ret); + + return ret; +} + +/* + * Convert an SV to a char * in the current database encoding + * + * Returns a palloc'ed copy of the original string + */ +static inline char * +sv2cstr(SV *sv) +{ + dTHX; + char *val, + *res; + STRLEN len; + + /* + * get a utf8 encoded char * out of perl. *note* it may not be valid utf8! + */ + + /* + * SvPVutf8() croaks nastily on certain things, like typeglobs and + * readonly objects such as $^V. That's a perl bug - it's not supposed to + * happen. To avoid crashing the backend, we make a copy of the sv before + * passing it to SvPVutf8(). The copy is garbage collected when we're done + * with it. + */ + if (SvREADONLY(sv) || + isGV_with_GP(sv) || + (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)) + sv = newSVsv(sv); + else + { + /* + * increase the reference count so we can just SvREFCNT_dec() it when + * we are done + */ + SvREFCNT_inc_simple_void(sv); + } + + /* + * Request the string from Perl, in UTF-8 encoding; but if we're in a + * SQL_ASCII database, just request the byte soup without trying to make + * it UTF8, because that might fail. + */ + if (GetDatabaseEncoding() == PG_SQL_ASCII) + val = SvPV(sv, len); + else + val = SvPVutf8(sv, len); + + /* + * Now convert to database encoding. We use perl's length in the event we + * had an embedded null byte to ensure we error out properly. + */ + res = utf_u2e(val, len); + + /* safe now to garbage collect the new SV */ + SvREFCNT_dec(sv); + + return res; +} + +/* + * Create a new SV from a string assumed to be in the current database's + * encoding. + */ +static inline SV * +cstr2sv(const char *str) +{ + dTHX; + SV *sv; + char *utf8_str; + + /* no conversion when SQL_ASCII */ + if (GetDatabaseEncoding() == PG_SQL_ASCII) + return newSVpv(str, 0); + + utf8_str = utf_e2u(str); + + sv = newSVpv(utf8_str, 0); + SvUTF8_on(sv); + pfree(utf8_str); + + return sv; +} + +/* + * croak() with specified message, which is given in the database encoding. + * + * Ideally we'd just write croak("%s", str), but plain croak() does not play + * nice with non-ASCII data. In modern Perl versions we can call cstr2sv() + * and pass the result to croak_sv(); in versions that don't have croak_sv(), + * we have to work harder. + */ +static inline void +croak_cstr(const char *str) +{ + dTHX; + +#ifdef croak_sv + /* Use sv_2mortal() to be sure the transient SV gets freed */ + croak_sv(sv_2mortal(cstr2sv(str))); +#else + + /* + * The older way to do this is to assign a UTF8-marked value to ERRSV and + * then call croak(NULL). But if we leave it to croak() to append the + * error location, it does so too late (only after popping the stack) in + * some Perl versions. Hence, use mess() to create an SV with the error + * location info already appended. + */ + SV *errsv = get_sv("@", GV_ADD); + char *utf8_str = utf_e2u(str); + SV *ssv; + + ssv = mess("%s", utf8_str); + SvUTF8_on(ssv); + + pfree(utf8_str); + + sv_setsv(errsv, ssv); + + croak(NULL); +#endif /* croak_sv */ +} + #endif /* PL_PERL_H */ diff --git a/src/pl/plperl/plperl_helpers.h b/src/pl/plperl/plperl_helpers.h deleted file mode 100644 index 1e318b6dc8..0000000000 --- a/src/pl/plperl/plperl_helpers.h +++ /dev/null @@ -1,171 +0,0 @@ -#ifndef PL_PERL_HELPERS_H -#define PL_PERL_HELPERS_H - -#include "mb/pg_wchar.h" - -#include "plperl.h" - - -/* - * convert from utf8 to database encoding - * - * Returns a palloc'ed copy of the original string - */ -static inline char * -utf_u2e(char *utf8_str, size_t len) -{ - char *ret; - - ret = pg_any_to_server(utf8_str, len, PG_UTF8); - - /* ensure we have a copy even if no conversion happened */ - if (ret == utf8_str) - ret = pstrdup(ret); - - return ret; -} - -/* - * convert from database encoding to utf8 - * - * Returns a palloc'ed copy of the original string - */ -static inline char * -utf_e2u(const char *str) -{ - char *ret; - - ret = pg_server_to_any(str, strlen(str), PG_UTF8); - - /* ensure we have a copy even if no conversion happened */ - if (ret == str) - ret = pstrdup(ret); - - return ret; -} - - -/* - * Convert an SV to a char * in the current database encoding - * - * Returns a palloc'ed copy of the original string - */ -static inline char * -sv2cstr(SV *sv) -{ - dTHX; - char *val, - *res; - STRLEN len; - - /* - * get a utf8 encoded char * out of perl. *note* it may not be valid utf8! - */ - - /* - * SvPVutf8() croaks nastily on certain things, like typeglobs and - * readonly objects such as $^V. That's a perl bug - it's not supposed to - * happen. To avoid crashing the backend, we make a copy of the sv before - * passing it to SvPVutf8(). The copy is garbage collected when we're done - * with it. - */ - if (SvREADONLY(sv) || - isGV_with_GP(sv) || - (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)) - sv = newSVsv(sv); - else - { - /* - * increase the reference count so we can just SvREFCNT_dec() it when - * we are done - */ - SvREFCNT_inc_simple_void(sv); - } - - /* - * Request the string from Perl, in UTF-8 encoding; but if we're in a - * SQL_ASCII database, just request the byte soup without trying to make - * it UTF8, because that might fail. - */ - if (GetDatabaseEncoding() == PG_SQL_ASCII) - val = SvPV(sv, len); - else - val = SvPVutf8(sv, len); - - /* - * Now convert to database encoding. We use perl's length in the event we - * had an embedded null byte to ensure we error out properly. - */ - res = utf_u2e(val, len); - - /* safe now to garbage collect the new SV */ - SvREFCNT_dec(sv); - - return res; -} - -/* - * Create a new SV from a string assumed to be in the current database's - * encoding. - */ -static inline SV * -cstr2sv(const char *str) -{ - dTHX; - SV *sv; - char *utf8_str; - - /* no conversion when SQL_ASCII */ - if (GetDatabaseEncoding() == PG_SQL_ASCII) - return newSVpv(str, 0); - - utf8_str = utf_e2u(str); - - sv = newSVpv(utf8_str, 0); - SvUTF8_on(sv); - pfree(utf8_str); - - return sv; -} - -/* - * croak() with specified message, which is given in the database encoding. - * - * Ideally we'd just write croak("%s", str), but plain croak() does not play - * nice with non-ASCII data. In modern Perl versions we can call cstr2sv() - * and pass the result to croak_sv(); in versions that don't have croak_sv(), - * we have to work harder. - */ -static inline void -croak_cstr(const char *str) -{ - dTHX; - -#ifdef croak_sv - /* Use sv_2mortal() to be sure the transient SV gets freed */ - croak_sv(sv_2mortal(cstr2sv(str))); -#else - - /* - * The older way to do this is to assign a UTF8-marked value to ERRSV and - * then call croak(NULL). But if we leave it to croak() to append the - * error location, it does so too late (only after popping the stack) in - * some Perl versions. Hence, use mess() to create an SV with the error - * location info already appended. - */ - SV *errsv = get_sv("@", GV_ADD); - char *utf8_str = utf_e2u(str); - SV *ssv; - - ssv = mess("%s", utf8_str); - SvUTF8_on(ssv); - - pfree(utf8_str); - - sv_setsv(errsv, ssv); - - croak(NULL); -#endif /* croak_sv */ -} - -#endif /* PL_PERL_HELPERS_H */ -- 2.36.1
