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