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