Be more careful to avoid including system headers after perl.h
Commit 121d2d3d70
included simd.h into pg_wchar.h. This caused a problem
on Windows, since Perl has "#define free" (referring to globals), which
breaks the Windows' header. 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 and review by Andres Freund, patch by myself per suggestion
from Tom Lane
Discussion: https://www.postgresql.org/message-id/20220826115546.GE2342%40telsasoft.com
This commit is contained in:
parent
52144b6fcd
commit
4eec2e03c3
|
@ -3,7 +3,6 @@
|
||||||
#include "fmgr.h"
|
#include "fmgr.h"
|
||||||
#include "hstore/hstore.h"
|
#include "hstore/hstore.h"
|
||||||
#include "plperl.h"
|
#include "plperl.h"
|
||||||
#include "plperl_helpers.h"
|
|
||||||
|
|
||||||
PG_MODULE_MAGIC;
|
PG_MODULE_MAGIC;
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,6 @@
|
||||||
|
|
||||||
#include "fmgr.h"
|
#include "fmgr.h"
|
||||||
#include "plperl.h"
|
#include "plperl.h"
|
||||||
#include "plperl_helpers.h"
|
|
||||||
#include "utils/fmgrprotos.h"
|
#include "utils/fmgrprotos.h"
|
||||||
#include "utils/jsonb.h"
|
#include "utils/jsonb.h"
|
||||||
|
|
||||||
|
|
|
@ -72,7 +72,7 @@ XSUBPPDIR = $(shell $(PERL) -e 'use List::Util qw(first); print first { -r "$$_/
|
||||||
|
|
||||||
include $(top_srcdir)/src/Makefile.shlib
|
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
|
plperl_opmask.h: plperl_opmask.pl
|
||||||
@if [ x"$(perl_privlibexp)" = x"" ]; then echo "configure switch --with-perl was not specified."; exit 1; fi
|
@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: installdirs
|
||||||
$(INSTALL_DATA) $(addprefix $(srcdir)/, $(DATA)) '$(DESTDIR)$(datadir)/extension/'
|
$(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:
|
uninstall-data:
|
||||||
rm -f $(addprefix '$(DESTDIR)$(datadir)/extension'/, $(notdir $(DATA)))
|
rm -f $(addprefix '$(DESTDIR)$(datadir)/extension'/, $(notdir $(DATA)))
|
||||||
|
|
|
@ -13,7 +13,6 @@
|
||||||
/* perl stuff */
|
/* perl stuff */
|
||||||
#define PG_NEED_PERL_XSUB_H
|
#define PG_NEED_PERL_XSUB_H
|
||||||
#include "plperl.h"
|
#include "plperl.h"
|
||||||
#include "plperl_helpers.h"
|
|
||||||
|
|
||||||
|
|
||||||
MODULE = PostgreSQL::InServer::SPI PREFIX = spi_
|
MODULE = PostgreSQL::InServer::SPI PREFIX = spi_
|
||||||
|
|
|
@ -20,7 +20,6 @@
|
||||||
/* perl stuff */
|
/* perl stuff */
|
||||||
#define PG_NEED_PERL_XSUB_H
|
#define PG_NEED_PERL_XSUB_H
|
||||||
#include "plperl.h"
|
#include "plperl.h"
|
||||||
#include "plperl_helpers.h"
|
|
||||||
|
|
||||||
|
|
||||||
static text *
|
static text *
|
||||||
|
|
|
@ -23,7 +23,6 @@
|
||||||
#include "commands/trigger.h"
|
#include "commands/trigger.h"
|
||||||
#include "executor/spi.h"
|
#include "executor/spi.h"
|
||||||
#include "funcapi.h"
|
#include "funcapi.h"
|
||||||
#include "mb/pg_wchar.h"
|
|
||||||
#include "miscadmin.h"
|
#include "miscadmin.h"
|
||||||
#include "nodes/makefuncs.h"
|
#include "nodes/makefuncs.h"
|
||||||
#include "parser/parse_type.h"
|
#include "parser/parse_type.h"
|
||||||
|
@ -47,7 +46,6 @@
|
||||||
/* string literal macros defining chunks of perl code */
|
/* string literal macros defining chunks of perl code */
|
||||||
#include "perlchunks.h"
|
#include "perlchunks.h"
|
||||||
#include "plperl.h"
|
#include "plperl.h"
|
||||||
#include "plperl_helpers.h"
|
|
||||||
/* defines PLPERL_SET_OPMASK */
|
/* defines PLPERL_SET_OPMASK */
|
||||||
#include "plperl_opmask.h"
|
#include "plperl_opmask.h"
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,8 @@
|
||||||
* plperl.h
|
* plperl.h
|
||||||
* Common include file for PL/Perl files
|
* 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) 1996-2022, PostgreSQL Global Development Group
|
||||||
* Portions Copyright (c) 1995, Regents of the University of California
|
* Portions Copyright (c) 1995, Regents of the University of California
|
||||||
|
@ -14,6 +15,9 @@
|
||||||
#ifndef PL_PERL_H
|
#ifndef PL_PERL_H
|
||||||
#define 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 */
|
/* stop perl headers from hijacking stdio and other stuff on Windows */
|
||||||
#ifdef WIN32
|
#ifdef WIN32
|
||||||
#define WIN32IO_IS_STDIO
|
#define WIN32IO_IS_STDIO
|
||||||
|
@ -213,4 +217,168 @@ void plperl_spi_rollback(void);
|
||||||
char *plperl_sv_to_literal(SV *, char *);
|
char *plperl_sv_to_literal(SV *, char *);
|
||||||
void plperl_util_elog(int level, SV *msg);
|
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 */
|
#endif /* PL_PERL_H */
|
||||||
|
|
|
@ -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 */
|
|
Loading…
Reference in New Issue