1 /**********************************************************************
2 * pltcl.c - PostgreSQL support for Tcl as
3 * procedural language (PL)
4 *
5 * src/pl/tcl/pltcl.c
6 *
7 **********************************************************************/
8
9 #include "postgres.h"
10
11 #include <tcl.h>
12
13 #include <unistd.h>
14 #include <fcntl.h>
15
16 #include "access/htup_details.h"
17 #include "access/xact.h"
18 #include "catalog/objectaccess.h"
19 #include "catalog/pg_proc.h"
20 #include "catalog/pg_type.h"
21 #include "commands/event_trigger.h"
22 #include "commands/trigger.h"
23 #include "executor/spi.h"
24 #include "fmgr.h"
25 #include "funcapi.h"
26 #include "mb/pg_wchar.h"
27 #include "miscadmin.h"
28 #include "nodes/makefuncs.h"
29 #include "parser/parse_func.h"
30 #include "parser/parse_type.h"
31 #include "pgstat.h"
32 #include "tcop/tcopprot.h"
33 #include "utils/builtins.h"
34 #include "utils/lsyscache.h"
35 #include "utils/memutils.h"
36 #include "utils/regproc.h"
37 #include "utils/rel.h"
38 #include "utils/syscache.h"
39 #include "utils/typcache.h"
40
41
42 PG_MODULE_MAGIC;
43
44 #define HAVE_TCL_VERSION(maj,min) \
45 ((TCL_MAJOR_VERSION > maj) || \
46 (TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
47
48 /* Insist on Tcl >= 8.4 */
49 #if !HAVE_TCL_VERSION(8,4)
50 #error PostgreSQL only supports Tcl 8.4 or later.
51 #endif
52
53 /* Hack to deal with Tcl 8.6 const-ification without losing compatibility */
54 #ifndef CONST86
55 #define CONST86
56 #endif
57
58 /* define our text domain for translations */
59 #undef TEXTDOMAIN
60 #define TEXTDOMAIN PG_TEXTDOMAIN("pltcl")
61
62
63 /*
64 * Support for converting between UTF8 (which is what all strings going into
65 * or out of Tcl should be) and the database encoding.
66 *
67 * If you just use utf_u2e() or utf_e2u() directly, they will leak some
68 * palloc'd space when doing a conversion. This is not worth worrying about
69 * if it only happens, say, once per PL/Tcl function call. If it does seem
70 * worth worrying about, use the wrapper macros.
71 */
72
73 static inline char *
utf_u2e(const char * src)74 utf_u2e(const char *src)
75 {
76 return pg_any_to_server(src, strlen(src), PG_UTF8);
77 }
78
79 static inline char *
utf_e2u(const char * src)80 utf_e2u(const char *src)
81 {
82 return pg_server_to_any(src, strlen(src), PG_UTF8);
83 }
84
85 #define UTF_BEGIN \
86 do { \
87 const char *_pltcl_utf_src = NULL; \
88 char *_pltcl_utf_dst = NULL
89
90 #define UTF_END \
91 if (_pltcl_utf_src != (const char *) _pltcl_utf_dst) \
92 pfree(_pltcl_utf_dst); \
93 } while (0)
94
95 #define UTF_U2E(x) \
96 (_pltcl_utf_dst = utf_u2e(_pltcl_utf_src = (x)))
97
98 #define UTF_E2U(x) \
99 (_pltcl_utf_dst = utf_e2u(_pltcl_utf_src = (x)))
100
101
102 /**********************************************************************
103 * Information associated with a Tcl interpreter. We have one interpreter
104 * that is used for all pltclu (untrusted) functions. For pltcl (trusted)
105 * functions, there is a separate interpreter for each effective SQL userid.
106 * (This is needed to ensure that an unprivileged user can't inject Tcl code
107 * that'll be executed with the privileges of some other SQL user.)
108 *
109 * The pltcl_interp_desc structs are kept in a Postgres hash table indexed
110 * by userid OID, with OID 0 used for the single untrusted interpreter.
111 **********************************************************************/
112 typedef struct pltcl_interp_desc
113 {
114 Oid user_id; /* Hash key (must be first!) */
115 Tcl_Interp *interp; /* The interpreter */
116 Tcl_HashTable query_hash; /* pltcl_query_desc structs */
117 } pltcl_interp_desc;
118
119
120 /**********************************************************************
121 * The information we cache about loaded procedures
122 *
123 * The pltcl_proc_desc struct itself, as well as all subsidiary data,
124 * is stored in the memory context identified by the fn_cxt field.
125 * We can reclaim all the data by deleting that context, and should do so
126 * when the fn_refcount goes to zero. (But note that we do not bother
127 * trying to clean up Tcl's copy of the procedure definition: it's Tcl's
128 * problem to manage its memory when we replace a proc definition. We do
129 * not clean up pltcl_proc_descs when a pg_proc row is deleted, only when
130 * it is updated, and the same policy applies to Tcl's copy as well.)
131 *
132 * Note that the data in this struct is shared across all active calls;
133 * nothing except the fn_refcount should be changed by a call instance.
134 **********************************************************************/
135 typedef struct pltcl_proc_desc
136 {
137 char *user_proname; /* user's name (from pg_proc.proname) */
138 char *internal_proname; /* Tcl name (based on function OID) */
139 MemoryContext fn_cxt; /* memory context for this procedure */
140 unsigned long fn_refcount; /* number of active references */
141 TransactionId fn_xmin; /* xmin of pg_proc row */
142 ItemPointerData fn_tid; /* TID of pg_proc row */
143 bool fn_readonly; /* is function readonly? */
144 bool lanpltrusted; /* is it pltcl (vs. pltclu)? */
145 pltcl_interp_desc *interp_desc; /* interpreter to use */
146 FmgrInfo result_in_func; /* input function for fn's result type */
147 Oid result_typioparam; /* param to pass to same */
148 bool fn_retisset; /* true if function returns a set */
149 bool fn_retistuple; /* true if function returns composite */
150 int nargs; /* number of arguments */
151 /* these arrays have nargs entries: */
152 FmgrInfo *arg_out_func; /* output fns for arg types */
153 bool *arg_is_rowtype; /* is each arg composite? */
154 } pltcl_proc_desc;
155
156
157 /**********************************************************************
158 * The information we cache about prepared and saved plans
159 **********************************************************************/
160 typedef struct pltcl_query_desc
161 {
162 char qname[20];
163 SPIPlanPtr plan;
164 int nargs;
165 Oid *argtypes;
166 FmgrInfo *arginfuncs;
167 Oid *argtypioparams;
168 } pltcl_query_desc;
169
170
171 /**********************************************************************
172 * For speedy lookup, we maintain a hash table mapping from
173 * function OID + trigger flag + user OID to pltcl_proc_desc pointers.
174 * The reason the pltcl_proc_desc struct isn't directly part of the hash
175 * entry is to simplify recovery from errors during compile_pltcl_function.
176 *
177 * Note: if the same function is called by multiple userIDs within a session,
178 * there will be a separate pltcl_proc_desc entry for each userID in the case
179 * of pltcl functions, but only one entry for pltclu functions, because we
180 * set user_id = 0 for that case.
181 **********************************************************************/
182 typedef struct pltcl_proc_key
183 {
184 Oid proc_id; /* Function OID */
185
186 /*
187 * is_trigger is really a bool, but declare as Oid to ensure this struct
188 * contains no padding
189 */
190 Oid is_trigger; /* is it a trigger function? */
191 Oid user_id; /* User calling the function, or 0 */
192 } pltcl_proc_key;
193
194 typedef struct pltcl_proc_ptr
195 {
196 pltcl_proc_key proc_key; /* Hash key (must be first!) */
197 pltcl_proc_desc *proc_ptr;
198 } pltcl_proc_ptr;
199
200
201 /**********************************************************************
202 * Per-call state
203 **********************************************************************/
204 typedef struct pltcl_call_state
205 {
206 /* Call info struct, or NULL in a trigger */
207 FunctionCallInfo fcinfo;
208
209 /* Trigger data, if we're in a normal (not event) trigger; else NULL */
210 TriggerData *trigdata;
211
212 /* Function we're executing (NULL if not yet identified) */
213 pltcl_proc_desc *prodesc;
214
215 /*
216 * Information for SRFs and functions returning composite types.
217 * ret_tupdesc and attinmeta are set up if either fn_retistuple or
218 * fn_retisset, since even a scalar-returning SRF needs a tuplestore.
219 */
220 TupleDesc ret_tupdesc; /* return rowtype, if retistuple or retisset */
221 AttInMetadata *attinmeta; /* metadata for building tuples of that type */
222
223 ReturnSetInfo *rsi; /* passed-in ReturnSetInfo, if any */
224 Tuplestorestate *tuple_store; /* SRFs accumulate result here */
225 MemoryContext tuple_store_cxt; /* context and resowner for tuplestore */
226 ResourceOwner tuple_store_owner;
227 } pltcl_call_state;
228
229
230 /**********************************************************************
231 * Global data
232 **********************************************************************/
233 static char *pltcl_start_proc = NULL;
234 static char *pltclu_start_proc = NULL;
235 static bool pltcl_pm_init_done = false;
236 static Tcl_Interp *pltcl_hold_interp = NULL;
237 static HTAB *pltcl_interp_htab = NULL;
238 static HTAB *pltcl_proc_htab = NULL;
239
240 /* this is saved and restored by pltcl_handler */
241 static pltcl_call_state *pltcl_current_call_state = NULL;
242
243 /**********************************************************************
244 * Lookup table for SQLSTATE condition names
245 **********************************************************************/
246 typedef struct
247 {
248 const char *label;
249 int sqlerrstate;
250 } TclExceptionNameMap;
251
252 static const TclExceptionNameMap exception_name_map[] = {
253 #include "pltclerrcodes.h" /* pgrminclude ignore */
254 {NULL, 0}
255 };
256
257 /**********************************************************************
258 * Forward declarations
259 **********************************************************************/
260 void _PG_init(void);
261
262 static void pltcl_init_interp(pltcl_interp_desc *interp_desc,
263 Oid prolang, bool pltrusted);
264 static pltcl_interp_desc *pltcl_fetch_interp(Oid prolang, bool pltrusted);
265 static void call_pltcl_start_proc(Oid prolang, bool pltrusted);
266 static void start_proc_error_callback(void *arg);
267
268 static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
269
270 static Datum pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
271 bool pltrusted);
272 static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
273 bool pltrusted);
274 static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
275 bool pltrusted);
276
277 static void throw_tcl_error(Tcl_Interp *interp, const char *proname);
278
279 static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid,
280 bool is_event_trigger,
281 bool pltrusted);
282
283 static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
284 int objc, Tcl_Obj *const objv[]);
285 static void pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata);
286 static const char *pltcl_get_condition_name(int sqlstate);
287 static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
288 int objc, Tcl_Obj *const objv[]);
289 static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
290 int objc, Tcl_Obj *const objv[]);
291 static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
292 int objc, Tcl_Obj *const objv[]);
293 static int pltcl_returnnext(ClientData cdata, Tcl_Interp *interp,
294 int objc, Tcl_Obj *const objv[]);
295 static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
296 int objc, Tcl_Obj *const objv[]);
297 static int pltcl_process_SPI_result(Tcl_Interp *interp,
298 const char *arrayname,
299 Tcl_Obj *loop_body,
300 int spi_rc,
301 SPITupleTable *tuptable,
302 uint64 ntuples);
303 static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
304 int objc, Tcl_Obj *const objv[]);
305 static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
306 int objc, Tcl_Obj *const objv[]);
307 static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
308 int objc, Tcl_Obj *const objv[]);
309 static int pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp,
310 int objc, Tcl_Obj *const objv[]);
311
312 static void pltcl_subtrans_begin(MemoryContext oldcontext,
313 ResourceOwner oldowner);
314 static void pltcl_subtrans_commit(MemoryContext oldcontext,
315 ResourceOwner oldowner);
316 static void pltcl_subtrans_abort(Tcl_Interp *interp,
317 MemoryContext oldcontext,
318 ResourceOwner oldowner);
319
320 static void pltcl_set_tuple_values(Tcl_Interp *interp, const char *arrayname,
321 uint64 tupno, HeapTuple tuple, TupleDesc tupdesc);
322 static Tcl_Obj *pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc);
323 static HeapTuple pltcl_build_tuple_result(Tcl_Interp *interp,
324 Tcl_Obj **kvObjv, int kvObjc,
325 pltcl_call_state *call_state);
326 static void pltcl_init_tuple_store(pltcl_call_state *call_state);
327
328
329 /*
330 * Hack to override Tcl's builtin Notifier subsystem. This prevents the
331 * backend from becoming multithreaded, which breaks all sorts of things.
332 * That happens in the default version of Tcl_InitNotifier if the TCL library
333 * has been compiled with multithreading support (i.e. when TCL_THREADS is
334 * defined under Unix, and in all cases under Windows).
335 * It's okay to disable the notifier because we never enter the Tcl event loop
336 * from Postgres, so the notifier capabilities are initialized, but never
337 * used. Only InitNotifier and DeleteFileHandler ever seem to get called
338 * within Postgres, but we implement all the functions for completeness.
339 */
340 static ClientData
pltcl_InitNotifier(void)341 pltcl_InitNotifier(void)
342 {
343 static int fakeThreadKey; /* To give valid address for ClientData */
344
345 return (ClientData) &(fakeThreadKey);
346 }
347
348 static void
pltcl_FinalizeNotifier(ClientData clientData)349 pltcl_FinalizeNotifier(ClientData clientData)
350 {
351 }
352
353 static void
pltcl_SetTimer(CONST86 Tcl_Time * timePtr)354 pltcl_SetTimer(CONST86 Tcl_Time *timePtr)
355 {
356 }
357
358 static void
pltcl_AlertNotifier(ClientData clientData)359 pltcl_AlertNotifier(ClientData clientData)
360 {
361 }
362
363 static void
pltcl_CreateFileHandler(int fd,int mask,Tcl_FileProc * proc,ClientData clientData)364 pltcl_CreateFileHandler(int fd, int mask,
365 Tcl_FileProc *proc, ClientData clientData)
366 {
367 }
368
369 static void
pltcl_DeleteFileHandler(int fd)370 pltcl_DeleteFileHandler(int fd)
371 {
372 }
373
374 static void
pltcl_ServiceModeHook(int mode)375 pltcl_ServiceModeHook(int mode)
376 {
377 }
378
379 static int
pltcl_WaitForEvent(CONST86 Tcl_Time * timePtr)380 pltcl_WaitForEvent(CONST86 Tcl_Time *timePtr)
381 {
382 return 0;
383 }
384
385
386 /*
387 * _PG_init() - library load-time initialization
388 *
389 * DO NOT make this static nor change its name!
390 *
391 * The work done here must be safe to do in the postmaster process,
392 * in case the pltcl library is preloaded in the postmaster.
393 */
394 void
_PG_init(void)395 _PG_init(void)
396 {
397 Tcl_NotifierProcs notifier;
398 HASHCTL hash_ctl;
399
400 /* Be sure we do initialization only once (should be redundant now) */
401 if (pltcl_pm_init_done)
402 return;
403
404 pg_bindtextdomain(TEXTDOMAIN);
405
406 #ifdef WIN32
407 /* Required on win32 to prevent error loading init.tcl */
408 Tcl_FindExecutable("");
409 #endif
410
411 /*
412 * Override the functions in the Notifier subsystem. See comments above.
413 */
414 notifier.setTimerProc = pltcl_SetTimer;
415 notifier.waitForEventProc = pltcl_WaitForEvent;
416 notifier.createFileHandlerProc = pltcl_CreateFileHandler;
417 notifier.deleteFileHandlerProc = pltcl_DeleteFileHandler;
418 notifier.initNotifierProc = pltcl_InitNotifier;
419 notifier.finalizeNotifierProc = pltcl_FinalizeNotifier;
420 notifier.alertNotifierProc = pltcl_AlertNotifier;
421 notifier.serviceModeHookProc = pltcl_ServiceModeHook;
422 Tcl_SetNotifier(¬ifier);
423
424 /************************************************************
425 * Create the dummy hold interpreter to prevent close of
426 * stdout and stderr on DeleteInterp
427 ************************************************************/
428 if ((pltcl_hold_interp = Tcl_CreateInterp()) == NULL)
429 elog(ERROR, "could not create master Tcl interpreter");
430 if (Tcl_Init(pltcl_hold_interp) == TCL_ERROR)
431 elog(ERROR, "could not initialize master Tcl interpreter");
432
433 /************************************************************
434 * Create the hash table for working interpreters
435 ************************************************************/
436 memset(&hash_ctl, 0, sizeof(hash_ctl));
437 hash_ctl.keysize = sizeof(Oid);
438 hash_ctl.entrysize = sizeof(pltcl_interp_desc);
439 pltcl_interp_htab = hash_create("PL/Tcl interpreters",
440 8,
441 &hash_ctl,
442 HASH_ELEM | HASH_BLOBS);
443
444 /************************************************************
445 * Create the hash table for function lookup
446 ************************************************************/
447 memset(&hash_ctl, 0, sizeof(hash_ctl));
448 hash_ctl.keysize = sizeof(pltcl_proc_key);
449 hash_ctl.entrysize = sizeof(pltcl_proc_ptr);
450 pltcl_proc_htab = hash_create("PL/Tcl functions",
451 100,
452 &hash_ctl,
453 HASH_ELEM | HASH_BLOBS);
454
455 /************************************************************
456 * Define PL/Tcl's custom GUCs
457 ************************************************************/
458 DefineCustomStringVariable("pltcl.start_proc",
459 gettext_noop("PL/Tcl function to call once when pltcl is first used."),
460 NULL,
461 &pltcl_start_proc,
462 NULL,
463 PGC_SUSET, 0,
464 NULL, NULL, NULL);
465 DefineCustomStringVariable("pltclu.start_proc",
466 gettext_noop("PL/TclU function to call once when pltclu is first used."),
467 NULL,
468 &pltclu_start_proc,
469 NULL,
470 PGC_SUSET, 0,
471 NULL, NULL, NULL);
472
473 pltcl_pm_init_done = true;
474 }
475
476 /**********************************************************************
477 * pltcl_init_interp() - initialize a new Tcl interpreter
478 **********************************************************************/
479 static void
pltcl_init_interp(pltcl_interp_desc * interp_desc,Oid prolang,bool pltrusted)480 pltcl_init_interp(pltcl_interp_desc *interp_desc, Oid prolang, bool pltrusted)
481 {
482 Tcl_Interp *interp;
483 char interpname[32];
484
485 /************************************************************
486 * Create the Tcl interpreter as a slave of pltcl_hold_interp.
487 * Note: Tcl automatically does Tcl_Init in the untrusted case,
488 * and it's not wanted in the trusted case.
489 ************************************************************/
490 snprintf(interpname, sizeof(interpname), "slave_%u", interp_desc->user_id);
491 if ((interp = Tcl_CreateSlave(pltcl_hold_interp, interpname,
492 pltrusted ? 1 : 0)) == NULL)
493 elog(ERROR, "could not create slave Tcl interpreter");
494
495 /************************************************************
496 * Initialize the query hash table associated with interpreter
497 ************************************************************/
498 Tcl_InitHashTable(&interp_desc->query_hash, TCL_STRING_KEYS);
499
500 /************************************************************
501 * Install the commands for SPI support in the interpreter
502 ************************************************************/
503 Tcl_CreateObjCommand(interp, "elog",
504 pltcl_elog, NULL, NULL);
505 Tcl_CreateObjCommand(interp, "quote",
506 pltcl_quote, NULL, NULL);
507 Tcl_CreateObjCommand(interp, "argisnull",
508 pltcl_argisnull, NULL, NULL);
509 Tcl_CreateObjCommand(interp, "return_null",
510 pltcl_returnnull, NULL, NULL);
511 Tcl_CreateObjCommand(interp, "return_next",
512 pltcl_returnnext, NULL, NULL);
513 Tcl_CreateObjCommand(interp, "spi_exec",
514 pltcl_SPI_execute, NULL, NULL);
515 Tcl_CreateObjCommand(interp, "spi_prepare",
516 pltcl_SPI_prepare, NULL, NULL);
517 Tcl_CreateObjCommand(interp, "spi_execp",
518 pltcl_SPI_execute_plan, NULL, NULL);
519 Tcl_CreateObjCommand(interp, "spi_lastoid",
520 pltcl_SPI_lastoid, NULL, NULL);
521 Tcl_CreateObjCommand(interp, "subtransaction",
522 pltcl_subtransaction, NULL, NULL);
523
524 /************************************************************
525 * Call the appropriate start_proc, if there is one.
526 *
527 * We must set interp_desc->interp before the call, else the start_proc
528 * won't find the interpreter it's supposed to use. But, if the
529 * start_proc fails, we want to abandon use of the interpreter.
530 ************************************************************/
531 PG_TRY();
532 {
533 interp_desc->interp = interp;
534 call_pltcl_start_proc(prolang, pltrusted);
535 }
536 PG_CATCH();
537 {
538 interp_desc->interp = NULL;
539 Tcl_DeleteInterp(interp);
540 PG_RE_THROW();
541 }
542 PG_END_TRY();
543 }
544
545 /**********************************************************************
546 * pltcl_fetch_interp() - fetch the Tcl interpreter to use for a function
547 *
548 * This also takes care of any on-first-use initialization required.
549 **********************************************************************/
550 static pltcl_interp_desc *
pltcl_fetch_interp(Oid prolang,bool pltrusted)551 pltcl_fetch_interp(Oid prolang, bool pltrusted)
552 {
553 Oid user_id;
554 pltcl_interp_desc *interp_desc;
555 bool found;
556
557 /* Find or create the interpreter hashtable entry for this userid */
558 if (pltrusted)
559 user_id = GetUserId();
560 else
561 user_id = InvalidOid;
562
563 interp_desc = hash_search(pltcl_interp_htab, &user_id,
564 HASH_ENTER,
565 &found);
566 if (!found)
567 interp_desc->interp = NULL;
568
569 /* If we haven't yet successfully made an interpreter, try to do that */
570 if (!interp_desc->interp)
571 pltcl_init_interp(interp_desc, prolang, pltrusted);
572
573 return interp_desc;
574 }
575
576
577 /**********************************************************************
578 * call_pltcl_start_proc() - Call user-defined initialization proc, if any
579 **********************************************************************/
580 static void
call_pltcl_start_proc(Oid prolang,bool pltrusted)581 call_pltcl_start_proc(Oid prolang, bool pltrusted)
582 {
583 char *start_proc;
584 const char *gucname;
585 ErrorContextCallback errcallback;
586 List *namelist;
587 Oid fargtypes[1]; /* dummy */
588 Oid procOid;
589 HeapTuple procTup;
590 Form_pg_proc procStruct;
591 AclResult aclresult;
592 FmgrInfo finfo;
593 FunctionCallInfoData fcinfo;
594 PgStat_FunctionCallUsage fcusage;
595
596 /* select appropriate GUC */
597 start_proc = pltrusted ? pltcl_start_proc : pltclu_start_proc;
598 gucname = pltrusted ? "pltcl.start_proc" : "pltclu.start_proc";
599
600 /* Nothing to do if it's empty or unset */
601 if (start_proc == NULL || start_proc[0] == '\0')
602 return;
603
604 /* Set up errcontext callback to make errors more helpful */
605 errcallback.callback = start_proc_error_callback;
606 errcallback.arg = (void *) gucname;
607 errcallback.previous = error_context_stack;
608 error_context_stack = &errcallback;
609
610 /* Parse possibly-qualified identifier and look up the function */
611 namelist = stringToQualifiedNameList(start_proc);
612 procOid = LookupFuncName(namelist, 0, fargtypes, false);
613
614 /* Current user must have permission to call function */
615 aclresult = pg_proc_aclcheck(procOid, GetUserId(), ACL_EXECUTE);
616 if (aclresult != ACLCHECK_OK)
617 aclcheck_error(aclresult, ACL_KIND_PROC, start_proc);
618
619 /* Get the function's pg_proc entry */
620 procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(procOid));
621 if (!HeapTupleIsValid(procTup))
622 elog(ERROR, "cache lookup failed for function %u", procOid);
623 procStruct = (Form_pg_proc) GETSTRUCT(procTup);
624
625 /* It must be same language as the function we're currently calling */
626 if (procStruct->prolang != prolang)
627 ereport(ERROR,
628 (errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE),
629 errmsg("function \"%s\" is in the wrong language",
630 start_proc)));
631
632 /*
633 * It must not be SECURITY DEFINER, either. This together with the
634 * language match check ensures that the function will execute in the same
635 * Tcl interpreter we just finished initializing.
636 */
637 if (procStruct->prosecdef)
638 ereport(ERROR,
639 (errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE),
640 errmsg("function \"%s\" must not be SECURITY DEFINER",
641 start_proc)));
642
643 /* A-OK */
644 ReleaseSysCache(procTup);
645
646 /*
647 * Call the function using the normal SQL function call mechanism. We
648 * could perhaps cheat and jump directly to pltcl_handler(), but it seems
649 * better to do it this way so that the call is exposed to, eg, call
650 * statistics collection.
651 */
652 InvokeFunctionExecuteHook(procOid);
653 fmgr_info(procOid, &finfo);
654 InitFunctionCallInfoData(fcinfo, &finfo,
655 0,
656 InvalidOid, NULL, NULL);
657 pgstat_init_function_usage(&fcinfo, &fcusage);
658 (void) FunctionCallInvoke(&fcinfo);
659 pgstat_end_function_usage(&fcusage, true);
660
661 /* Pop the error context stack */
662 error_context_stack = errcallback.previous;
663 }
664
665 /*
666 * Error context callback for errors occurring during start_proc processing.
667 */
668 static void
start_proc_error_callback(void * arg)669 start_proc_error_callback(void *arg)
670 {
671 const char *gucname = (const char *) arg;
672
673 /* translator: %s is "pltcl.start_proc" or "pltclu.start_proc" */
674 errcontext("processing %s parameter", gucname);
675 }
676
677
678 /**********************************************************************
679 * pltcl_call_handler - This is the only visible function
680 * of the PL interpreter. The PostgreSQL
681 * function manager and trigger manager
682 * call this function for execution of
683 * PL/Tcl procedures.
684 **********************************************************************/
685 PG_FUNCTION_INFO_V1(pltcl_call_handler);
686
687 /* keep non-static */
688 Datum
pltcl_call_handler(PG_FUNCTION_ARGS)689 pltcl_call_handler(PG_FUNCTION_ARGS)
690 {
691 return pltcl_handler(fcinfo, true);
692 }
693
694 /*
695 * Alternative handler for unsafe functions
696 */
697 PG_FUNCTION_INFO_V1(pltclu_call_handler);
698
699 /* keep non-static */
700 Datum
pltclu_call_handler(PG_FUNCTION_ARGS)701 pltclu_call_handler(PG_FUNCTION_ARGS)
702 {
703 return pltcl_handler(fcinfo, false);
704 }
705
706
707 /**********************************************************************
708 * pltcl_handler() - Handler for function and trigger calls, for
709 * both trusted and untrusted interpreters.
710 **********************************************************************/
711 static Datum
pltcl_handler(PG_FUNCTION_ARGS,bool pltrusted)712 pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
713 {
714 Datum retval;
715 pltcl_call_state current_call_state;
716 pltcl_call_state *save_call_state;
717
718 /*
719 * Initialize current_call_state to nulls/zeroes; in particular, set its
720 * prodesc pointer to null. Anything that sets it non-null should
721 * increase the prodesc's fn_refcount at the same time. We'll decrease
722 * the refcount, and then delete the prodesc if it's no longer referenced,
723 * on the way out of this function. This ensures that prodescs live as
724 * long as needed even if somebody replaces the originating pg_proc row
725 * while they're executing.
726 */
727 memset(¤t_call_state, 0, sizeof(current_call_state));
728
729 /*
730 * Ensure that static pointer is saved/restored properly
731 */
732 save_call_state = pltcl_current_call_state;
733 pltcl_current_call_state = ¤t_call_state;
734
735 PG_TRY();
736 {
737 /*
738 * Determine if called as function or trigger and call appropriate
739 * subhandler
740 */
741 if (CALLED_AS_TRIGGER(fcinfo))
742 {
743 /* invoke the trigger handler */
744 retval = PointerGetDatum(pltcl_trigger_handler(fcinfo,
745 ¤t_call_state,
746 pltrusted));
747 }
748 else if (CALLED_AS_EVENT_TRIGGER(fcinfo))
749 {
750 /* invoke the event trigger handler */
751 pltcl_event_trigger_handler(fcinfo, ¤t_call_state, pltrusted);
752 retval = (Datum) 0;
753 }
754 else
755 {
756 /* invoke the regular function handler */
757 current_call_state.fcinfo = fcinfo;
758 retval = pltcl_func_handler(fcinfo, ¤t_call_state, pltrusted);
759 }
760 }
761 PG_CATCH();
762 {
763 /* Restore static pointer, then clean up the prodesc refcount if any */
764 pltcl_current_call_state = save_call_state;
765 if (current_call_state.prodesc != NULL)
766 {
767 Assert(current_call_state.prodesc->fn_refcount > 0);
768 if (--current_call_state.prodesc->fn_refcount == 0)
769 MemoryContextDelete(current_call_state.prodesc->fn_cxt);
770 }
771 PG_RE_THROW();
772 }
773 PG_END_TRY();
774
775 /* Restore static pointer, then clean up the prodesc refcount if any */
776 /* (We're being paranoid in case an error is thrown in context deletion) */
777 pltcl_current_call_state = save_call_state;
778 if (current_call_state.prodesc != NULL)
779 {
780 Assert(current_call_state.prodesc->fn_refcount > 0);
781 if (--current_call_state.prodesc->fn_refcount == 0)
782 MemoryContextDelete(current_call_state.prodesc->fn_cxt);
783 }
784
785 return retval;
786 }
787
788
789 /**********************************************************************
790 * pltcl_func_handler() - Handler for regular function calls
791 **********************************************************************/
792 static Datum
pltcl_func_handler(PG_FUNCTION_ARGS,pltcl_call_state * call_state,bool pltrusted)793 pltcl_func_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
794 bool pltrusted)
795 {
796 pltcl_proc_desc *prodesc;
797 Tcl_Interp *volatile interp;
798 Tcl_Obj *tcl_cmd;
799 int i;
800 int tcl_rc;
801 Datum retval;
802
803 /* Connect to SPI manager */
804 if (SPI_connect() != SPI_OK_CONNECT)
805 elog(ERROR, "could not connect to SPI manager");
806
807 /* Find or compile the function */
808 prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
809 false, pltrusted);
810
811 call_state->prodesc = prodesc;
812 prodesc->fn_refcount++;
813
814 interp = prodesc->interp_desc->interp;
815
816 /*
817 * If we're a SRF, check caller can handle materialize mode, and save
818 * relevant info into call_state. We must ensure that the returned
819 * tuplestore is owned by the caller's context, even if we first create it
820 * inside a subtransaction.
821 */
822 if (prodesc->fn_retisset)
823 {
824 ReturnSetInfo *rsi = (ReturnSetInfo *) fcinfo->resultinfo;
825
826 if (!rsi || !IsA(rsi, ReturnSetInfo) ||
827 (rsi->allowedModes & SFRM_Materialize) == 0)
828 ereport(ERROR,
829 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
830 errmsg("set-valued function called in context that cannot accept a set")));
831
832 call_state->rsi = rsi;
833 call_state->tuple_store_cxt = rsi->econtext->ecxt_per_query_memory;
834 call_state->tuple_store_owner = CurrentResourceOwner;
835 }
836
837 /************************************************************
838 * Create the tcl command to call the internal
839 * proc in the Tcl interpreter
840 ************************************************************/
841 tcl_cmd = Tcl_NewObj();
842 Tcl_ListObjAppendElement(NULL, tcl_cmd,
843 Tcl_NewStringObj(prodesc->internal_proname, -1));
844
845 /* We hold a refcount on tcl_cmd just to be sure it stays around */
846 Tcl_IncrRefCount(tcl_cmd);
847
848 /************************************************************
849 * Add all call arguments to the command
850 ************************************************************/
851 PG_TRY();
852 {
853 for (i = 0; i < prodesc->nargs; i++)
854 {
855 if (prodesc->arg_is_rowtype[i])
856 {
857 /**************************************************
858 * For tuple values, add a list for 'array set ...'
859 **************************************************/
860 if (fcinfo->argnull[i])
861 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
862 else
863 {
864 HeapTupleHeader td;
865 Oid tupType;
866 int32 tupTypmod;
867 TupleDesc tupdesc;
868 HeapTupleData tmptup;
869 Tcl_Obj *list_tmp;
870
871 td = DatumGetHeapTupleHeader(fcinfo->arg[i]);
872 /* Extract rowtype info and find a tupdesc */
873 tupType = HeapTupleHeaderGetTypeId(td);
874 tupTypmod = HeapTupleHeaderGetTypMod(td);
875 tupdesc = lookup_rowtype_tupdesc(tupType, tupTypmod);
876 /* Build a temporary HeapTuple control structure */
877 tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
878 tmptup.t_data = td;
879
880 list_tmp = pltcl_build_tuple_argument(&tmptup, tupdesc);
881 Tcl_ListObjAppendElement(NULL, tcl_cmd, list_tmp);
882
883 ReleaseTupleDesc(tupdesc);
884 }
885 }
886 else
887 {
888 /**************************************************
889 * Single values are added as string element
890 * of their external representation
891 **************************************************/
892 if (fcinfo->argnull[i])
893 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
894 else
895 {
896 char *tmp;
897
898 tmp = OutputFunctionCall(&prodesc->arg_out_func[i],
899 fcinfo->arg[i]);
900 UTF_BEGIN;
901 Tcl_ListObjAppendElement(NULL, tcl_cmd,
902 Tcl_NewStringObj(UTF_E2U(tmp), -1));
903 UTF_END;
904 pfree(tmp);
905 }
906 }
907 }
908 }
909 PG_CATCH();
910 {
911 /* Release refcount to free tcl_cmd */
912 Tcl_DecrRefCount(tcl_cmd);
913 PG_RE_THROW();
914 }
915 PG_END_TRY();
916
917 /************************************************************
918 * Call the Tcl function
919 *
920 * We assume no PG error can be thrown directly from this call.
921 ************************************************************/
922 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
923
924 /* Release refcount to free tcl_cmd (and all subsidiary objects) */
925 Tcl_DecrRefCount(tcl_cmd);
926
927 /************************************************************
928 * Check for errors reported by Tcl.
929 ************************************************************/
930 if (tcl_rc != TCL_OK)
931 throw_tcl_error(interp, prodesc->user_proname);
932
933 /************************************************************
934 * Disconnect from SPI manager and then create the return
935 * value datum (if the input function does a palloc for it
936 * this must not be allocated in the SPI memory context
937 * because SPI_finish would free it). But don't try to call
938 * the result_in_func if we've been told to return a NULL;
939 * the Tcl result may not be a valid value of the result type
940 * in that case.
941 ************************************************************/
942 if (SPI_finish() != SPI_OK_FINISH)
943 elog(ERROR, "SPI_finish() failed");
944
945 if (prodesc->fn_retisset)
946 {
947 ReturnSetInfo *rsi = call_state->rsi;
948
949 /* We already checked this is OK */
950 rsi->returnMode = SFRM_Materialize;
951
952 /* If we produced any tuples, send back the result */
953 if (call_state->tuple_store)
954 {
955 rsi->setResult = call_state->tuple_store;
956 if (call_state->ret_tupdesc)
957 {
958 MemoryContext oldcxt;
959
960 oldcxt = MemoryContextSwitchTo(call_state->tuple_store_cxt);
961 rsi->setDesc = CreateTupleDescCopy(call_state->ret_tupdesc);
962 MemoryContextSwitchTo(oldcxt);
963 }
964 }
965 retval = (Datum) 0;
966 fcinfo->isnull = true;
967 }
968 else if (fcinfo->isnull)
969 {
970 retval = InputFunctionCall(&prodesc->result_in_func,
971 NULL,
972 prodesc->result_typioparam,
973 -1);
974 }
975 else if (prodesc->fn_retistuple)
976 {
977 TupleDesc td;
978 HeapTuple tup;
979 Tcl_Obj *resultObj;
980 Tcl_Obj **resultObjv;
981 int resultObjc;
982
983 /*
984 * Set up data about result type. XXX it's tempting to consider
985 * caching this in the prodesc, in the common case where the rowtype
986 * is determined by the function not the calling query. But we'd have
987 * to be able to deal with ADD/DROP/ALTER COLUMN events when the
988 * result type is a named composite type, so it's not exactly trivial.
989 * Maybe worth improving someday.
990 */
991 if (get_call_result_type(fcinfo, NULL, &td) != TYPEFUNC_COMPOSITE)
992 ereport(ERROR,
993 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
994 errmsg("function returning record called in context "
995 "that cannot accept type record")));
996
997 Assert(!call_state->ret_tupdesc);
998 Assert(!call_state->attinmeta);
999 call_state->ret_tupdesc = td;
1000 call_state->attinmeta = TupleDescGetAttInMetadata(td);
1001
1002 /* Convert function result to tuple */
1003 resultObj = Tcl_GetObjResult(interp);
1004 if (Tcl_ListObjGetElements(interp, resultObj, &resultObjc, &resultObjv) == TCL_ERROR)
1005 throw_tcl_error(interp, prodesc->user_proname);
1006
1007 tup = pltcl_build_tuple_result(interp, resultObjv, resultObjc,
1008 call_state);
1009 retval = HeapTupleGetDatum(tup);
1010 }
1011 else
1012 retval = InputFunctionCall(&prodesc->result_in_func,
1013 utf_u2e(Tcl_GetStringResult(interp)),
1014 prodesc->result_typioparam,
1015 -1);
1016
1017 return retval;
1018 }
1019
1020
1021 /**********************************************************************
1022 * pltcl_trigger_handler() - Handler for trigger calls
1023 **********************************************************************/
1024 static HeapTuple
pltcl_trigger_handler(PG_FUNCTION_ARGS,pltcl_call_state * call_state,bool pltrusted)1025 pltcl_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
1026 bool pltrusted)
1027 {
1028 pltcl_proc_desc *prodesc;
1029 Tcl_Interp *volatile interp;
1030 TriggerData *trigdata = (TriggerData *) fcinfo->context;
1031 char *stroid;
1032 TupleDesc tupdesc;
1033 volatile HeapTuple rettup;
1034 Tcl_Obj *tcl_cmd;
1035 Tcl_Obj *tcl_trigtup;
1036 Tcl_Obj *tcl_newtup;
1037 int tcl_rc;
1038 int i;
1039 const char *result;
1040 int result_Objc;
1041 Tcl_Obj **result_Objv;
1042 int rc PG_USED_FOR_ASSERTS_ONLY;
1043
1044 call_state->trigdata = trigdata;
1045
1046 /* Connect to SPI manager */
1047 if (SPI_connect() != SPI_OK_CONNECT)
1048 elog(ERROR, "could not connect to SPI manager");
1049
1050 /* Make transition tables visible to this SPI connection */
1051 rc = SPI_register_trigger_data(trigdata);
1052 Assert(rc >= 0);
1053
1054 /* Find or compile the function */
1055 prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
1056 RelationGetRelid(trigdata->tg_relation),
1057 false, /* not an event trigger */
1058 pltrusted);
1059
1060 call_state->prodesc = prodesc;
1061 prodesc->fn_refcount++;
1062
1063 interp = prodesc->interp_desc->interp;
1064
1065 tupdesc = RelationGetDescr(trigdata->tg_relation);
1066
1067 /************************************************************
1068 * Create the tcl command to call the internal
1069 * proc in the interpreter
1070 ************************************************************/
1071 tcl_cmd = Tcl_NewObj();
1072 Tcl_IncrRefCount(tcl_cmd);
1073
1074 PG_TRY();
1075 {
1076 /* The procedure name (note this is all ASCII, so no utf_e2u) */
1077 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1078 Tcl_NewStringObj(prodesc->internal_proname, -1));
1079
1080 /* The trigger name for argument TG_name */
1081 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1082 Tcl_NewStringObj(utf_e2u(trigdata->tg_trigger->tgname), -1));
1083
1084 /* The oid of the trigger relation for argument TG_relid */
1085 /* Consider not converting to a string for more performance? */
1086 stroid = DatumGetCString(DirectFunctionCall1(oidout,
1087 ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
1088 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1089 Tcl_NewStringObj(stroid, -1));
1090 pfree(stroid);
1091
1092 /* The name of the table the trigger is acting on: TG_table_name */
1093 stroid = SPI_getrelname(trigdata->tg_relation);
1094 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1095 Tcl_NewStringObj(utf_e2u(stroid), -1));
1096 pfree(stroid);
1097
1098 /* The schema of the table the trigger is acting on: TG_table_schema */
1099 stroid = SPI_getnspname(trigdata->tg_relation);
1100 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1101 Tcl_NewStringObj(utf_e2u(stroid), -1));
1102 pfree(stroid);
1103
1104 /* A list of attribute names for argument TG_relatts */
1105 tcl_trigtup = Tcl_NewObj();
1106 Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
1107 for (i = 0; i < tupdesc->natts; i++)
1108 {
1109 if (tupdesc->attrs[i]->attisdropped)
1110 Tcl_ListObjAppendElement(NULL, tcl_trigtup, Tcl_NewObj());
1111 else
1112 Tcl_ListObjAppendElement(NULL, tcl_trigtup,
1113 Tcl_NewStringObj(utf_e2u(NameStr(tupdesc->attrs[i]->attname)), -1));
1114 }
1115 Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
1116
1117 /* The when part of the event for TG_when */
1118 if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
1119 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1120 Tcl_NewStringObj("BEFORE", -1));
1121 else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
1122 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1123 Tcl_NewStringObj("AFTER", -1));
1124 else if (TRIGGER_FIRED_INSTEAD(trigdata->tg_event))
1125 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1126 Tcl_NewStringObj("INSTEAD OF", -1));
1127 else
1128 elog(ERROR, "unrecognized WHEN tg_event: %u", trigdata->tg_event);
1129
1130 /* The level part of the event for TG_level */
1131 if (TRIGGER_FIRED_FOR_ROW(trigdata->tg_event))
1132 {
1133 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1134 Tcl_NewStringObj("ROW", -1));
1135
1136 /* Build the data list for the trigtuple */
1137 tcl_trigtup = pltcl_build_tuple_argument(trigdata->tg_trigtuple,
1138 tupdesc);
1139
1140 /*
1141 * Now the command part of the event for TG_op and data for NEW
1142 * and OLD
1143 */
1144 if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
1145 {
1146 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1147 Tcl_NewStringObj("INSERT", -1));
1148
1149 Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
1150 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1151
1152 rettup = trigdata->tg_trigtuple;
1153 }
1154 else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
1155 {
1156 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1157 Tcl_NewStringObj("DELETE", -1));
1158
1159 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1160 Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
1161
1162 rettup = trigdata->tg_trigtuple;
1163 }
1164 else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
1165 {
1166 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1167 Tcl_NewStringObj("UPDATE", -1));
1168
1169 tcl_newtup = pltcl_build_tuple_argument(trigdata->tg_newtuple,
1170 tupdesc);
1171
1172 Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_newtup);
1173 Tcl_ListObjAppendElement(NULL, tcl_cmd, tcl_trigtup);
1174
1175 rettup = trigdata->tg_newtuple;
1176 }
1177 else
1178 elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
1179 }
1180 else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event))
1181 {
1182 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1183 Tcl_NewStringObj("STATEMENT", -1));
1184
1185 if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
1186 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1187 Tcl_NewStringObj("INSERT", -1));
1188 else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
1189 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1190 Tcl_NewStringObj("DELETE", -1));
1191 else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
1192 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1193 Tcl_NewStringObj("UPDATE", -1));
1194 else if (TRIGGER_FIRED_BY_TRUNCATE(trigdata->tg_event))
1195 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1196 Tcl_NewStringObj("TRUNCATE", -1));
1197 else
1198 elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
1199
1200 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1201 Tcl_ListObjAppendElement(NULL, tcl_cmd, Tcl_NewObj());
1202
1203 rettup = (HeapTuple) NULL;
1204 }
1205 else
1206 elog(ERROR, "unrecognized LEVEL tg_event: %u", trigdata->tg_event);
1207
1208 /* Finally append the arguments from CREATE TRIGGER */
1209 for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
1210 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1211 Tcl_NewStringObj(utf_e2u(trigdata->tg_trigger->tgargs[i]), -1));
1212
1213 }
1214 PG_CATCH();
1215 {
1216 Tcl_DecrRefCount(tcl_cmd);
1217 PG_RE_THROW();
1218 }
1219 PG_END_TRY();
1220
1221 /************************************************************
1222 * Call the Tcl function
1223 *
1224 * We assume no PG error can be thrown directly from this call.
1225 ************************************************************/
1226 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
1227
1228 /* Release refcount to free tcl_cmd (and all subsidiary objects) */
1229 Tcl_DecrRefCount(tcl_cmd);
1230
1231 /************************************************************
1232 * Check for errors reported by Tcl.
1233 ************************************************************/
1234 if (tcl_rc != TCL_OK)
1235 throw_tcl_error(interp, prodesc->user_proname);
1236
1237 /************************************************************
1238 * Exit SPI environment.
1239 ************************************************************/
1240 if (SPI_finish() != SPI_OK_FINISH)
1241 elog(ERROR, "SPI_finish() failed");
1242
1243 /************************************************************
1244 * The return value from the procedure might be one of
1245 * the magic strings OK or SKIP, or a list from array get.
1246 * We can check for OK or SKIP without worrying about encoding.
1247 ************************************************************/
1248 result = Tcl_GetStringResult(interp);
1249
1250 if (strcmp(result, "OK") == 0)
1251 return rettup;
1252 if (strcmp(result, "SKIP") == 0)
1253 return (HeapTuple) NULL;
1254
1255 /************************************************************
1256 * Otherwise, the return value should be a column name/value list
1257 * specifying the modified tuple to return.
1258 ************************************************************/
1259 if (Tcl_ListObjGetElements(interp, Tcl_GetObjResult(interp),
1260 &result_Objc, &result_Objv) != TCL_OK)
1261 ereport(ERROR,
1262 (errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
1263 errmsg("could not split return value from trigger: %s",
1264 utf_u2e(Tcl_GetStringResult(interp)))));
1265
1266 /* Convert function result to tuple */
1267 rettup = pltcl_build_tuple_result(interp, result_Objv, result_Objc,
1268 call_state);
1269
1270 return rettup;
1271 }
1272
1273 /**********************************************************************
1274 * pltcl_event_trigger_handler() - Handler for event trigger calls
1275 **********************************************************************/
1276 static void
pltcl_event_trigger_handler(PG_FUNCTION_ARGS,pltcl_call_state * call_state,bool pltrusted)1277 pltcl_event_trigger_handler(PG_FUNCTION_ARGS, pltcl_call_state *call_state,
1278 bool pltrusted)
1279 {
1280 pltcl_proc_desc *prodesc;
1281 Tcl_Interp *volatile interp;
1282 EventTriggerData *tdata = (EventTriggerData *) fcinfo->context;
1283 Tcl_Obj *tcl_cmd;
1284 int tcl_rc;
1285
1286 /* Connect to SPI manager */
1287 if (SPI_connect() != SPI_OK_CONNECT)
1288 elog(ERROR, "could not connect to SPI manager");
1289
1290 /* Find or compile the function */
1291 prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
1292 InvalidOid, true, pltrusted);
1293
1294 call_state->prodesc = prodesc;
1295 prodesc->fn_refcount++;
1296
1297 interp = prodesc->interp_desc->interp;
1298
1299 /* Create the tcl command and call the internal proc */
1300 tcl_cmd = Tcl_NewObj();
1301 Tcl_IncrRefCount(tcl_cmd);
1302 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1303 Tcl_NewStringObj(prodesc->internal_proname, -1));
1304 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1305 Tcl_NewStringObj(utf_e2u(tdata->event), -1));
1306 Tcl_ListObjAppendElement(NULL, tcl_cmd,
1307 Tcl_NewStringObj(utf_e2u(tdata->tag), -1));
1308
1309 tcl_rc = Tcl_EvalObjEx(interp, tcl_cmd, (TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));
1310
1311 /* Release refcount to free tcl_cmd (and all subsidiary objects) */
1312 Tcl_DecrRefCount(tcl_cmd);
1313
1314 /* Check for errors reported by Tcl. */
1315 if (tcl_rc != TCL_OK)
1316 throw_tcl_error(interp, prodesc->user_proname);
1317
1318 if (SPI_finish() != SPI_OK_FINISH)
1319 elog(ERROR, "SPI_finish() failed");
1320 }
1321
1322
1323 /**********************************************************************
1324 * throw_tcl_error - ereport an error returned from the Tcl interpreter
1325 **********************************************************************/
1326 static void
throw_tcl_error(Tcl_Interp * interp,const char * proname)1327 throw_tcl_error(Tcl_Interp *interp, const char *proname)
1328 {
1329 /*
1330 * Caution is needed here because Tcl_GetVar could overwrite the
1331 * interpreter result (even though it's not really supposed to), and we
1332 * can't control the order of evaluation of ereport arguments. Hence, make
1333 * real sure we have our own copy of the result string before invoking
1334 * Tcl_GetVar.
1335 */
1336 char *emsg;
1337 char *econtext;
1338
1339 emsg = pstrdup(utf_u2e(Tcl_GetStringResult(interp)));
1340 econtext = utf_u2e(Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY));
1341 ereport(ERROR,
1342 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1343 errmsg("%s", emsg),
1344 errcontext("%s\nin PL/Tcl function \"%s\"",
1345 econtext, proname)));
1346 }
1347
1348
1349 /**********************************************************************
1350 * compile_pltcl_function - compile (or hopefully just look up) function
1351 *
1352 * tgreloid is the OID of the relation when compiling a trigger, or zero
1353 * (InvalidOid) when compiling a plain function.
1354 **********************************************************************/
1355 static pltcl_proc_desc *
compile_pltcl_function(Oid fn_oid,Oid tgreloid,bool is_event_trigger,bool pltrusted)1356 compile_pltcl_function(Oid fn_oid, Oid tgreloid,
1357 bool is_event_trigger, bool pltrusted)
1358 {
1359 HeapTuple procTup;
1360 Form_pg_proc procStruct;
1361 pltcl_proc_key proc_key;
1362 pltcl_proc_ptr *proc_ptr;
1363 bool found;
1364 pltcl_proc_desc *prodesc;
1365 pltcl_proc_desc *old_prodesc;
1366 volatile MemoryContext proc_cxt = NULL;
1367 Tcl_DString proc_internal_def;
1368 Tcl_DString proc_internal_body;
1369
1370 /* We'll need the pg_proc tuple in any case... */
1371 procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(fn_oid));
1372 if (!HeapTupleIsValid(procTup))
1373 elog(ERROR, "cache lookup failed for function %u", fn_oid);
1374 procStruct = (Form_pg_proc) GETSTRUCT(procTup);
1375
1376 /*
1377 * Look up function in pltcl_proc_htab; if it's not there, create an entry
1378 * and set the entry's proc_ptr to NULL.
1379 */
1380 proc_key.proc_id = fn_oid;
1381 proc_key.is_trigger = OidIsValid(tgreloid);
1382 proc_key.user_id = pltrusted ? GetUserId() : InvalidOid;
1383
1384 proc_ptr = hash_search(pltcl_proc_htab, &proc_key,
1385 HASH_ENTER,
1386 &found);
1387 if (!found)
1388 proc_ptr->proc_ptr = NULL;
1389
1390 prodesc = proc_ptr->proc_ptr;
1391
1392 /************************************************************
1393 * If it's present, must check whether it's still up to date.
1394 * This is needed because CREATE OR REPLACE FUNCTION can modify the
1395 * function's pg_proc entry without changing its OID.
1396 ************************************************************/
1397 if (prodesc != NULL &&
1398 prodesc->fn_xmin == HeapTupleHeaderGetRawXmin(procTup->t_data) &&
1399 ItemPointerEquals(&prodesc->fn_tid, &procTup->t_self))
1400 {
1401 /* It's still up-to-date, so we can use it */
1402 ReleaseSysCache(procTup);
1403 return prodesc;
1404 }
1405
1406 /************************************************************
1407 * If we haven't found it in the hashtable, we analyze
1408 * the functions arguments and returntype and store
1409 * the in-/out-functions in the prodesc block and create
1410 * a new hashtable entry for it.
1411 *
1412 * Then we load the procedure into the Tcl interpreter.
1413 ************************************************************/
1414 Tcl_DStringInit(&proc_internal_def);
1415 Tcl_DStringInit(&proc_internal_body);
1416 PG_TRY();
1417 {
1418 bool is_trigger = OidIsValid(tgreloid);
1419 char internal_proname[128];
1420 HeapTuple typeTup;
1421 Form_pg_type typeStruct;
1422 char proc_internal_args[33 * FUNC_MAX_ARGS];
1423 Datum prosrcdatum;
1424 bool isnull;
1425 char *proc_source;
1426 char buf[32];
1427 Tcl_Interp *interp;
1428 int i;
1429 int tcl_rc;
1430 MemoryContext oldcontext;
1431
1432 /************************************************************
1433 * Build our internal proc name from the function's Oid. Append
1434 * "_trigger" when appropriate to ensure the normal and trigger
1435 * cases are kept separate. Note name must be all-ASCII.
1436 ************************************************************/
1437 if (is_event_trigger)
1438 snprintf(internal_proname, sizeof(internal_proname),
1439 "__PLTcl_proc_%u_evttrigger", fn_oid);
1440 else if (is_trigger)
1441 snprintf(internal_proname, sizeof(internal_proname),
1442 "__PLTcl_proc_%u_trigger", fn_oid);
1443 else
1444 snprintf(internal_proname, sizeof(internal_proname),
1445 "__PLTcl_proc_%u", fn_oid);
1446
1447 /************************************************************
1448 * Allocate a context that will hold all PG data for the procedure.
1449 * We use the internal proc name as the context name.
1450 ************************************************************/
1451 proc_cxt = AllocSetContextCreate(TopMemoryContext,
1452 internal_proname,
1453 ALLOCSET_SMALL_SIZES);
1454
1455 /************************************************************
1456 * Allocate and fill a new procedure description block.
1457 * struct prodesc and subsidiary data must all live in proc_cxt.
1458 ************************************************************/
1459 oldcontext = MemoryContextSwitchTo(proc_cxt);
1460 prodesc = (pltcl_proc_desc *) palloc0(sizeof(pltcl_proc_desc));
1461 prodesc->user_proname = pstrdup(NameStr(procStruct->proname));
1462 prodesc->internal_proname = pstrdup(internal_proname);
1463 prodesc->fn_cxt = proc_cxt;
1464 prodesc->fn_refcount = 0;
1465 prodesc->fn_xmin = HeapTupleHeaderGetRawXmin(procTup->t_data);
1466 prodesc->fn_tid = procTup->t_self;
1467 prodesc->nargs = procStruct->pronargs;
1468 prodesc->arg_out_func = (FmgrInfo *) palloc0(prodesc->nargs * sizeof(FmgrInfo));
1469 prodesc->arg_is_rowtype = (bool *) palloc0(prodesc->nargs * sizeof(bool));
1470 MemoryContextSwitchTo(oldcontext);
1471
1472 /* Remember if function is STABLE/IMMUTABLE */
1473 prodesc->fn_readonly =
1474 (procStruct->provolatile != PROVOLATILE_VOLATILE);
1475 /* And whether it is trusted */
1476 prodesc->lanpltrusted = pltrusted;
1477
1478 /************************************************************
1479 * Identify the interpreter to use for the function
1480 ************************************************************/
1481 prodesc->interp_desc = pltcl_fetch_interp(procStruct->prolang,
1482 prodesc->lanpltrusted);
1483 interp = prodesc->interp_desc->interp;
1484
1485 /************************************************************
1486 * Get the required information for input conversion of the
1487 * return value.
1488 ************************************************************/
1489 if (!is_trigger && !is_event_trigger)
1490 {
1491 typeTup =
1492 SearchSysCache1(TYPEOID,
1493 ObjectIdGetDatum(procStruct->prorettype));
1494 if (!HeapTupleIsValid(typeTup))
1495 elog(ERROR, "cache lookup failed for type %u",
1496 procStruct->prorettype);
1497 typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
1498
1499 /* Disallow pseudotype result, except VOID and RECORD */
1500 if (typeStruct->typtype == TYPTYPE_PSEUDO)
1501 {
1502 if (procStruct->prorettype == VOIDOID ||
1503 procStruct->prorettype == RECORDOID)
1504 /* okay */ ;
1505 else if (procStruct->prorettype == TRIGGEROID ||
1506 procStruct->prorettype == EVTTRIGGEROID)
1507 ereport(ERROR,
1508 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1509 errmsg("trigger functions can only be called as triggers")));
1510 else
1511 ereport(ERROR,
1512 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1513 errmsg("PL/Tcl functions cannot return type %s",
1514 format_type_be(procStruct->prorettype))));
1515 }
1516
1517 fmgr_info_cxt(typeStruct->typinput,
1518 &(prodesc->result_in_func),
1519 proc_cxt);
1520 prodesc->result_typioparam = getTypeIOParam(typeTup);
1521
1522 prodesc->fn_retisset = procStruct->proretset;
1523 prodesc->fn_retistuple = (procStruct->prorettype == RECORDOID ||
1524 typeStruct->typtype == TYPTYPE_COMPOSITE);
1525
1526 ReleaseSysCache(typeTup);
1527 }
1528
1529 /************************************************************
1530 * Get the required information for output conversion
1531 * of all procedure arguments, and set up argument naming info.
1532 ************************************************************/
1533 if (!is_trigger && !is_event_trigger)
1534 {
1535 proc_internal_args[0] = '\0';
1536 for (i = 0; i < prodesc->nargs; i++)
1537 {
1538 typeTup = SearchSysCache1(TYPEOID,
1539 ObjectIdGetDatum(procStruct->proargtypes.values[i]));
1540 if (!HeapTupleIsValid(typeTup))
1541 elog(ERROR, "cache lookup failed for type %u",
1542 procStruct->proargtypes.values[i]);
1543 typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
1544
1545 /* Disallow pseudotype argument */
1546 if (typeStruct->typtype == TYPTYPE_PSEUDO)
1547 ereport(ERROR,
1548 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1549 errmsg("PL/Tcl functions cannot accept type %s",
1550 format_type_be(procStruct->proargtypes.values[i]))));
1551
1552 if (typeStruct->typtype == TYPTYPE_COMPOSITE)
1553 {
1554 prodesc->arg_is_rowtype[i] = true;
1555 snprintf(buf, sizeof(buf), "__PLTcl_Tup_%d", i + 1);
1556 }
1557 else
1558 {
1559 prodesc->arg_is_rowtype[i] = false;
1560 fmgr_info_cxt(typeStruct->typoutput,
1561 &(prodesc->arg_out_func[i]),
1562 proc_cxt);
1563 snprintf(buf, sizeof(buf), "%d", i + 1);
1564 }
1565
1566 if (i > 0)
1567 strcat(proc_internal_args, " ");
1568 strcat(proc_internal_args, buf);
1569
1570 ReleaseSysCache(typeTup);
1571 }
1572 }
1573 else if (is_trigger)
1574 {
1575 /* trigger procedure has fixed args */
1576 strcpy(proc_internal_args,
1577 "TG_name TG_relid TG_table_name TG_table_schema TG_relatts TG_when TG_level TG_op __PLTcl_Tup_NEW __PLTcl_Tup_OLD args");
1578 }
1579 else if (is_event_trigger)
1580 {
1581 /* event trigger procedure has fixed args */
1582 strcpy(proc_internal_args, "TG_event TG_tag");
1583 }
1584
1585 /************************************************************
1586 * Create the tcl command to define the internal
1587 * procedure
1588 *
1589 * Leave this code as DString - performance is not critical here,
1590 * and we don't want to duplicate the knowledge of the Tcl quoting
1591 * rules that's embedded in Tcl_DStringAppendElement.
1592 ************************************************************/
1593 Tcl_DStringAppendElement(&proc_internal_def, "proc");
1594 Tcl_DStringAppendElement(&proc_internal_def, internal_proname);
1595 Tcl_DStringAppendElement(&proc_internal_def, proc_internal_args);
1596
1597 /************************************************************
1598 * prefix procedure body with
1599 * upvar #0 <internal_procname> GD
1600 * and with appropriate setting of arguments
1601 ************************************************************/
1602 Tcl_DStringAppend(&proc_internal_body, "upvar #0 ", -1);
1603 Tcl_DStringAppend(&proc_internal_body, internal_proname, -1);
1604 Tcl_DStringAppend(&proc_internal_body, " GD\n", -1);
1605 if (is_trigger)
1606 {
1607 Tcl_DStringAppend(&proc_internal_body,
1608 "array set NEW $__PLTcl_Tup_NEW\n", -1);
1609 Tcl_DStringAppend(&proc_internal_body,
1610 "array set OLD $__PLTcl_Tup_OLD\n", -1);
1611 Tcl_DStringAppend(&proc_internal_body,
1612 "set i 0\n"
1613 "set v 0\n"
1614 "foreach v $args {\n"
1615 " incr i\n"
1616 " set $i $v\n"
1617 "}\n"
1618 "unset i v\n\n", -1);
1619 }
1620 else if (is_event_trigger)
1621 {
1622 /* no argument support for event triggers */
1623 }
1624 else
1625 {
1626 for (i = 0; i < prodesc->nargs; i++)
1627 {
1628 if (prodesc->arg_is_rowtype[i])
1629 {
1630 snprintf(buf, sizeof(buf),
1631 "array set %d $__PLTcl_Tup_%d\n",
1632 i + 1, i + 1);
1633 Tcl_DStringAppend(&proc_internal_body, buf, -1);
1634 }
1635 }
1636 }
1637
1638 /************************************************************
1639 * Add user's function definition to proc body
1640 ************************************************************/
1641 prosrcdatum = SysCacheGetAttr(PROCOID, procTup,
1642 Anum_pg_proc_prosrc, &isnull);
1643 if (isnull)
1644 elog(ERROR, "null prosrc");
1645 proc_source = TextDatumGetCString(prosrcdatum);
1646 UTF_BEGIN;
1647 Tcl_DStringAppend(&proc_internal_body, UTF_E2U(proc_source), -1);
1648 UTF_END;
1649 pfree(proc_source);
1650 Tcl_DStringAppendElement(&proc_internal_def,
1651 Tcl_DStringValue(&proc_internal_body));
1652
1653 /************************************************************
1654 * Create the procedure in the interpreter
1655 ************************************************************/
1656 tcl_rc = Tcl_EvalEx(interp,
1657 Tcl_DStringValue(&proc_internal_def),
1658 Tcl_DStringLength(&proc_internal_def),
1659 TCL_EVAL_GLOBAL);
1660 if (tcl_rc != TCL_OK)
1661 ereport(ERROR,
1662 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1663 errmsg("could not create internal procedure \"%s\": %s",
1664 internal_proname,
1665 utf_u2e(Tcl_GetStringResult(interp)))));
1666 }
1667 PG_CATCH();
1668 {
1669 /*
1670 * If we failed anywhere above, clean up whatever got allocated. It
1671 * should all be in the proc_cxt, except for the DStrings.
1672 */
1673 if (proc_cxt)
1674 MemoryContextDelete(proc_cxt);
1675 Tcl_DStringFree(&proc_internal_def);
1676 Tcl_DStringFree(&proc_internal_body);
1677 PG_RE_THROW();
1678 }
1679 PG_END_TRY();
1680
1681 /*
1682 * Install the new proc description block in the hashtable, incrementing
1683 * its refcount (the hashtable link counts as a reference). Then, if
1684 * there was a previous definition of the function, decrement that one's
1685 * refcount, and delete it if no longer referenced. The order of
1686 * operations here is important: if something goes wrong during the
1687 * MemoryContextDelete, leaking some memory for the old definition is OK,
1688 * but we don't want to corrupt the live hashtable entry. (Likewise,
1689 * freeing the DStrings is pretty low priority if that happens.)
1690 */
1691 old_prodesc = proc_ptr->proc_ptr;
1692
1693 proc_ptr->proc_ptr = prodesc;
1694 prodesc->fn_refcount++;
1695
1696 if (old_prodesc != NULL)
1697 {
1698 Assert(old_prodesc->fn_refcount > 0);
1699 if (--old_prodesc->fn_refcount == 0)
1700 MemoryContextDelete(old_prodesc->fn_cxt);
1701 }
1702
1703 Tcl_DStringFree(&proc_internal_def);
1704 Tcl_DStringFree(&proc_internal_body);
1705
1706 ReleaseSysCache(procTup);
1707
1708 return prodesc;
1709 }
1710
1711
1712 /**********************************************************************
1713 * pltcl_elog() - elog() support for PLTcl
1714 **********************************************************************/
1715 static int
pltcl_elog(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])1716 pltcl_elog(ClientData cdata, Tcl_Interp *interp,
1717 int objc, Tcl_Obj *const objv[])
1718 {
1719 volatile int level;
1720 MemoryContext oldcontext;
1721 int priIndex;
1722
1723 static const char *logpriorities[] = {
1724 "DEBUG", "LOG", "INFO", "NOTICE",
1725 "WARNING", "ERROR", "FATAL", (const char *) NULL
1726 };
1727
1728 static const int loglevels[] = {
1729 DEBUG2, LOG, INFO, NOTICE,
1730 WARNING, ERROR, FATAL
1731 };
1732
1733 if (objc != 3)
1734 {
1735 Tcl_WrongNumArgs(interp, 1, objv, "level msg");
1736 return TCL_ERROR;
1737 }
1738
1739 if (Tcl_GetIndexFromObj(interp, objv[1], logpriorities, "priority",
1740 TCL_EXACT, &priIndex) != TCL_OK)
1741 return TCL_ERROR;
1742
1743 level = loglevels[priIndex];
1744
1745 if (level == ERROR)
1746 {
1747 /*
1748 * We just pass the error back to Tcl. If it's not caught, it'll
1749 * eventually get converted to a PG error when we reach the call
1750 * handler.
1751 */
1752 Tcl_SetObjResult(interp, objv[2]);
1753 return TCL_ERROR;
1754 }
1755
1756 /*
1757 * For non-error messages, just pass 'em to ereport(). We do not expect
1758 * that this will fail, but just on the off chance it does, report the
1759 * error back to Tcl. Note we are assuming that ereport() can't have any
1760 * internal failures that are so bad as to require a transaction abort.
1761 *
1762 * This path is also used for FATAL errors, which aren't going to come
1763 * back to us at all.
1764 */
1765 oldcontext = CurrentMemoryContext;
1766 PG_TRY();
1767 {
1768 UTF_BEGIN;
1769 ereport(level,
1770 (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
1771 errmsg("%s", UTF_U2E(Tcl_GetString(objv[2])))));
1772 UTF_END;
1773 }
1774 PG_CATCH();
1775 {
1776 ErrorData *edata;
1777
1778 /* Must reset elog.c's state */
1779 MemoryContextSwitchTo(oldcontext);
1780 edata = CopyErrorData();
1781 FlushErrorState();
1782
1783 /* Pass the error data to Tcl */
1784 pltcl_construct_errorCode(interp, edata);
1785 UTF_BEGIN;
1786 Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1));
1787 UTF_END;
1788 FreeErrorData(edata);
1789
1790 return TCL_ERROR;
1791 }
1792 PG_END_TRY();
1793
1794 return TCL_OK;
1795 }
1796
1797
1798 /**********************************************************************
1799 * pltcl_construct_errorCode() - construct a Tcl errorCode
1800 * list with detailed information from the PostgreSQL server
1801 **********************************************************************/
1802 static void
pltcl_construct_errorCode(Tcl_Interp * interp,ErrorData * edata)1803 pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata)
1804 {
1805 Tcl_Obj *obj = Tcl_NewObj();
1806
1807 Tcl_ListObjAppendElement(interp, obj,
1808 Tcl_NewStringObj("POSTGRES", -1));
1809 Tcl_ListObjAppendElement(interp, obj,
1810 Tcl_NewStringObj(PG_VERSION, -1));
1811 Tcl_ListObjAppendElement(interp, obj,
1812 Tcl_NewStringObj("SQLSTATE", -1));
1813 Tcl_ListObjAppendElement(interp, obj,
1814 Tcl_NewStringObj(unpack_sql_state(edata->sqlerrcode), -1));
1815 Tcl_ListObjAppendElement(interp, obj,
1816 Tcl_NewStringObj("condition", -1));
1817 Tcl_ListObjAppendElement(interp, obj,
1818 Tcl_NewStringObj(pltcl_get_condition_name(edata->sqlerrcode), -1));
1819 Tcl_ListObjAppendElement(interp, obj,
1820 Tcl_NewStringObj("message", -1));
1821 UTF_BEGIN;
1822 Tcl_ListObjAppendElement(interp, obj,
1823 Tcl_NewStringObj(UTF_E2U(edata->message), -1));
1824 UTF_END;
1825 if (edata->detail)
1826 {
1827 Tcl_ListObjAppendElement(interp, obj,
1828 Tcl_NewStringObj("detail", -1));
1829 UTF_BEGIN;
1830 Tcl_ListObjAppendElement(interp, obj,
1831 Tcl_NewStringObj(UTF_E2U(edata->detail), -1));
1832 UTF_END;
1833 }
1834 if (edata->hint)
1835 {
1836 Tcl_ListObjAppendElement(interp, obj,
1837 Tcl_NewStringObj("hint", -1));
1838 UTF_BEGIN;
1839 Tcl_ListObjAppendElement(interp, obj,
1840 Tcl_NewStringObj(UTF_E2U(edata->hint), -1));
1841 UTF_END;
1842 }
1843 if (edata->context)
1844 {
1845 Tcl_ListObjAppendElement(interp, obj,
1846 Tcl_NewStringObj("context", -1));
1847 UTF_BEGIN;
1848 Tcl_ListObjAppendElement(interp, obj,
1849 Tcl_NewStringObj(UTF_E2U(edata->context), -1));
1850 UTF_END;
1851 }
1852 if (edata->schema_name)
1853 {
1854 Tcl_ListObjAppendElement(interp, obj,
1855 Tcl_NewStringObj("schema", -1));
1856 UTF_BEGIN;
1857 Tcl_ListObjAppendElement(interp, obj,
1858 Tcl_NewStringObj(UTF_E2U(edata->schema_name), -1));
1859 UTF_END;
1860 }
1861 if (edata->table_name)
1862 {
1863 Tcl_ListObjAppendElement(interp, obj,
1864 Tcl_NewStringObj("table", -1));
1865 UTF_BEGIN;
1866 Tcl_ListObjAppendElement(interp, obj,
1867 Tcl_NewStringObj(UTF_E2U(edata->table_name), -1));
1868 UTF_END;
1869 }
1870 if (edata->column_name)
1871 {
1872 Tcl_ListObjAppendElement(interp, obj,
1873 Tcl_NewStringObj("column", -1));
1874 UTF_BEGIN;
1875 Tcl_ListObjAppendElement(interp, obj,
1876 Tcl_NewStringObj(UTF_E2U(edata->column_name), -1));
1877 UTF_END;
1878 }
1879 if (edata->datatype_name)
1880 {
1881 Tcl_ListObjAppendElement(interp, obj,
1882 Tcl_NewStringObj("datatype", -1));
1883 UTF_BEGIN;
1884 Tcl_ListObjAppendElement(interp, obj,
1885 Tcl_NewStringObj(UTF_E2U(edata->datatype_name), -1));
1886 UTF_END;
1887 }
1888 if (edata->constraint_name)
1889 {
1890 Tcl_ListObjAppendElement(interp, obj,
1891 Tcl_NewStringObj("constraint", -1));
1892 UTF_BEGIN;
1893 Tcl_ListObjAppendElement(interp, obj,
1894 Tcl_NewStringObj(UTF_E2U(edata->constraint_name), -1));
1895 UTF_END;
1896 }
1897 /* cursorpos is never interesting here; report internal query/pos */
1898 if (edata->internalquery)
1899 {
1900 Tcl_ListObjAppendElement(interp, obj,
1901 Tcl_NewStringObj("statement", -1));
1902 UTF_BEGIN;
1903 Tcl_ListObjAppendElement(interp, obj,
1904 Tcl_NewStringObj(UTF_E2U(edata->internalquery), -1));
1905 UTF_END;
1906 }
1907 if (edata->internalpos > 0)
1908 {
1909 Tcl_ListObjAppendElement(interp, obj,
1910 Tcl_NewStringObj("cursor_position", -1));
1911 Tcl_ListObjAppendElement(interp, obj,
1912 Tcl_NewIntObj(edata->internalpos));
1913 }
1914 if (edata->filename)
1915 {
1916 Tcl_ListObjAppendElement(interp, obj,
1917 Tcl_NewStringObj("filename", -1));
1918 UTF_BEGIN;
1919 Tcl_ListObjAppendElement(interp, obj,
1920 Tcl_NewStringObj(UTF_E2U(edata->filename), -1));
1921 UTF_END;
1922 }
1923 if (edata->lineno > 0)
1924 {
1925 Tcl_ListObjAppendElement(interp, obj,
1926 Tcl_NewStringObj("lineno", -1));
1927 Tcl_ListObjAppendElement(interp, obj,
1928 Tcl_NewIntObj(edata->lineno));
1929 }
1930 if (edata->funcname)
1931 {
1932 Tcl_ListObjAppendElement(interp, obj,
1933 Tcl_NewStringObj("funcname", -1));
1934 UTF_BEGIN;
1935 Tcl_ListObjAppendElement(interp, obj,
1936 Tcl_NewStringObj(UTF_E2U(edata->funcname), -1));
1937 UTF_END;
1938 }
1939
1940 Tcl_SetObjErrorCode(interp, obj);
1941 }
1942
1943
1944 /**********************************************************************
1945 * pltcl_get_condition_name() - find name for SQLSTATE
1946 **********************************************************************/
1947 static const char *
pltcl_get_condition_name(int sqlstate)1948 pltcl_get_condition_name(int sqlstate)
1949 {
1950 int i;
1951
1952 for (i = 0; exception_name_map[i].label != NULL; i++)
1953 {
1954 if (exception_name_map[i].sqlerrstate == sqlstate)
1955 return exception_name_map[i].label;
1956 }
1957 return "unrecognized_sqlstate";
1958 }
1959
1960
1961 /**********************************************************************
1962 * pltcl_quote() - quote literal strings that are to
1963 * be used in SPI_execute query strings
1964 **********************************************************************/
1965 static int
pltcl_quote(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])1966 pltcl_quote(ClientData cdata, Tcl_Interp *interp,
1967 int objc, Tcl_Obj *const objv[])
1968 {
1969 char *tmp;
1970 const char *cp1;
1971 char *cp2;
1972 int length;
1973
1974 /************************************************************
1975 * Check call syntax
1976 ************************************************************/
1977 if (objc != 2)
1978 {
1979 Tcl_WrongNumArgs(interp, 1, objv, "string");
1980 return TCL_ERROR;
1981 }
1982
1983 /************************************************************
1984 * Allocate space for the maximum the string can
1985 * grow to and initialize pointers
1986 ************************************************************/
1987 cp1 = Tcl_GetStringFromObj(objv[1], &length);
1988 tmp = palloc(length * 2 + 1);
1989 cp2 = tmp;
1990
1991 /************************************************************
1992 * Walk through string and double every quote and backslash
1993 ************************************************************/
1994 while (*cp1)
1995 {
1996 if (*cp1 == '\'')
1997 *cp2++ = '\'';
1998 else
1999 {
2000 if (*cp1 == '\\')
2001 *cp2++ = '\\';
2002 }
2003 *cp2++ = *cp1++;
2004 }
2005
2006 /************************************************************
2007 * Terminate the string and set it as result
2008 ************************************************************/
2009 *cp2 = '\0';
2010 Tcl_SetObjResult(interp, Tcl_NewStringObj(tmp, -1));
2011 pfree(tmp);
2012 return TCL_OK;
2013 }
2014
2015
2016 /**********************************************************************
2017 * pltcl_argisnull() - determine if a specific argument is NULL
2018 **********************************************************************/
2019 static int
pltcl_argisnull(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])2020 pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
2021 int objc, Tcl_Obj *const objv[])
2022 {
2023 int argno;
2024 FunctionCallInfo fcinfo = pltcl_current_call_state->fcinfo;
2025
2026 /************************************************************
2027 * Check call syntax
2028 ************************************************************/
2029 if (objc != 2)
2030 {
2031 Tcl_WrongNumArgs(interp, 1, objv, "argno");
2032 return TCL_ERROR;
2033 }
2034
2035 /************************************************************
2036 * Check that we're called as a normal function
2037 ************************************************************/
2038 if (fcinfo == NULL)
2039 {
2040 Tcl_SetObjResult(interp,
2041 Tcl_NewStringObj("argisnull cannot be used in triggers", -1));
2042 return TCL_ERROR;
2043 }
2044
2045 /************************************************************
2046 * Get the argument number
2047 ************************************************************/
2048 if (Tcl_GetIntFromObj(interp, objv[1], &argno) != TCL_OK)
2049 return TCL_ERROR;
2050
2051 /************************************************************
2052 * Check that the argno is valid
2053 ************************************************************/
2054 argno--;
2055 if (argno < 0 || argno >= fcinfo->nargs)
2056 {
2057 Tcl_SetObjResult(interp,
2058 Tcl_NewStringObj("argno out of range", -1));
2059 return TCL_ERROR;
2060 }
2061
2062 /************************************************************
2063 * Get the requested NULL state
2064 ************************************************************/
2065 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(PG_ARGISNULL(argno)));
2066 return TCL_OK;
2067 }
2068
2069
2070 /**********************************************************************
2071 * pltcl_returnnull() - Cause a NULL return from the current function
2072 **********************************************************************/
2073 static int
pltcl_returnnull(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])2074 pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
2075 int objc, Tcl_Obj *const objv[])
2076 {
2077 FunctionCallInfo fcinfo = pltcl_current_call_state->fcinfo;
2078
2079 /************************************************************
2080 * Check call syntax
2081 ************************************************************/
2082 if (objc != 1)
2083 {
2084 Tcl_WrongNumArgs(interp, 1, objv, "");
2085 return TCL_ERROR;
2086 }
2087
2088 /************************************************************
2089 * Check that we're called as a normal function
2090 ************************************************************/
2091 if (fcinfo == NULL)
2092 {
2093 Tcl_SetObjResult(interp,
2094 Tcl_NewStringObj("return_null cannot be used in triggers", -1));
2095 return TCL_ERROR;
2096 }
2097
2098 /************************************************************
2099 * Set the NULL return flag and cause Tcl to return from the
2100 * procedure.
2101 ************************************************************/
2102 fcinfo->isnull = true;
2103
2104 return TCL_RETURN;
2105 }
2106
2107
2108 /**********************************************************************
2109 * pltcl_returnnext() - Add a row to the result tuplestore in a SRF.
2110 **********************************************************************/
2111 static int
pltcl_returnnext(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])2112 pltcl_returnnext(ClientData cdata, Tcl_Interp *interp,
2113 int objc, Tcl_Obj *const objv[])
2114 {
2115 pltcl_call_state *call_state = pltcl_current_call_state;
2116 FunctionCallInfo fcinfo = call_state->fcinfo;
2117 pltcl_proc_desc *prodesc = call_state->prodesc;
2118 MemoryContext oldcontext = CurrentMemoryContext;
2119 ResourceOwner oldowner = CurrentResourceOwner;
2120 volatile int result = TCL_OK;
2121
2122 /*
2123 * Check that we're called as a set-returning function
2124 */
2125 if (fcinfo == NULL)
2126 {
2127 Tcl_SetObjResult(interp,
2128 Tcl_NewStringObj("return_next cannot be used in triggers", -1));
2129 return TCL_ERROR;
2130 }
2131
2132 if (!prodesc->fn_retisset)
2133 {
2134 Tcl_SetObjResult(interp,
2135 Tcl_NewStringObj("return_next cannot be used in non-set-returning functions", -1));
2136 return TCL_ERROR;
2137 }
2138
2139 /*
2140 * Check call syntax
2141 */
2142 if (objc != 2)
2143 {
2144 Tcl_WrongNumArgs(interp, 1, objv, "result");
2145 return TCL_ERROR;
2146 }
2147
2148 /*
2149 * The rest might throw elog(ERROR), so must run in a subtransaction.
2150 *
2151 * A small advantage of using a subtransaction is that it provides a
2152 * short-lived memory context for free, so we needn't worry about leaking
2153 * memory here. To use that context, call BeginInternalSubTransaction
2154 * directly instead of going through pltcl_subtrans_begin.
2155 */
2156 BeginInternalSubTransaction(NULL);
2157 PG_TRY();
2158 {
2159 /* Set up tuple store if first output row */
2160 if (call_state->tuple_store == NULL)
2161 pltcl_init_tuple_store(call_state);
2162
2163 if (prodesc->fn_retistuple)
2164 {
2165 Tcl_Obj **rowObjv;
2166 int rowObjc;
2167
2168 /* result should be a list, so break it down */
2169 if (Tcl_ListObjGetElements(interp, objv[1], &rowObjc, &rowObjv) == TCL_ERROR)
2170 result = TCL_ERROR;
2171 else
2172 {
2173 HeapTuple tuple;
2174
2175 tuple = pltcl_build_tuple_result(interp, rowObjv, rowObjc,
2176 call_state);
2177 tuplestore_puttuple(call_state->tuple_store, tuple);
2178 }
2179 }
2180 else
2181 {
2182 Datum retval;
2183 bool isNull = false;
2184
2185 /* for paranoia's sake, check that tupdesc has exactly one column */
2186 if (call_state->ret_tupdesc->natts != 1)
2187 elog(ERROR, "wrong result type supplied in return_next");
2188
2189 retval = InputFunctionCall(&prodesc->result_in_func,
2190 utf_u2e((char *) Tcl_GetString(objv[1])),
2191 prodesc->result_typioparam,
2192 -1);
2193 tuplestore_putvalues(call_state->tuple_store, call_state->ret_tupdesc,
2194 &retval, &isNull);
2195 }
2196
2197 pltcl_subtrans_commit(oldcontext, oldowner);
2198 }
2199 PG_CATCH();
2200 {
2201 pltcl_subtrans_abort(interp, oldcontext, oldowner);
2202 return TCL_ERROR;
2203 }
2204 PG_END_TRY();
2205
2206 return result;
2207 }
2208
2209
2210 /*----------
2211 * Support for running SPI operations inside subtransactions
2212 *
2213 * Intended usage pattern is:
2214 *
2215 * MemoryContext oldcontext = CurrentMemoryContext;
2216 * ResourceOwner oldowner = CurrentResourceOwner;
2217 *
2218 * ...
2219 * pltcl_subtrans_begin(oldcontext, oldowner);
2220 * PG_TRY();
2221 * {
2222 * do something risky;
2223 * pltcl_subtrans_commit(oldcontext, oldowner);
2224 * }
2225 * PG_CATCH();
2226 * {
2227 * pltcl_subtrans_abort(interp, oldcontext, oldowner);
2228 * return TCL_ERROR;
2229 * }
2230 * PG_END_TRY();
2231 * return TCL_OK;
2232 *----------
2233 */
2234 static void
pltcl_subtrans_begin(MemoryContext oldcontext,ResourceOwner oldowner)2235 pltcl_subtrans_begin(MemoryContext oldcontext, ResourceOwner oldowner)
2236 {
2237 BeginInternalSubTransaction(NULL);
2238
2239 /* Want to run inside function's memory context */
2240 MemoryContextSwitchTo(oldcontext);
2241 }
2242
2243 static void
pltcl_subtrans_commit(MemoryContext oldcontext,ResourceOwner oldowner)2244 pltcl_subtrans_commit(MemoryContext oldcontext, ResourceOwner oldowner)
2245 {
2246 /* Commit the inner transaction, return to outer xact context */
2247 ReleaseCurrentSubTransaction();
2248 MemoryContextSwitchTo(oldcontext);
2249 CurrentResourceOwner = oldowner;
2250 }
2251
2252 static void
pltcl_subtrans_abort(Tcl_Interp * interp,MemoryContext oldcontext,ResourceOwner oldowner)2253 pltcl_subtrans_abort(Tcl_Interp *interp,
2254 MemoryContext oldcontext, ResourceOwner oldowner)
2255 {
2256 ErrorData *edata;
2257
2258 /* Save error info */
2259 MemoryContextSwitchTo(oldcontext);
2260 edata = CopyErrorData();
2261 FlushErrorState();
2262
2263 /* Abort the inner transaction */
2264 RollbackAndReleaseCurrentSubTransaction();
2265 MemoryContextSwitchTo(oldcontext);
2266 CurrentResourceOwner = oldowner;
2267
2268 /* Pass the error data to Tcl */
2269 pltcl_construct_errorCode(interp, edata);
2270 UTF_BEGIN;
2271 Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1));
2272 UTF_END;
2273 FreeErrorData(edata);
2274 }
2275
2276
2277 /**********************************************************************
2278 * pltcl_SPI_execute() - The builtin SPI_execute command
2279 * for the Tcl interpreter
2280 **********************************************************************/
2281 static int
pltcl_SPI_execute(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])2282 pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
2283 int objc, Tcl_Obj *const objv[])
2284 {
2285 int my_rc;
2286 int spi_rc;
2287 int query_idx;
2288 int i;
2289 int optIndex;
2290 int count = 0;
2291 const char *volatile arrayname = NULL;
2292 Tcl_Obj *volatile loop_body = NULL;
2293 MemoryContext oldcontext = CurrentMemoryContext;
2294 ResourceOwner oldowner = CurrentResourceOwner;
2295
2296 enum options
2297 {
2298 OPT_ARRAY, OPT_COUNT
2299 };
2300
2301 static const char *options[] = {
2302 "-array", "-count", (const char *) NULL
2303 };
2304
2305 /************************************************************
2306 * Check the call syntax and get the options
2307 ************************************************************/
2308 if (objc < 2)
2309 {
2310 Tcl_WrongNumArgs(interp, 1, objv,
2311 "?-count n? ?-array name? query ?loop body?");
2312 return TCL_ERROR;
2313 }
2314
2315 i = 1;
2316 while (i < objc)
2317 {
2318 if (Tcl_GetIndexFromObj(NULL, objv[i], options, NULL,
2319 TCL_EXACT, &optIndex) != TCL_OK)
2320 break;
2321
2322 if (++i >= objc)
2323 {
2324 Tcl_SetObjResult(interp,
2325 Tcl_NewStringObj("missing argument to -count or -array", -1));
2326 return TCL_ERROR;
2327 }
2328
2329 switch ((enum options) optIndex)
2330 {
2331 case OPT_ARRAY:
2332 arrayname = Tcl_GetString(objv[i++]);
2333 break;
2334
2335 case OPT_COUNT:
2336 if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK)
2337 return TCL_ERROR;
2338 break;
2339 }
2340 }
2341
2342 query_idx = i;
2343 if (query_idx >= objc || query_idx + 2 < objc)
2344 {
2345 Tcl_WrongNumArgs(interp, query_idx - 1, objv, "query ?loop body?");
2346 return TCL_ERROR;
2347 }
2348
2349 if (query_idx + 1 < objc)
2350 loop_body = objv[query_idx + 1];
2351
2352 /************************************************************
2353 * Execute the query inside a sub-transaction, so we can cope with
2354 * errors sanely
2355 ************************************************************/
2356
2357 pltcl_subtrans_begin(oldcontext, oldowner);
2358
2359 PG_TRY();
2360 {
2361 UTF_BEGIN;
2362 spi_rc = SPI_execute(UTF_U2E(Tcl_GetString(objv[query_idx])),
2363 pltcl_current_call_state->prodesc->fn_readonly, count);
2364 UTF_END;
2365
2366 my_rc = pltcl_process_SPI_result(interp,
2367 arrayname,
2368 loop_body,
2369 spi_rc,
2370 SPI_tuptable,
2371 SPI_processed);
2372
2373 pltcl_subtrans_commit(oldcontext, oldowner);
2374 }
2375 PG_CATCH();
2376 {
2377 pltcl_subtrans_abort(interp, oldcontext, oldowner);
2378 return TCL_ERROR;
2379 }
2380 PG_END_TRY();
2381
2382 return my_rc;
2383 }
2384
2385 /*
2386 * Process the result from SPI_execute or SPI_execute_plan
2387 *
2388 * Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan
2389 */
2390 static int
pltcl_process_SPI_result(Tcl_Interp * interp,const char * arrayname,Tcl_Obj * loop_body,int spi_rc,SPITupleTable * tuptable,uint64 ntuples)2391 pltcl_process_SPI_result(Tcl_Interp *interp,
2392 const char *arrayname,
2393 Tcl_Obj *loop_body,
2394 int spi_rc,
2395 SPITupleTable *tuptable,
2396 uint64 ntuples)
2397 {
2398 int my_rc = TCL_OK;
2399 int loop_rc;
2400 HeapTuple *tuples;
2401 TupleDesc tupdesc;
2402
2403 switch (spi_rc)
2404 {
2405 case SPI_OK_SELINTO:
2406 case SPI_OK_INSERT:
2407 case SPI_OK_DELETE:
2408 case SPI_OK_UPDATE:
2409 Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ntuples));
2410 break;
2411
2412 case SPI_OK_UTILITY:
2413 case SPI_OK_REWRITTEN:
2414 if (tuptable == NULL)
2415 {
2416 Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
2417 break;
2418 }
2419 /* FALL THRU for utility returning tuples */
2420
2421 case SPI_OK_SELECT:
2422 case SPI_OK_INSERT_RETURNING:
2423 case SPI_OK_DELETE_RETURNING:
2424 case SPI_OK_UPDATE_RETURNING:
2425
2426 /*
2427 * Process the tuples we got
2428 */
2429 tuples = tuptable->vals;
2430 tupdesc = tuptable->tupdesc;
2431
2432 if (loop_body == NULL)
2433 {
2434 /*
2435 * If there is no loop body given, just set the variables from
2436 * the first tuple (if any)
2437 */
2438 if (ntuples > 0)
2439 pltcl_set_tuple_values(interp, arrayname, 0,
2440 tuples[0], tupdesc);
2441 }
2442 else
2443 {
2444 /*
2445 * There is a loop body - process all tuples and evaluate the
2446 * body on each
2447 */
2448 uint64 i;
2449
2450 for (i = 0; i < ntuples; i++)
2451 {
2452 pltcl_set_tuple_values(interp, arrayname, i,
2453 tuples[i], tupdesc);
2454
2455 loop_rc = Tcl_EvalObjEx(interp, loop_body, 0);
2456
2457 if (loop_rc == TCL_OK)
2458 continue;
2459 if (loop_rc == TCL_CONTINUE)
2460 continue;
2461 if (loop_rc == TCL_RETURN)
2462 {
2463 my_rc = TCL_RETURN;
2464 break;
2465 }
2466 if (loop_rc == TCL_BREAK)
2467 break;
2468 my_rc = TCL_ERROR;
2469 break;
2470 }
2471 }
2472
2473 if (my_rc == TCL_OK)
2474 {
2475 Tcl_SetObjResult(interp, Tcl_NewWideIntObj(ntuples));
2476 }
2477 break;
2478
2479 default:
2480 Tcl_AppendResult(interp, "pltcl: SPI_execute failed: ",
2481 SPI_result_code_string(spi_rc), NULL);
2482 my_rc = TCL_ERROR;
2483 break;
2484 }
2485
2486 SPI_freetuptable(tuptable);
2487
2488 return my_rc;
2489 }
2490
2491
2492 /**********************************************************************
2493 * pltcl_SPI_prepare() - Builtin support for prepared plans
2494 * The Tcl command SPI_prepare
2495 * always saves the plan using
2496 * SPI_keepplan and returns a key for
2497 * access. There is no chance to prepare
2498 * and not save the plan currently.
2499 **********************************************************************/
2500 static int
pltcl_SPI_prepare(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])2501 pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
2502 int objc, Tcl_Obj *const objv[])
2503 {
2504 volatile MemoryContext plan_cxt = NULL;
2505 int nargs;
2506 Tcl_Obj **argsObj;
2507 pltcl_query_desc *qdesc;
2508 int i;
2509 Tcl_HashEntry *hashent;
2510 int hashnew;
2511 Tcl_HashTable *query_hash;
2512 MemoryContext oldcontext = CurrentMemoryContext;
2513 ResourceOwner oldowner = CurrentResourceOwner;
2514
2515 /************************************************************
2516 * Check the call syntax
2517 ************************************************************/
2518 if (objc != 3)
2519 {
2520 Tcl_WrongNumArgs(interp, 1, objv, "query argtypes");
2521 return TCL_ERROR;
2522 }
2523
2524 /************************************************************
2525 * Split the argument type list
2526 ************************************************************/
2527 if (Tcl_ListObjGetElements(interp, objv[2], &nargs, &argsObj) != TCL_OK)
2528 return TCL_ERROR;
2529
2530 /************************************************************
2531 * Allocate the new querydesc structure
2532 *
2533 * struct qdesc and subsidiary data all live in plan_cxt. Note that if the
2534 * function is recompiled for whatever reason, permanent memory leaks
2535 * occur. FIXME someday.
2536 ************************************************************/
2537 plan_cxt = AllocSetContextCreate(TopMemoryContext,
2538 "PL/Tcl spi_prepare query",
2539 ALLOCSET_SMALL_SIZES);
2540 MemoryContextSwitchTo(plan_cxt);
2541 qdesc = (pltcl_query_desc *) palloc0(sizeof(pltcl_query_desc));
2542 snprintf(qdesc->qname, sizeof(qdesc->qname), "%p", qdesc);
2543 qdesc->nargs = nargs;
2544 qdesc->argtypes = (Oid *) palloc(nargs * sizeof(Oid));
2545 qdesc->arginfuncs = (FmgrInfo *) palloc(nargs * sizeof(FmgrInfo));
2546 qdesc->argtypioparams = (Oid *) palloc(nargs * sizeof(Oid));
2547 MemoryContextSwitchTo(oldcontext);
2548
2549 /************************************************************
2550 * Execute the prepare inside a sub-transaction, so we can cope with
2551 * errors sanely
2552 ************************************************************/
2553
2554 pltcl_subtrans_begin(oldcontext, oldowner);
2555
2556 PG_TRY();
2557 {
2558 /************************************************************
2559 * Resolve argument type names and then look them up by oid
2560 * in the system cache, and remember the required information
2561 * for input conversion.
2562 ************************************************************/
2563 for (i = 0; i < nargs; i++)
2564 {
2565 Oid typId,
2566 typInput,
2567 typIOParam;
2568 int32 typmod;
2569
2570 parseTypeString(Tcl_GetString(argsObj[i]), &typId, &typmod, false);
2571
2572 getTypeInputInfo(typId, &typInput, &typIOParam);
2573
2574 qdesc->argtypes[i] = typId;
2575 fmgr_info_cxt(typInput, &(qdesc->arginfuncs[i]), plan_cxt);
2576 qdesc->argtypioparams[i] = typIOParam;
2577 }
2578
2579 /************************************************************
2580 * Prepare the plan and check for errors
2581 ************************************************************/
2582 UTF_BEGIN;
2583 qdesc->plan = SPI_prepare(UTF_U2E(Tcl_GetString(objv[1])),
2584 nargs, qdesc->argtypes);
2585 UTF_END;
2586
2587 if (qdesc->plan == NULL)
2588 elog(ERROR, "SPI_prepare() failed");
2589
2590 /************************************************************
2591 * Save the plan into permanent memory (right now it's in the
2592 * SPI procCxt, which will go away at function end).
2593 ************************************************************/
2594 if (SPI_keepplan(qdesc->plan))
2595 elog(ERROR, "SPI_keepplan() failed");
2596
2597 pltcl_subtrans_commit(oldcontext, oldowner);
2598 }
2599 PG_CATCH();
2600 {
2601 pltcl_subtrans_abort(interp, oldcontext, oldowner);
2602
2603 MemoryContextDelete(plan_cxt);
2604
2605 return TCL_ERROR;
2606 }
2607 PG_END_TRY();
2608
2609 /************************************************************
2610 * Insert a hashtable entry for the plan and return
2611 * the key to the caller
2612 ************************************************************/
2613 query_hash = &pltcl_current_call_state->prodesc->interp_desc->query_hash;
2614
2615 hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
2616 Tcl_SetHashValue(hashent, (ClientData) qdesc);
2617
2618 /* qname is ASCII, so no need for encoding conversion */
2619 Tcl_SetObjResult(interp, Tcl_NewStringObj(qdesc->qname, -1));
2620 return TCL_OK;
2621 }
2622
2623
2624 /**********************************************************************
2625 * pltcl_SPI_execute_plan() - Execute a prepared plan
2626 **********************************************************************/
2627 static int
pltcl_SPI_execute_plan(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])2628 pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
2629 int objc, Tcl_Obj *const objv[])
2630 {
2631 int my_rc;
2632 int spi_rc;
2633 int i;
2634 int j;
2635 int optIndex;
2636 Tcl_HashEntry *hashent;
2637 pltcl_query_desc *qdesc;
2638 const char *nulls = NULL;
2639 const char *arrayname = NULL;
2640 Tcl_Obj *loop_body = NULL;
2641 int count = 0;
2642 int callObjc;
2643 Tcl_Obj **callObjv = NULL;
2644 Datum *argvalues;
2645 MemoryContext oldcontext = CurrentMemoryContext;
2646 ResourceOwner oldowner = CurrentResourceOwner;
2647 Tcl_HashTable *query_hash;
2648
2649 enum options
2650 {
2651 OPT_ARRAY, OPT_COUNT, OPT_NULLS
2652 };
2653
2654 static const char *options[] = {
2655 "-array", "-count", "-nulls", (const char *) NULL
2656 };
2657
2658 /************************************************************
2659 * Get the options and check syntax
2660 ************************************************************/
2661 i = 1;
2662 while (i < objc)
2663 {
2664 if (Tcl_GetIndexFromObj(NULL, objv[i], options, NULL,
2665 TCL_EXACT, &optIndex) != TCL_OK)
2666 break;
2667
2668 if (++i >= objc)
2669 {
2670 Tcl_SetObjResult(interp,
2671 Tcl_NewStringObj("missing argument to -array, -count or -nulls", -1));
2672 return TCL_ERROR;
2673 }
2674
2675 switch ((enum options) optIndex)
2676 {
2677 case OPT_ARRAY:
2678 arrayname = Tcl_GetString(objv[i++]);
2679 break;
2680
2681 case OPT_COUNT:
2682 if (Tcl_GetIntFromObj(interp, objv[i++], &count) != TCL_OK)
2683 return TCL_ERROR;
2684 break;
2685
2686 case OPT_NULLS:
2687 nulls = Tcl_GetString(objv[i++]);
2688 break;
2689 }
2690 }
2691
2692 /************************************************************
2693 * Get the prepared plan descriptor by its key
2694 ************************************************************/
2695 if (i >= objc)
2696 {
2697 Tcl_SetObjResult(interp,
2698 Tcl_NewStringObj("missing argument to -count or -array", -1));
2699 return TCL_ERROR;
2700 }
2701
2702 query_hash = &pltcl_current_call_state->prodesc->interp_desc->query_hash;
2703
2704 hashent = Tcl_FindHashEntry(query_hash, Tcl_GetString(objv[i]));
2705 if (hashent == NULL)
2706 {
2707 Tcl_AppendResult(interp, "invalid queryid '", Tcl_GetString(objv[i]), "'", NULL);
2708 return TCL_ERROR;
2709 }
2710 qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent);
2711 i++;
2712
2713 /************************************************************
2714 * If a nulls string is given, check for correct length
2715 ************************************************************/
2716 if (nulls != NULL)
2717 {
2718 if (strlen(nulls) != qdesc->nargs)
2719 {
2720 Tcl_SetObjResult(interp,
2721 Tcl_NewStringObj(
2722 "length of nulls string doesn't match number of arguments",
2723 -1));
2724 return TCL_ERROR;
2725 }
2726 }
2727
2728 /************************************************************
2729 * If there was an argtype list on preparation, we need
2730 * an argument value list now
2731 ************************************************************/
2732 if (qdesc->nargs > 0)
2733 {
2734 if (i >= objc)
2735 {
2736 Tcl_SetObjResult(interp,
2737 Tcl_NewStringObj(
2738 "argument list length doesn't match number of arguments for query"
2739 ,-1));
2740 return TCL_ERROR;
2741 }
2742
2743 /************************************************************
2744 * Split the argument values
2745 ************************************************************/
2746 if (Tcl_ListObjGetElements(interp, objv[i++], &callObjc, &callObjv) != TCL_OK)
2747 return TCL_ERROR;
2748
2749 /************************************************************
2750 * Check that the number of arguments matches
2751 ************************************************************/
2752 if (callObjc != qdesc->nargs)
2753 {
2754 Tcl_SetObjResult(interp,
2755 Tcl_NewStringObj(
2756 "argument list length doesn't match number of arguments for query"
2757 ,-1));
2758 return TCL_ERROR;
2759 }
2760 }
2761 else
2762 callObjc = 0;
2763
2764 /************************************************************
2765 * Get loop body if present
2766 ************************************************************/
2767 if (i < objc)
2768 loop_body = objv[i++];
2769
2770 if (i != objc)
2771 {
2772 Tcl_WrongNumArgs(interp, 1, objv,
2773 "?-count n? ?-array name? ?-nulls string? "
2774 "query ?args? ?loop body?");
2775 return TCL_ERROR;
2776 }
2777
2778 /************************************************************
2779 * Execute the plan inside a sub-transaction, so we can cope with
2780 * errors sanely
2781 ************************************************************/
2782
2783 pltcl_subtrans_begin(oldcontext, oldowner);
2784
2785 PG_TRY();
2786 {
2787 /************************************************************
2788 * Setup the value array for SPI_execute_plan() using
2789 * the type specific input functions
2790 ************************************************************/
2791 argvalues = (Datum *) palloc(callObjc * sizeof(Datum));
2792
2793 for (j = 0; j < callObjc; j++)
2794 {
2795 if (nulls && nulls[j] == 'n')
2796 {
2797 argvalues[j] = InputFunctionCall(&qdesc->arginfuncs[j],
2798 NULL,
2799 qdesc->argtypioparams[j],
2800 -1);
2801 }
2802 else
2803 {
2804 UTF_BEGIN;
2805 argvalues[j] = InputFunctionCall(&qdesc->arginfuncs[j],
2806 UTF_U2E(Tcl_GetString(callObjv[j])),
2807 qdesc->argtypioparams[j],
2808 -1);
2809 UTF_END;
2810 }
2811 }
2812
2813 /************************************************************
2814 * Execute the plan
2815 ************************************************************/
2816 spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls,
2817 pltcl_current_call_state->prodesc->fn_readonly,
2818 count);
2819
2820 my_rc = pltcl_process_SPI_result(interp,
2821 arrayname,
2822 loop_body,
2823 spi_rc,
2824 SPI_tuptable,
2825 SPI_processed);
2826
2827 pltcl_subtrans_commit(oldcontext, oldowner);
2828 }
2829 PG_CATCH();
2830 {
2831 pltcl_subtrans_abort(interp, oldcontext, oldowner);
2832 return TCL_ERROR;
2833 }
2834 PG_END_TRY();
2835
2836 return my_rc;
2837 }
2838
2839
2840 /**********************************************************************
2841 * pltcl_SPI_lastoid() - return the last oid. To
2842 * be used after insert queries
2843 **********************************************************************/
2844 static int
pltcl_SPI_lastoid(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])2845 pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
2846 int objc, Tcl_Obj *const objv[])
2847 {
2848 /*
2849 * Check call syntax
2850 */
2851 if (objc != 1)
2852 {
2853 Tcl_WrongNumArgs(interp, 1, objv, "");
2854 return TCL_ERROR;
2855 }
2856
2857 Tcl_SetObjResult(interp, Tcl_NewWideIntObj(SPI_lastoid));
2858 return TCL_OK;
2859 }
2860
2861
2862 /**********************************************************************
2863 * pltcl_subtransaction() - Execute some Tcl code in a subtransaction
2864 *
2865 * The subtransaction is aborted if the Tcl code fragment returns TCL_ERROR,
2866 * otherwise it's subcommitted.
2867 **********************************************************************/
2868 static int
pltcl_subtransaction(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])2869 pltcl_subtransaction(ClientData cdata, Tcl_Interp *interp,
2870 int objc, Tcl_Obj *const objv[])
2871 {
2872 MemoryContext oldcontext = CurrentMemoryContext;
2873 ResourceOwner oldowner = CurrentResourceOwner;
2874 int retcode;
2875
2876 if (objc != 2)
2877 {
2878 Tcl_WrongNumArgs(interp, 1, objv, "command");
2879 return TCL_ERROR;
2880 }
2881
2882 /*
2883 * Note: we don't use pltcl_subtrans_begin and friends here because we
2884 * don't want the error handling in pltcl_subtrans_abort. But otherwise
2885 * the processing should be about the same as in those functions.
2886 */
2887 BeginInternalSubTransaction(NULL);
2888 MemoryContextSwitchTo(oldcontext);
2889
2890 retcode = Tcl_EvalObjEx(interp, objv[1], 0);
2891
2892 if (retcode == TCL_ERROR)
2893 {
2894 /* Rollback the subtransaction */
2895 RollbackAndReleaseCurrentSubTransaction();
2896 }
2897 else
2898 {
2899 /* Commit the subtransaction */
2900 ReleaseCurrentSubTransaction();
2901 }
2902
2903 /* In either case, restore previous memory context and resource owner */
2904 MemoryContextSwitchTo(oldcontext);
2905 CurrentResourceOwner = oldowner;
2906
2907 return retcode;
2908 }
2909
2910
2911 /**********************************************************************
2912 * pltcl_set_tuple_values() - Set variables for all attributes
2913 * of a given tuple
2914 *
2915 * Note: arrayname is presumed to be UTF8; it usually came from Tcl
2916 **********************************************************************/
2917 static void
pltcl_set_tuple_values(Tcl_Interp * interp,const char * arrayname,uint64 tupno,HeapTuple tuple,TupleDesc tupdesc)2918 pltcl_set_tuple_values(Tcl_Interp *interp, const char *arrayname,
2919 uint64 tupno, HeapTuple tuple, TupleDesc tupdesc)
2920 {
2921 int i;
2922 char *outputstr;
2923 Datum attr;
2924 bool isnull;
2925 const char *attname;
2926 Oid typoutput;
2927 bool typisvarlena;
2928 const char **arrptr;
2929 const char **nameptr;
2930 const char *nullname = NULL;
2931
2932 /************************************************************
2933 * Prepare pointers for Tcl_SetVar2() below
2934 ************************************************************/
2935 if (arrayname == NULL)
2936 {
2937 arrptr = &attname;
2938 nameptr = &nullname;
2939 }
2940 else
2941 {
2942 arrptr = &arrayname;
2943 nameptr = &attname;
2944
2945 /*
2946 * When outputting to an array, fill the ".tupno" element with the
2947 * current tuple number. This will be overridden below if ".tupno" is
2948 * in use as an actual field name in the rowtype.
2949 */
2950 Tcl_SetVar2Ex(interp, arrayname, ".tupno", Tcl_NewWideIntObj(tupno), 0);
2951 }
2952
2953 for (i = 0; i < tupdesc->natts; i++)
2954 {
2955 /* ignore dropped attributes */
2956 if (tupdesc->attrs[i]->attisdropped)
2957 continue;
2958
2959 /************************************************************
2960 * Get the attribute name
2961 ************************************************************/
2962 UTF_BEGIN;
2963 attname = pstrdup(UTF_E2U(NameStr(tupdesc->attrs[i]->attname)));
2964 UTF_END;
2965
2966 /************************************************************
2967 * Get the attributes value
2968 ************************************************************/
2969 attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
2970
2971 /************************************************************
2972 * If there is a value, set the variable
2973 * If not, unset it
2974 *
2975 * Hmmm - Null attributes will cause functions to
2976 * crash if they don't expect them - need something
2977 * smarter here.
2978 ************************************************************/
2979 if (!isnull)
2980 {
2981 getTypeOutputInfo(tupdesc->attrs[i]->atttypid,
2982 &typoutput, &typisvarlena);
2983 outputstr = OidOutputFunctionCall(typoutput, attr);
2984 UTF_BEGIN;
2985 Tcl_SetVar2Ex(interp, *arrptr, *nameptr,
2986 Tcl_NewStringObj(UTF_E2U(outputstr), -1), 0);
2987 UTF_END;
2988 pfree(outputstr);
2989 }
2990 else
2991 Tcl_UnsetVar2(interp, *arrptr, *nameptr, 0);
2992
2993 pfree((char *) attname);
2994 }
2995 }
2996
2997
2998 /**********************************************************************
2999 * pltcl_build_tuple_argument() - Build a list object usable for 'array set'
3000 * from all attributes of a given tuple
3001 **********************************************************************/
3002 static Tcl_Obj *
pltcl_build_tuple_argument(HeapTuple tuple,TupleDesc tupdesc)3003 pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
3004 {
3005 Tcl_Obj *retobj = Tcl_NewObj();
3006 int i;
3007 char *outputstr;
3008 Datum attr;
3009 bool isnull;
3010 char *attname;
3011 Oid typoutput;
3012 bool typisvarlena;
3013
3014 for (i = 0; i < tupdesc->natts; i++)
3015 {
3016 /* ignore dropped attributes */
3017 if (tupdesc->attrs[i]->attisdropped)
3018 continue;
3019
3020 /************************************************************
3021 * Get the attribute name
3022 ************************************************************/
3023 attname = NameStr(tupdesc->attrs[i]->attname);
3024
3025 /************************************************************
3026 * Get the attributes value
3027 ************************************************************/
3028 attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
3029
3030 /************************************************************
3031 * If there is a value, append the attribute name and the
3032 * value to the list
3033 *
3034 * Hmmm - Null attributes will cause functions to
3035 * crash if they don't expect them - need something
3036 * smarter here.
3037 ************************************************************/
3038 if (!isnull)
3039 {
3040 getTypeOutputInfo(tupdesc->attrs[i]->atttypid,
3041 &typoutput, &typisvarlena);
3042 outputstr = OidOutputFunctionCall(typoutput, attr);
3043 UTF_BEGIN;
3044 Tcl_ListObjAppendElement(NULL, retobj,
3045 Tcl_NewStringObj(UTF_E2U(attname), -1));
3046 UTF_END;
3047 UTF_BEGIN;
3048 Tcl_ListObjAppendElement(NULL, retobj,
3049 Tcl_NewStringObj(UTF_E2U(outputstr), -1));
3050 UTF_END;
3051 pfree(outputstr);
3052 }
3053 }
3054
3055 return retobj;
3056 }
3057
3058 /**********************************************************************
3059 * pltcl_build_tuple_result() - Build a tuple of function's result rowtype
3060 * from a Tcl list of column names and values
3061 *
3062 * In a trigger function, we build a tuple of the trigger table's rowtype.
3063 *
3064 * Note: this function leaks memory. Even if we made it clean up its own
3065 * mess, there's no way to prevent the datatype input functions it calls
3066 * from leaking. Run it in a short-lived context, unless we're about to
3067 * exit the procedure anyway.
3068 **********************************************************************/
3069 static HeapTuple
pltcl_build_tuple_result(Tcl_Interp * interp,Tcl_Obj ** kvObjv,int kvObjc,pltcl_call_state * call_state)3070 pltcl_build_tuple_result(Tcl_Interp *interp, Tcl_Obj **kvObjv, int kvObjc,
3071 pltcl_call_state *call_state)
3072 {
3073 TupleDesc tupdesc;
3074 AttInMetadata *attinmeta;
3075 char **values;
3076 int i;
3077
3078 if (call_state->ret_tupdesc)
3079 {
3080 tupdesc = call_state->ret_tupdesc;
3081 attinmeta = call_state->attinmeta;
3082 }
3083 else if (call_state->trigdata)
3084 {
3085 tupdesc = RelationGetDescr(call_state->trigdata->tg_relation);
3086 attinmeta = TupleDescGetAttInMetadata(tupdesc);
3087 }
3088 else
3089 {
3090 elog(ERROR, "PL/Tcl function does not return a tuple");
3091 tupdesc = NULL; /* keep compiler quiet */
3092 attinmeta = NULL;
3093 }
3094
3095 values = (char **) palloc0(tupdesc->natts * sizeof(char *));
3096
3097 if (kvObjc % 2 != 0)
3098 ereport(ERROR,
3099 (errcode(ERRCODE_INVALID_PARAMETER_VALUE),
3100 errmsg("column name/value list must have even number of elements")));
3101
3102 for (i = 0; i < kvObjc; i += 2)
3103 {
3104 char *fieldName = utf_u2e(Tcl_GetString(kvObjv[i]));
3105 int attn = SPI_fnumber(tupdesc, fieldName);
3106
3107 /*
3108 * We silently ignore ".tupno", if it's present but doesn't match any
3109 * actual output column. This allows direct use of a row returned by
3110 * pltcl_set_tuple_values().
3111 */
3112 if (attn == SPI_ERROR_NOATTRIBUTE)
3113 {
3114 if (strcmp(fieldName, ".tupno") == 0)
3115 continue;
3116 ereport(ERROR,
3117 (errcode(ERRCODE_UNDEFINED_COLUMN),
3118 errmsg("column name/value list contains nonexistent column name \"%s\"",
3119 fieldName)));
3120 }
3121
3122 if (attn <= 0)
3123 ereport(ERROR,
3124 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
3125 errmsg("cannot set system attribute \"%s\"",
3126 fieldName)));
3127
3128 values[attn - 1] = utf_u2e(Tcl_GetString(kvObjv[i + 1]));
3129 }
3130
3131 return BuildTupleFromCStrings(attinmeta, values);
3132 }
3133
3134 /**********************************************************************
3135 * pltcl_init_tuple_store() - Initialize the result tuplestore for a SRF
3136 **********************************************************************/
3137 static void
pltcl_init_tuple_store(pltcl_call_state * call_state)3138 pltcl_init_tuple_store(pltcl_call_state *call_state)
3139 {
3140 ReturnSetInfo *rsi = call_state->rsi;
3141 MemoryContext oldcxt;
3142 ResourceOwner oldowner;
3143
3144 /* Should be in a SRF */
3145 Assert(rsi);
3146 /* Should be first time through */
3147 Assert(!call_state->tuple_store);
3148 Assert(!call_state->attinmeta);
3149
3150 /* We expect caller to provide an appropriate result tupdesc */
3151 Assert(rsi->expectedDesc);
3152 call_state->ret_tupdesc = rsi->expectedDesc;
3153
3154 /*
3155 * Switch to the right memory context and resource owner for storing the
3156 * tuplestore. If we're within a subtransaction opened for an exception
3157 * block, for example, we must still create the tuplestore in the resource
3158 * owner that was active when this function was entered, and not in the
3159 * subtransaction's resource owner.
3160 */
3161 oldcxt = MemoryContextSwitchTo(call_state->tuple_store_cxt);
3162 oldowner = CurrentResourceOwner;
3163 CurrentResourceOwner = call_state->tuple_store_owner;
3164
3165 call_state->tuple_store =
3166 tuplestore_begin_heap(rsi->allowedModes & SFRM_Materialize_Random,
3167 false, work_mem);
3168
3169 /* Build attinmeta in this context, too */
3170 call_state->attinmeta = TupleDescGetAttInMetadata(call_state->ret_tupdesc);
3171
3172 CurrentResourceOwner = oldowner;
3173 MemoryContextSwitchTo(oldcxt);
3174 }
3175