23
23
#include "commands/trigger.h"
24
24
#include "executor/spi.h"
25
25
#include "funcapi.h"
26
#include "libpq/pqsignal.h"
26
27
#include "mb/pg_wchar.h"
27
28
#include "miscadmin.h"
28
29
#include "nodes/makefuncs.h"
29
30
#include "parser/parse_type.h"
30
31
#include "storage/ipc.h"
32
#include "tcop/tcopprot.h"
31
33
#include "utils/builtins.h"
32
34
#include "utils/fmgroids.h"
33
35
#include "utils/guc.h"
67
69
* The plperl_interp_desc structs are kept in a Postgres hash table indexed
68
70
* by userid OID, with OID 0 used for the single untrusted interpreter.
71
* Once created, an interpreter is kept for the life of the process.
70
73
* We start out by creating a "held" interpreter, which we initialize
71
74
* only as far as we can do without deciding if it will be trusted or
92
95
/**********************************************************************
93
96
* The information we cache about loaded procedures
98
* The refcount field counts the struct's reference from the hash table shown
99
* below, plus one reference for each function call level that is using the
100
* struct. We can release the struct, and the associated Perl sub, when the
101
* refcount goes to zero.
94
102
**********************************************************************/
95
103
typedef struct plperl_proc_desc
97
105
char *proname; /* user name of procedure */
98
TransactionId fn_xmin;
106
TransactionId fn_xmin; /* xmin/TID of procedure's pg_proc tuple */
99
107
ItemPointerData fn_tid;
108
int refcount; /* reference count of this struct */
109
SV *reference; /* CODE reference for Perl sub */
100
110
plperl_interp_desc *interp; /* interpreter it's created in */
111
bool fn_readonly; /* is function readonly (not volatile)? */
112
bool lanpltrusted; /* is it plperl, rather than plperlu? */
103
113
bool fn_retistuple; /* true, if function returns tuple */
104
114
bool fn_retisset; /* true, if function returns set */
105
115
bool fn_retisarray; /* true if function returns array */
116
/* Conversion info for function's result type: */
106
117
Oid result_oid; /* Oid of result type */
107
118
FmgrInfo result_in_func; /* I/O function and arg for result type */
108
119
Oid result_typioparam;
120
/* Conversion info for function's argument types: */
110
122
FmgrInfo arg_out_func[FUNC_MAX_ARGS];
111
123
bool arg_is_rowtype[FUNC_MAX_ARGS];
112
124
Oid arg_arraytype[FUNC_MAX_ARGS]; /* InvalidOid if not an array */
114
125
} plperl_proc_desc;
127
#define increment_prodesc_refcount(prodesc) \
128
((prodesc)->refcount++)
129
#define decrement_prodesc_refcount(prodesc) \
131
if (--((prodesc)->refcount) <= 0) \
132
free_plperl_function(prodesc); \
116
135
/**********************************************************************
117
136
* For speedy lookup, we maintain a hash table mapping from
118
137
* function OID + trigger flag + user OID to plperl_proc_desc pointers.
234
253
static Datum plperl_func_handler(PG_FUNCTION_ARGS);
235
254
static Datum plperl_trigger_handler(PG_FUNCTION_ARGS);
256
static void free_plperl_function(plperl_proc_desc *prodesc);
237
258
static plperl_proc_desc *compile_plperl_function(Oid fn_oid, bool is_trigger);
239
260
static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
740
761
char *dummy_env[1] = {NULL};
742
763
PERL_SYS_INIT3(&nargs, (char ***) &embedding, (char ***) &dummy_env);
766
* For unclear reasons, PERL_SYS_INIT3 sets the SIGFPE handler to
767
* SIG_IGN. Aside from being extremely unfriendly behavior for a
768
* library, this is dumb on the grounds that the results of a
769
* SIGFPE in this state are undefined according to POSIX, and in
770
* fact you get a forced process kill at least on Linux. Hence,
771
* restore the SIGFPE handler to the backend's standard setting.
772
* (See Perl bug 114574 for more information.)
774
pqsignal(SIGFPE, FloatExceptionHandler);
743
776
perl_sys_init_done = 1;
744
777
/* quiet warning if PERL_SYS_INIT3 doesn't use the third argument */
745
778
dummy_env[0] = NULL;
1663
1696
plperl_call_data *save_call_data = current_call_data;
1664
1697
plperl_interp_desc *oldinterp = plperl_active_interp;
1698
plperl_call_data this_call_data;
1700
/* Initialize current-call status record */
1701
MemSet(&this_call_data, 0, sizeof(this_call_data));
1702
this_call_data.fcinfo = fcinfo;
1706
current_call_data = &this_call_data;
1668
1707
if (CALLED_AS_TRIGGER(fcinfo))
1669
1708
retval = PointerGetDatum(plperl_trigger_handler(fcinfo));
1714
if (this_call_data.prodesc)
1715
decrement_prodesc_refcount(this_call_data.prodesc);
1675
1716
current_call_data = save_call_data;
1676
1717
activate_interpreter(oldinterp);
1722
if (this_call_data.prodesc)
1723
decrement_prodesc_refcount(this_call_data.prodesc);
1681
1724
current_call_data = save_call_data;
1682
1725
activate_interpreter(oldinterp);
1697
1740
plperl_proc_desc desc;
1698
1741
plperl_call_data *save_call_data = current_call_data;
1699
1742
plperl_interp_desc *oldinterp = plperl_active_interp;
1743
plperl_call_data this_call_data;
1700
1744
ErrorContextCallback pl_error_context;
1746
/* Initialize current-call status record */
1747
MemSet(&this_call_data, 0, sizeof(this_call_data));
1702
1749
/* Set up a callback for error reporting */
1703
1750
pl_error_context.callback = plperl_inline_callback;
1704
1751
pl_error_context.previous = error_context_stack;
1729
1776
desc.nargs = 0;
1730
1777
desc.reference = NULL;
1732
current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
1733
current_call_data->fcinfo = &fake_fcinfo;
1734
current_call_data->prodesc = &desc;
1779
this_call_data.fcinfo = &fake_fcinfo;
1780
this_call_data.prodesc = &desc;
1781
/* we do not bother with refcounting the fake prodesc */
1787
current_call_data = &this_call_data;
1740
1789
if (SPI_connect() != SPI_OK_CONNECT)
1741
1790
elog(ERROR, "could not connect to SPI manager");
2118
2167
ReturnSetInfo *rsi;
2119
2168
ErrorContextCallback pl_error_context;
2122
* Create the call_data before connecting to SPI, so that it is not
2123
* allocated in the SPI memory context
2125
current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
2126
current_call_data->fcinfo = fcinfo;
2128
2170
if (SPI_connect() != SPI_OK_CONNECT)
2129
2171
elog(ERROR, "could not connect to SPI manager");
2131
2173
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
2132
2174
current_call_data->prodesc = prodesc;
2175
increment_prodesc_refcount(prodesc);
2134
2177
/* Set a callback for error reporting */
2135
2178
pl_error_context.callback = plperl_exec_callback;
2237
2280
ErrorContextCallback pl_error_context;
2240
* Create the call_data before connecting to SPI, so that it is not
2241
* allocated in the SPI memory context
2243
current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
2244
current_call_data->fcinfo = fcinfo;
2246
2282
/* Connect to SPI manager */
2247
2283
if (SPI_connect() != SPI_OK_CONNECT)
2248
2284
elog(ERROR, "could not connect to SPI manager");
2250
2286
/* Find or compile the function */
2251
2287
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, true);
2252
2288
current_call_data->prodesc = prodesc;
2289
increment_prodesc_refcount(prodesc);
2254
2291
/* Set a callback for error reporting */
2255
2292
pl_error_context.callback = plperl_exec_callback;
2360
2397
/* Otherwise, unlink the obsoleted entry from the hashtable ... */
2361
2398
proc_ptr->proc_ptr = NULL;
2362
/* ... and throw it away */
2363
if (prodesc->reference)
2365
plperl_interp_desc *oldinterp = plperl_active_interp;
2367
activate_interpreter(prodesc->interp);
2368
SvREFCNT_dec(prodesc->reference);
2369
activate_interpreter(oldinterp);
2399
/* ... and release the corresponding refcount, probably deleting it */
2400
decrement_prodesc_refcount(prodesc);
2408
free_plperl_function(plperl_proc_desc *prodesc)
2410
Assert(prodesc->refcount <= 0);
2411
/* Release CODE reference, if we have one, from the appropriate interp */
2412
if (prodesc->reference)
2414
plperl_interp_desc *oldinterp = plperl_active_interp;
2416
activate_interpreter(prodesc->interp);
2417
SvREFCNT_dec(prodesc->reference);
2418
activate_interpreter(oldinterp);
2420
/* Get rid of what we conveniently can of our own structs */
2421
/* (FmgrInfo subsidiary info will get leaked ...) */
2422
if (prodesc->proname)
2371
2423
free(prodesc->proname);
2447
2496
(errcode(ERRCODE_OUT_OF_MEMORY),
2448
2497
errmsg("out of memory")));
2498
/* Initialize all fields to 0 so free_plperl_function is safe */
2449
2499
MemSet(prodesc, 0, sizeof(plperl_proc_desc));
2450
2501
prodesc->proname = strdup(NameStr(procStruct->proname));
2451
2502
if (prodesc->proname == NULL)
2504
free_plperl_function(prodesc);
2453
2506
(errcode(ERRCODE_OUT_OF_MEMORY),
2454
2507
errmsg("out of memory")));
2455
2509
prodesc->fn_xmin = HeapTupleHeaderGetXmin(procTup->t_data);
2456
2510
prodesc->fn_tid = procTup->t_self;
2466
2520
ObjectIdGetDatum(procStruct->prolang));
2467
2521
if (!HeapTupleIsValid(langTup))
2469
free(prodesc->proname);
2523
free_plperl_function(prodesc);
2471
2524
elog(ERROR, "cache lookup failed for language %u",
2472
2525
procStruct->prolang);
2486
2539
ObjectIdGetDatum(procStruct->prorettype));
2487
2540
if (!HeapTupleIsValid(typeTup))
2489
free(prodesc->proname);
2542
free_plperl_function(prodesc);
2491
2543
elog(ERROR, "cache lookup failed for type %u",
2492
2544
procStruct->prorettype);
2502
2554
else if (procStruct->prorettype == TRIGGEROID)
2504
free(prodesc->proname);
2556
free_plperl_function(prodesc);
2507
2558
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2508
2559
errmsg("trigger functions can only be called "
2546
2596
ObjectIdGetDatum(procStruct->proargtypes.values[i]));
2547
2597
if (!HeapTupleIsValid(typeTup))
2549
free(prodesc->proname);
2599
free_plperl_function(prodesc);
2551
2600
elog(ERROR, "cache lookup failed for type %u",
2552
2601
procStruct->proargtypes.values[i]);
2557
2606
if (typeStruct->typtype == TYPTYPE_PSEUDO &&
2558
2607
procStruct->proargtypes.values[i] != RECORDOID)
2560
free(prodesc->proname);
2609
free_plperl_function(prodesc);
2563
2611
(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
2564
2612
errmsg("PL/Perl functions cannot accept type %s",
2624
2671
proc_ptr = hash_search(plperl_proc_hash, &proc_key,
2625
2672
HASH_ENTER, NULL);
2626
2673
proc_ptr->proc_ptr = prodesc;
2674
increment_prodesc_refcount(prodesc);
2629
2677
/* restore previous error callback */
added
removed
src/pl/plperl/plperl.c
