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