granicus.if.org Git - postgresql/blob - src/pl/tcl/pltcl.c

   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 /* Hack to deal with Tcl 8.4 const-ification without losing compatibility */
  17 #ifndef CONST84
  18 #define CONST84
  19 #endif
  20
  21 /* ... and for Tcl 8.6. */
  22 #ifndef CONST86
  23 #define CONST86
  24 #endif
  25
  26 #include "access/htup_details.h"
  27 #include "access/xact.h"
  28 #include "catalog/pg_proc.h"
  29 #include "catalog/pg_type.h"
  30 #include "commands/event_trigger.h"
  31 #include "commands/trigger.h"
  32 #include "executor/spi.h"
  33 #include "fmgr.h"
  34 #include "miscadmin.h"
  35 #include "nodes/makefuncs.h"
  36 #include "parser/parse_type.h"
  37 #include "tcop/tcopprot.h"
  38 #include "utils/builtins.h"
  39 #include "utils/lsyscache.h"
  40 #include "utils/memutils.h"
  41 #include "utils/rel.h"
  42 #include "utils/syscache.h"
  43 #include "utils/typcache.h"
  44
  45
  46 #define HAVE_TCL_VERSION(maj,min) \
  47         ((TCL_MAJOR_VERSION > maj) || \
  48          (TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
  49
  50 /* In Tcl >= 8.0, really not supposed to touch interp->result directly */
  51 #if !HAVE_TCL_VERSION(8,0)
  52 #define Tcl_GetStringResult(interp)  ((interp)->result)
  53 #endif
  54
  55 /* define our text domain for translations */
  56 #undef TEXTDOMAIN
  57 #define TEXTDOMAIN PG_TEXTDOMAIN("pltcl")
  58
  59 #if defined(UNICODE_CONVERSION) && HAVE_TCL_VERSION(8,1)
  60
  61 #include "mb/pg_wchar.h"
  62
  63 static unsigned char *
  64 utf_u2e(unsigned char *src)
  65 {
  66         return pg_do_encoding_conversion(src, strlen(src), PG_UTF8, GetDatabaseEncoding());
  67 }
  68
  69 static unsigned char *
  70 utf_e2u(unsigned char *src)
  71 {
  72         return pg_do_encoding_conversion(src, strlen(src), GetDatabaseEncoding(), PG_UTF8);
  73 }
  74
  75 #define PLTCL_UTF
  76 #define UTF_BEGIN        do { \
  77                                         unsigned char *_pltcl_utf_src; \
  78                                         unsigned char *_pltcl_utf_dst
  79 #define UTF_END          if (_pltcl_utf_src!=_pltcl_utf_dst) \
  80                                         pfree(_pltcl_utf_dst); } while (0)
  81 #define UTF_U2E(x)       (_pltcl_utf_dst=utf_u2e(_pltcl_utf_src=(x)))
  82 #define UTF_E2U(x)       (_pltcl_utf_dst=utf_e2u(_pltcl_utf_src=(x)))
  83 #else                                                   /* !PLTCL_UTF */
  84
  85 #define  UTF_BEGIN
  86 #define  UTF_END
  87 #define  UTF_U2E(x)  (x)
  88 #define  UTF_E2U(x)  (x)
  89 #endif   /* PLTCL_UTF */
  90
  91 PG_MODULE_MAGIC;
  92
  93
  94 /**********************************************************************
  95  * Information associated with a Tcl interpreter.  We have one interpreter
  96  * that is used for all pltclu (untrusted) functions.  For pltcl (trusted)
  97  * functions, there is a separate interpreter for each effective SQL userid.
  98  * (This is needed to ensure that an unprivileged user can't inject Tcl code
  99  * that'll be executed with the privileges of some other SQL user.)
 100  *
 101  * The pltcl_interp_desc structs are kept in a Postgres hash table indexed
 102  * by userid OID, with OID 0 used for the single untrusted interpreter.
 103  **********************************************************************/
 104 typedef struct pltcl_interp_desc
 105 {
 106         Oid                     user_id;                /* Hash key (must be first!) */
 107         Tcl_Interp *interp;                     /* The interpreter */
 108         Tcl_HashTable query_hash;       /* pltcl_query_desc structs */
 109 } pltcl_interp_desc;
 110
 111
 112 /**********************************************************************
 113  * The information we cache about loaded procedures
 114  **********************************************************************/
 115 typedef struct pltcl_proc_desc
 116 {
 117         char       *user_proname;
 118         char       *internal_proname;
 119         TransactionId fn_xmin;
 120         ItemPointerData fn_tid;
 121         bool            fn_readonly;
 122         bool            lanpltrusted;
 123         pltcl_interp_desc *interp_desc;
 124         FmgrInfo        result_in_func;
 125         Oid                     result_typioparam;
 126         int                     nargs;
 127         FmgrInfo        arg_out_func[FUNC_MAX_ARGS];
 128         bool            arg_is_rowtype[FUNC_MAX_ARGS];
 129 } pltcl_proc_desc;
 130
 131
 132 /**********************************************************************
 133  * The information we cache about prepared and saved plans
 134  **********************************************************************/
 135 typedef struct pltcl_query_desc
 136 {
 137         char            qname[20];
 138         SPIPlanPtr      plan;
 139         int                     nargs;
 140         Oid                *argtypes;
 141         FmgrInfo   *arginfuncs;
 142         Oid                *argtypioparams;
 143 } pltcl_query_desc;
 144
 145
 146 /**********************************************************************
 147  * For speedy lookup, we maintain a hash table mapping from
 148  * function OID + trigger flag + user OID to pltcl_proc_desc pointers.
 149  * The reason the pltcl_proc_desc struct isn't directly part of the hash
 150  * entry is to simplify recovery from errors during compile_pltcl_function.
 151  *
 152  * Note: if the same function is called by multiple userIDs within a session,
 153  * there will be a separate pltcl_proc_desc entry for each userID in the case
 154  * of pltcl functions, but only one entry for pltclu functions, because we
 155  * set user_id = 0 for that case.
 156  **********************************************************************/
 157 typedef struct pltcl_proc_key
 158 {
 159         Oid                     proc_id;                /* Function OID */
 160
 161         /*
 162          * is_trigger is really a bool, but declare as Oid to ensure this struct
 163          * contains no padding
 164          */
 165         Oid                     is_trigger;             /* is it a trigger function? */
 166         Oid                     user_id;                /* User calling the function, or 0 */
 167 } pltcl_proc_key;
 168
 169 typedef struct pltcl_proc_ptr
 170 {
 171         pltcl_proc_key proc_key;        /* Hash key (must be first!) */
 172         pltcl_proc_desc *proc_ptr;
 173 } pltcl_proc_ptr;
 174
 175
 176 /**********************************************************************
 177  * Global data
 178  **********************************************************************/
 179 static bool pltcl_pm_init_done = false;
 180 static Tcl_Interp *pltcl_hold_interp = NULL;
 181 static HTAB *pltcl_interp_htab = NULL;
 182 static HTAB *pltcl_proc_htab = NULL;
 183
 184 /* these are saved and restored by pltcl_handler */
 185 static FunctionCallInfo pltcl_current_fcinfo = NULL;
 186 static pltcl_proc_desc *pltcl_current_prodesc = NULL;
 187
 188 /**********************************************************************
 189  * Forward declarations
 190  **********************************************************************/
 191 Datum           pltcl_call_handler(PG_FUNCTION_ARGS);
 192 Datum           pltclu_call_handler(PG_FUNCTION_ARGS);
 193 void            _PG_init(void);
 194
 195 static void pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted);
 196 static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
 197 static void pltcl_init_load_unknown(Tcl_Interp *interp);
 198
 199 static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
 200
 201 static Datum pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted);
 202
 203 static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted);
 204 static void pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted);
 205
 206 static void throw_tcl_error(Tcl_Interp *interp, const char *proname);
 207
 208 static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid,
 209                                                                                            bool is_event_trigger,
 210                                                                                            bool pltrusted);
 211
 212 static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
 213                    int argc, CONST84 char *argv[]);
 214 static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
 215                         int argc, CONST84 char *argv[]);
 216 static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
 217                                 int argc, CONST84 char *argv[]);
 218 static int pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
 219                                  int argc, CONST84 char *argv[]);
 220
 221 static int pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
 222                                   int argc, CONST84 char *argv[]);
 223 static int pltcl_process_SPI_result(Tcl_Interp *interp,
 224                                                  CONST84 char *arrayname,
 225                                                  CONST84 char *loop_body,
 226                                                  int spi_rc,
 227                                                  SPITupleTable *tuptable,
 228                                                  int ntuples);
 229 static int pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
 230                                   int argc, CONST84 char *argv[]);
 231 static int pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
 232                                            int argc, CONST84 char *argv[]);
 233 static int pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
 234                                   int argc, CONST84 char *argv[]);
 235
 236 static void pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
 237                                            int tupno, HeapTuple tuple, TupleDesc tupdesc);
 238 static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
 239                                                    Tcl_DString *retval);
 240
 241
 242 /*
 243  * Hack to override Tcl's builtin Notifier subsystem.  This prevents the
 244  * backend from becoming multithreaded, which breaks all sorts of things.
 245  * That happens in the default version of Tcl_InitNotifier if the TCL library
 246  * has been compiled with multithreading support (i.e. when TCL_THREADS is
 247  * defined under Unix, and in all cases under Windows).
 248  * It's okay to disable the notifier because we never enter the Tcl event loop
 249  * from Postgres, so the notifier capabilities are initialized, but never
 250  * used.  Only InitNotifier and DeleteFileHandler ever seem to get called
 251  * within Postgres, but we implement all the functions for completeness.
 252  * We can only fix this with Tcl >= 8.4, when Tcl_SetNotifier() appeared.
 253  */
 254 #if HAVE_TCL_VERSION(8,4)
 255
 256 static ClientData
 257 pltcl_InitNotifier(void)
 258 {
 259         static int      fakeThreadKey;  /* To give valid address for ClientData */
 260
 261         return (ClientData) &(fakeThreadKey);
 262 }
 263
 264 static void
 265 pltcl_FinalizeNotifier(ClientData clientData)
 266 {
 267 }
 268
 269 static void
 270 pltcl_SetTimer(CONST86 Tcl_Time *timePtr)
 271 {
 272 }
 273
 274 static void
 275 pltcl_AlertNotifier(ClientData clientData)
 276 {
 277 }
 278
 279 static void
 280 pltcl_CreateFileHandler(int fd, int mask,
 281                                                 Tcl_FileProc *proc, ClientData clientData)
 282 {
 283 }
 284
 285 static void
 286 pltcl_DeleteFileHandler(int fd)
 287 {
 288 }
 289
 290 static void
 291 pltcl_ServiceModeHook(int mode)
 292 {
 293 }
 294
 295 static int
 296 pltcl_WaitForEvent(CONST86 Tcl_Time *timePtr)
 297 {
 298         return 0;
 299 }
 300 #endif   /* HAVE_TCL_VERSION(8,4) */
 301
 302
 303 /*
 304  * This routine is a crock, and so is everyplace that calls it.  The problem
 305  * is that the cached form of pltcl functions/queries is allocated permanently
 306  * (mostly via malloc()) and never released until backend exit.  Subsidiary
 307  * data structures such as fmgr info records therefore must live forever
 308  * as well.  A better implementation would store all this stuff in a per-
 309  * function memory context that could be reclaimed at need.  In the meantime,
 310  * fmgr_info_cxt must be called specifying TopMemoryContext so that whatever
 311  * it might allocate, and whatever the eventual function might allocate using
 312  * fn_mcxt, will live forever too.
 313  */
 314 static void
 315 perm_fmgr_info(Oid functionId, FmgrInfo *finfo)
 316 {
 317         fmgr_info_cxt(functionId, finfo, TopMemoryContext);
 318 }
 319
 320 /*
 321  * _PG_init()                   - library load-time initialization
 322  *
 323  * DO NOT make this static nor change its name!
 324  *
 325  * The work done here must be safe to do in the postmaster process,
 326  * in case the pltcl library is preloaded in the postmaster.
 327  */
 328 void
 329 _PG_init(void)
 330 {
 331         HASHCTL         hash_ctl;
 332
 333         /* Be sure we do initialization only once (should be redundant now) */
 334         if (pltcl_pm_init_done)
 335                 return;
 336
 337         pg_bindtextdomain(TEXTDOMAIN);
 338
 339 #ifdef WIN32
 340         /* Required on win32 to prevent error loading init.tcl */
 341         Tcl_FindExecutable("");
 342 #endif
 343
 344 #if HAVE_TCL_VERSION(8,4)
 345
 346         /*
 347          * Override the functions in the Notifier subsystem.  See comments above.
 348          */
 349         {
 350                 Tcl_NotifierProcs notifier;
 351
 352                 notifier.setTimerProc = pltcl_SetTimer;
 353                 notifier.waitForEventProc = pltcl_WaitForEvent;
 354                 notifier.createFileHandlerProc = pltcl_CreateFileHandler;
 355                 notifier.deleteFileHandlerProc = pltcl_DeleteFileHandler;
 356                 notifier.initNotifierProc = pltcl_InitNotifier;
 357                 notifier.finalizeNotifierProc = pltcl_FinalizeNotifier;
 358                 notifier.alertNotifierProc = pltcl_AlertNotifier;
 359                 notifier.serviceModeHookProc = pltcl_ServiceModeHook;
 360                 Tcl_SetNotifier(&notifier);
 361         }
 362 #endif
 363
 364         /************************************************************
 365          * Create the dummy hold interpreter to prevent close of
 366          * stdout and stderr on DeleteInterp
 367          ************************************************************/
 368         if ((pltcl_hold_interp = Tcl_CreateInterp()) == NULL)
 369                 elog(ERROR, "could not create master Tcl interpreter");
 370         if (Tcl_Init(pltcl_hold_interp) == TCL_ERROR)
 371                 elog(ERROR, "could not initialize master Tcl interpreter");
 372
 373         /************************************************************
 374          * Create the hash table for working interpreters
 375          ************************************************************/
 376         memset(&hash_ctl, 0, sizeof(hash_ctl));
 377         hash_ctl.keysize = sizeof(Oid);
 378         hash_ctl.entrysize = sizeof(pltcl_interp_desc);
 379         hash_ctl.hash = oid_hash;
 380         pltcl_interp_htab = hash_create("PL/Tcl interpreters",
 381                                                                         8,
 382                                                                         &hash_ctl,
 383                                                                         HASH_ELEM | HASH_FUNCTION);
 384
 385         /************************************************************
 386          * Create the hash table for function lookup
 387          ************************************************************/
 388         memset(&hash_ctl, 0, sizeof(hash_ctl));
 389         hash_ctl.keysize = sizeof(pltcl_proc_key);
 390         hash_ctl.entrysize = sizeof(pltcl_proc_ptr);
 391         hash_ctl.hash = tag_hash;
 392         pltcl_proc_htab = hash_create("PL/Tcl functions",
 393                                                                   100,
 394                                                                   &hash_ctl,
 395                                                                   HASH_ELEM | HASH_FUNCTION);
 396
 397         pltcl_pm_init_done = true;
 398 }
 399
 400 /**********************************************************************
 401  * pltcl_init_interp() - initialize a new Tcl interpreter
 402  **********************************************************************/
 403 static void
 404 pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted)
 405 {
 406         Tcl_Interp *interp;
 407         char            interpname[32];
 408
 409         /************************************************************
 410          * Create the Tcl interpreter as a slave of pltcl_hold_interp.
 411          * Note: Tcl automatically does Tcl_Init in the untrusted case,
 412          * and it's not wanted in the trusted case.
 413          ************************************************************/
 414         snprintf(interpname, sizeof(interpname), "slave_%u", interp_desc->user_id);
 415         if ((interp = Tcl_CreateSlave(pltcl_hold_interp, interpname,
 416                                                                   pltrusted ? 1 : 0)) == NULL)
 417                 elog(ERROR, "could not create slave Tcl interpreter");
 418         interp_desc->interp = interp;
 419
 420         /************************************************************
 421          * Initialize the query hash table associated with interpreter
 422          ************************************************************/
 423         Tcl_InitHashTable(&interp_desc->query_hash, TCL_STRING_KEYS);
 424
 425         /************************************************************
 426          * Install the commands for SPI support in the interpreter
 427          ************************************************************/
 428         Tcl_CreateCommand(interp, "elog",
 429                                           pltcl_elog, NULL, NULL);
 430         Tcl_CreateCommand(interp, "quote",
 431                                           pltcl_quote, NULL, NULL);
 432         Tcl_CreateCommand(interp, "argisnull",
 433                                           pltcl_argisnull, NULL, NULL);
 434         Tcl_CreateCommand(interp, "return_null",
 435                                           pltcl_returnnull, NULL, NULL);
 436
 437         Tcl_CreateCommand(interp, "spi_exec",
 438                                           pltcl_SPI_execute, NULL, NULL);
 439         Tcl_CreateCommand(interp, "spi_prepare",
 440                                           pltcl_SPI_prepare, NULL, NULL);
 441         Tcl_CreateCommand(interp, "spi_execp",
 442                                           pltcl_SPI_execute_plan, NULL, NULL);
 443         Tcl_CreateCommand(interp, "spi_lastoid",
 444                                           pltcl_SPI_lastoid, NULL, NULL);
 445
 446         /************************************************************
 447          * Try to load the unknown procedure from pltcl_modules
 448          ************************************************************/
 449         pltcl_init_load_unknown(interp);
 450 }
 451
 452 /**********************************************************************
 453  * pltcl_fetch_interp() - fetch the Tcl interpreter to use for a function
 454  *
 455  * This also takes care of any on-first-use initialization required.
 456  * Note: we assume caller has already connected to SPI.
 457  **********************************************************************/
 458 static pltcl_interp_desc *
 459 pltcl_fetch_interp(bool pltrusted)
 460 {
 461         Oid                     user_id;
 462         pltcl_interp_desc *interp_desc;
 463         bool            found;
 464
 465         /* Find or create the interpreter hashtable entry for this userid */
 466         if (pltrusted)
 467                 user_id = GetUserId();
 468         else
 469                 user_id = InvalidOid;
 470
 471         interp_desc = hash_search(pltcl_interp_htab, &user_id,
 472                                                           HASH_ENTER,
 473                                                           &found);
 474         if (!found)
 475                 pltcl_init_interp(interp_desc, pltrusted);
 476
 477         return interp_desc;
 478 }
 479
 480 /**********************************************************************
 481  * pltcl_init_load_unknown()    - Load the unknown procedure from
 482  *                                table pltcl_modules (if it exists)
 483  **********************************************************************/
 484 static void
 485 pltcl_init_load_unknown(Tcl_Interp *interp)
 486 {
 487         Relation        pmrel;
 488         char       *pmrelname,
 489                            *nspname;
 490         char       *buf;
 491         int                     buflen;
 492         int                     spi_rc;
 493         int                     tcl_rc;
 494         Tcl_DString unknown_src;
 495         char       *part;
 496         int                     i;
 497         int                     fno;
 498
 499         /************************************************************
 500          * Check if table pltcl_modules exists
 501          *
 502          * We allow the table to be found anywhere in the search_path.
 503          * This is for backwards compatibility.  To ensure that the table
 504          * is trustworthy, we require it to be owned by a superuser.
 505          ************************************************************/
 506         pmrel = relation_openrv_extended(makeRangeVar(NULL, "pltcl_modules", -1),
 507                                                                          AccessShareLock, true);
 508         if (pmrel == NULL)
 509                 return;
 510         /* sanity-check the relation kind */
 511         if (!(pmrel->rd_rel->relkind == RELKIND_RELATION ||
 512                   pmrel->rd_rel->relkind == RELKIND_MATVIEW ||
 513                   pmrel->rd_rel->relkind == RELKIND_VIEW))
 514         {
 515                 relation_close(pmrel, AccessShareLock);
 516                 return;
 517         }
 518         /* must be owned by superuser, else ignore */
 519         if (!superuser_arg(pmrel->rd_rel->relowner))
 520         {
 521                 relation_close(pmrel, AccessShareLock);
 522                 return;
 523         }
 524         /* get fully qualified table name for use in select command */
 525         nspname = get_namespace_name(RelationGetNamespace(pmrel));
 526         if (!nspname)
 527                 elog(ERROR, "cache lookup failed for namespace %u",
 528                          RelationGetNamespace(pmrel));
 529         pmrelname = quote_qualified_identifier(nspname,
 530                                                                                    RelationGetRelationName(pmrel));
 531
 532         /************************************************************
 533          * Read all the rows from it where modname = 'unknown',
 534          * in the order of modseq
 535          ************************************************************/
 536         buflen = strlen(pmrelname) + 100;
 537         buf = (char *) palloc(buflen);
 538         snprintf(buf, buflen,
 539                    "select modsrc from %s where modname = 'unknown' order by modseq",
 540                          pmrelname);
 541
 542         spi_rc = SPI_execute(buf, false, 0);
 543         if (spi_rc != SPI_OK_SELECT)
 544                 elog(ERROR, "select from pltcl_modules failed");
 545
 546         pfree(buf);
 547
 548         /************************************************************
 549          * If there's nothing, module unknown doesn't exist
 550          ************************************************************/
 551         if (SPI_processed == 0)
 552         {
 553                 SPI_freetuptable(SPI_tuptable);
 554                 elog(WARNING, "module \"unknown\" not found in pltcl_modules");
 555                 relation_close(pmrel, AccessShareLock);
 556                 return;
 557         }
 558
 559         /************************************************************
 560          * There is a module named unknown. Reassemble the
 561          * source from the modsrc attributes and evaluate
 562          * it in the Tcl interpreter
 563          ************************************************************/
 564         fno = SPI_fnumber(SPI_tuptable->tupdesc, "modsrc");
 565
 566         Tcl_DStringInit(&unknown_src);
 567
 568         for (i = 0; i < SPI_processed; i++)
 569         {
 570                 part = SPI_getvalue(SPI_tuptable->vals[i],
 571                                                         SPI_tuptable->tupdesc, fno);
 572                 if (part != NULL)
 573                 {
 574                         UTF_BEGIN;
 575                         Tcl_DStringAppend(&unknown_src, UTF_E2U(part), -1);
 576                         UTF_END;
 577                         pfree(part);
 578                 }
 579         }
 580         tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&unknown_src));
 581
 582         Tcl_DStringFree(&unknown_src);
 583         SPI_freetuptable(SPI_tuptable);
 584
 585         if (tcl_rc != TCL_OK)
 586         {
 587                 UTF_BEGIN;
 588                 elog(ERROR, "could not load module \"unknown\": %s",
 589                          UTF_U2E(Tcl_GetStringResult(interp)));
 590                 UTF_END;
 591         }
 592
 593         relation_close(pmrel, AccessShareLock);
 594 }
 595
 596
 597 /**********************************************************************
 598  * pltcl_call_handler           - This is the only visible function
 599  *                                of the PL interpreter. The PostgreSQL
 600  *                                function manager and trigger manager
 601  *                                call this function for execution of
 602  *                                PL/Tcl procedures.
 603  **********************************************************************/
 604 PG_FUNCTION_INFO_V1(pltcl_call_handler);
 605
 606 /* keep non-static */
 607 Datum
 608 pltcl_call_handler(PG_FUNCTION_ARGS)
 609 {
 610         return pltcl_handler(fcinfo, true);
 611 }
 612
 613 /*
 614  * Alternative handler for unsafe functions
 615  */
 616 PG_FUNCTION_INFO_V1(pltclu_call_handler);
 617
 618 /* keep non-static */
 619 Datum
 620 pltclu_call_handler(PG_FUNCTION_ARGS)
 621 {
 622         return pltcl_handler(fcinfo, false);
 623 }
 624
 625
 626 static Datum
 627 pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
 628 {
 629         Datum           retval;
 630         FunctionCallInfo save_fcinfo;
 631         pltcl_proc_desc *save_prodesc;
 632
 633         /*
 634          * Ensure that static pointers are saved/restored properly
 635          */
 636         save_fcinfo = pltcl_current_fcinfo;
 637         save_prodesc = pltcl_current_prodesc;
 638
 639         PG_TRY();
 640         {
 641                 /*
 642                  * Determine if called as function or trigger and call appropriate
 643                  * subhandler
 644                  */
 645                 if (CALLED_AS_TRIGGER(fcinfo))
 646                 {
 647                         pltcl_current_fcinfo = NULL;
 648                         retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, pltrusted));
 649                 }
 650                 else if (CALLED_AS_EVENT_TRIGGER(fcinfo))
 651                 {
 652                         pltcl_current_fcinfo = NULL;
 653                         pltcl_event_trigger_handler(fcinfo, pltrusted);
 654                         retval = (Datum) 0;
 655                 }
 656                 else
 657                 {
 658                         pltcl_current_fcinfo = fcinfo;
 659                         retval = pltcl_func_handler(fcinfo, pltrusted);
 660                 }
 661         }
 662         PG_CATCH();
 663         {
 664                 pltcl_current_fcinfo = save_fcinfo;
 665                 pltcl_current_prodesc = save_prodesc;
 666                 PG_RE_THROW();
 667         }
 668         PG_END_TRY();
 669
 670         pltcl_current_fcinfo = save_fcinfo;
 671         pltcl_current_prodesc = save_prodesc;
 672
 673         return retval;
 674 }
 675
 676
 677 /**********************************************************************
 678  * pltcl_func_handler()         - Handler for regular function calls
 679  **********************************************************************/
 680 static Datum
 681 pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
 682 {
 683         pltcl_proc_desc *prodesc;
 684         Tcl_Interp *volatile interp;
 685         Tcl_DString tcl_cmd;
 686         Tcl_DString list_tmp;
 687         int                     i;
 688         int                     tcl_rc;
 689         Datum           retval;
 690
 691         /* Connect to SPI manager */
 692         if (SPI_connect() != SPI_OK_CONNECT)
 693                 elog(ERROR, "could not connect to SPI manager");
 694
 695         /* Find or compile the function */
 696         prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
 697                                                                          false, pltrusted);
 698
 699         pltcl_current_prodesc = prodesc;
 700
 701         interp = prodesc->interp_desc->interp;
 702
 703         /************************************************************
 704          * Create the tcl command to call the internal
 705          * proc in the Tcl interpreter
 706          ************************************************************/
 707         Tcl_DStringInit(&tcl_cmd);
 708         Tcl_DStringInit(&list_tmp);
 709         Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
 710
 711         /************************************************************
 712          * Add all call arguments to the command
 713          ************************************************************/
 714         PG_TRY();
 715         {
 716                 for (i = 0; i < prodesc->nargs; i++)
 717                 {
 718                         if (prodesc->arg_is_rowtype[i])
 719                         {
 720                                 /**************************************************
 721                                  * For tuple values, add a list for 'array set ...'
 722                                  **************************************************/
 723                                 if (fcinfo->argnull[i])
 724                                         Tcl_DStringAppendElement(&tcl_cmd, "");
 725                                 else
 726                                 {
 727                                         HeapTupleHeader td;
 728                                         Oid                     tupType;
 729                                         int32           tupTypmod;
 730                                         TupleDesc       tupdesc;
 731                                         HeapTupleData tmptup;
 732
 733                                         td = DatumGetHeapTupleHeader(fcinfo->arg[i]);
 734                                         /* Extract rowtype info and find a tupdesc */
 735                                         tupType = HeapTupleHeaderGetTypeId(td);
 736                                         tupTypmod = HeapTupleHeaderGetTypMod(td);
 737                                         tupdesc = lookup_rowtype_tupdesc(tupType, tupTypmod);
 738                                         /* Build a temporary HeapTuple control structure */
 739                                         tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
 740                                         tmptup.t_data = td;
 741
 742                                         Tcl_DStringSetLength(&list_tmp, 0);
 743                                         pltcl_build_tuple_argument(&tmptup, tupdesc, &list_tmp);
 744                                         Tcl_DStringAppendElement(&tcl_cmd,
 745                                                                                          Tcl_DStringValue(&list_tmp));
 746                                         ReleaseTupleDesc(tupdesc);
 747                                 }
 748                         }
 749                         else
 750                         {
 751                                 /**************************************************
 752                                  * Single values are added as string element
 753                                  * of their external representation
 754                                  **************************************************/
 755                                 if (fcinfo->argnull[i])
 756                                         Tcl_DStringAppendElement(&tcl_cmd, "");
 757                                 else
 758                                 {
 759                                         char       *tmp;
 760
 761                                         tmp = OutputFunctionCall(&prodesc->arg_out_func[i],
 762                                                                                          fcinfo->arg[i]);
 763                                         UTF_BEGIN;
 764                                         Tcl_DStringAppendElement(&tcl_cmd, UTF_E2U(tmp));
 765                                         UTF_END;
 766                                         pfree(tmp);
 767                                 }
 768                         }
 769                 }
 770         }
 771         PG_CATCH();
 772         {
 773                 Tcl_DStringFree(&tcl_cmd);
 774                 Tcl_DStringFree(&list_tmp);
 775                 PG_RE_THROW();
 776         }
 777         PG_END_TRY();
 778         Tcl_DStringFree(&list_tmp);
 779
 780         /************************************************************
 781          * Call the Tcl function
 782          *
 783          * We assume no PG error can be thrown directly from this call.
 784          ************************************************************/
 785         tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
 786         Tcl_DStringFree(&tcl_cmd);
 787
 788         /************************************************************
 789          * Check for errors reported by Tcl.
 790          ************************************************************/
 791         if (tcl_rc != TCL_OK)
 792                 throw_tcl_error(interp, prodesc->user_proname);
 793
 794         /************************************************************
 795          * Disconnect from SPI manager and then create the return
 796          * value datum (if the input function does a palloc for it
 797          * this must not be allocated in the SPI memory context
 798          * because SPI_finish would free it).  But don't try to call
 799          * the result_in_func if we've been told to return a NULL;
 800          * the Tcl result may not be a valid value of the result type
 801          * in that case.
 802          ************************************************************/
 803         if (SPI_finish() != SPI_OK_FINISH)
 804                 elog(ERROR, "SPI_finish() failed");
 805
 806         if (fcinfo->isnull)
 807                 retval = InputFunctionCall(&prodesc->result_in_func,
 808                                                                    NULL,
 809                                                                    prodesc->result_typioparam,
 810                                                                    -1);
 811         else
 812         {
 813                 UTF_BEGIN;
 814                 retval = InputFunctionCall(&prodesc->result_in_func,
 815                                                            UTF_U2E((char *) Tcl_GetStringResult(interp)),
 816                                                                    prodesc->result_typioparam,
 817                                                                    -1);
 818                 UTF_END;
 819         }
 820
 821         return retval;
 822 }
 823
 824
 825 /**********************************************************************
 826  * pltcl_trigger_handler()      - Handler for trigger calls
 827  **********************************************************************/
 828 static HeapTuple
 829 pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
 830 {
 831         pltcl_proc_desc *prodesc;
 832         Tcl_Interp *volatile interp;
 833         TriggerData *trigdata = (TriggerData *) fcinfo->context;
 834         char       *stroid;
 835         TupleDesc       tupdesc;
 836         volatile HeapTuple rettup;
 837         Tcl_DString tcl_cmd;
 838         Tcl_DString tcl_trigtup;
 839         Tcl_DString tcl_newtup;
 840         int                     tcl_rc;
 841         int                     i;
 842         int                *modattrs;
 843         Datum      *modvalues;
 844         char       *modnulls;
 845         int                     ret_numvals;
 846         CONST84 char *result;
 847         CONST84 char **ret_values;
 848
 849         /* Connect to SPI manager */
 850         if (SPI_connect() != SPI_OK_CONNECT)
 851                 elog(ERROR, "could not connect to SPI manager");
 852
 853         /* Find or compile the function */
 854         prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
 855                                                                          RelationGetRelid(trigdata->tg_relation),
 856                                                                          false, /* not an event trigger */
 857                                                                          pltrusted);
 858
 859         pltcl_current_prodesc = prodesc;
 860
 861         interp = prodesc->interp_desc->interp;
 862
 863         tupdesc = trigdata->tg_relation->rd_att;
 864
 865         /************************************************************
 866          * Create the tcl command to call the internal
 867          * proc in the interpreter
 868          ************************************************************/
 869         Tcl_DStringInit(&tcl_cmd);
 870         Tcl_DStringInit(&tcl_trigtup);
 871         Tcl_DStringInit(&tcl_newtup);
 872         PG_TRY();
 873         {
 874                 /* The procedure name */
 875                 Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
 876
 877                 /* The trigger name for argument TG_name */
 878                 Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgname);
 879
 880                 /* The oid of the trigger relation for argument TG_relid */
 881                 stroid = DatumGetCString(DirectFunctionCall1(oidout,
 882                                                         ObjectIdGetDatum(trigdata->tg_relation->rd_id)));
 883                 Tcl_DStringAppendElement(&tcl_cmd, stroid);
 884                 pfree(stroid);
 885
 886                 /* The name of the table the trigger is acting on: TG_table_name */
 887                 stroid = SPI_getrelname(trigdata->tg_relation);
 888                 Tcl_DStringAppendElement(&tcl_cmd, stroid);
 889                 pfree(stroid);
 890
 891                 /* The schema of the table the trigger is acting on: TG_table_schema */
 892                 stroid = SPI_getnspname(trigdata->tg_relation);
 893                 Tcl_DStringAppendElement(&tcl_cmd, stroid);
 894                 pfree(stroid);
 895
 896                 /* A list of attribute names for argument TG_relatts */
 897                 Tcl_DStringAppendElement(&tcl_trigtup, "");
 898                 for (i = 0; i < tupdesc->natts; i++)
 899                 {
 900                         if (tupdesc->attrs[i]->attisdropped)
 901                                 Tcl_DStringAppendElement(&tcl_trigtup, "");
 902                         else
 903                                 Tcl_DStringAppendElement(&tcl_trigtup,
 904                                                                                  NameStr(tupdesc->attrs[i]->attname));
 905                 }
 906                 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
 907                 Tcl_DStringFree(&tcl_trigtup);
 908                 Tcl_DStringInit(&tcl_trigtup);
 909
 910                 /* The when part of the event for TG_when */
 911                 if (TRIGGER_FIRED_BEFORE(trigdata->tg_event))
 912                         Tcl_DStringAppendElement(&tcl_cmd, "BEFORE");
 913                 else if (TRIGGER_FIRED_AFTER(trigdata->tg_event))
 914                         Tcl_DStringAppendElement(&tcl_cmd, "AFTER");
 915                 else if (TRIGGER_FIRED_INSTEAD(trigdata->tg_event))
 916                         Tcl_DStringAppendElement(&tcl_cmd, "INSTEAD OF");
 917                 else
 918                         elog(ERROR, "unrecognized WHEN tg_event: %u", trigdata->tg_event);
 919
 920                 /* The level part of the event for TG_level */
 921                 if (TRIGGER_FIRED_FOR_ROW(trigdata->tg_event))
 922                 {
 923                         Tcl_DStringAppendElement(&tcl_cmd, "ROW");
 924
 925                         /* Build the data list for the trigtuple */
 926                         pltcl_build_tuple_argument(trigdata->tg_trigtuple,
 927                                                                            tupdesc, &tcl_trigtup);
 928
 929                         /*
 930                          * Now the command part of the event for TG_op and data for NEW
 931                          * and OLD
 932                          */
 933                         if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
 934                         {
 935                                 Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
 936
 937                                 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
 938                                 Tcl_DStringAppendElement(&tcl_cmd, "");
 939
 940                                 rettup = trigdata->tg_trigtuple;
 941                         }
 942                         else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
 943                         {
 944                                 Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
 945
 946                                 Tcl_DStringAppendElement(&tcl_cmd, "");
 947                                 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
 948
 949                                 rettup = trigdata->tg_trigtuple;
 950                         }
 951                         else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
 952                         {
 953                                 Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
 954
 955                                 pltcl_build_tuple_argument(trigdata->tg_newtuple,
 956                                                                                    tupdesc, &tcl_newtup);
 957
 958                                 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_newtup));
 959                                 Tcl_DStringAppendElement(&tcl_cmd, Tcl_DStringValue(&tcl_trigtup));
 960
 961                                 rettup = trigdata->tg_newtuple;
 962                         }
 963                         else
 964                                 elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
 965                 }
 966                 else if (TRIGGER_FIRED_FOR_STATEMENT(trigdata->tg_event))
 967                 {
 968                         Tcl_DStringAppendElement(&tcl_cmd, "STATEMENT");
 969
 970                         if (TRIGGER_FIRED_BY_INSERT(trigdata->tg_event))
 971                                 Tcl_DStringAppendElement(&tcl_cmd, "INSERT");
 972                         else if (TRIGGER_FIRED_BY_DELETE(trigdata->tg_event))
 973                                 Tcl_DStringAppendElement(&tcl_cmd, "DELETE");
 974                         else if (TRIGGER_FIRED_BY_UPDATE(trigdata->tg_event))
 975                                 Tcl_DStringAppendElement(&tcl_cmd, "UPDATE");
 976                         else if (TRIGGER_FIRED_BY_TRUNCATE(trigdata->tg_event))
 977                                 Tcl_DStringAppendElement(&tcl_cmd, "TRUNCATE");
 978                         else
 979                                 elog(ERROR, "unrecognized OP tg_event: %u", trigdata->tg_event);
 980
 981                         Tcl_DStringAppendElement(&tcl_cmd, "");
 982                         Tcl_DStringAppendElement(&tcl_cmd, "");
 983
 984                         rettup = (HeapTuple) NULL;
 985                 }
 986                 else
 987                         elog(ERROR, "unrecognized LEVEL tg_event: %u", trigdata->tg_event);
 988
 989                 /* Finally append the arguments from CREATE TRIGGER */
 990                 for (i = 0; i < trigdata->tg_trigger->tgnargs; i++)
 991                         Tcl_DStringAppendElement(&tcl_cmd, trigdata->tg_trigger->tgargs[i]);
 992
 993         }
 994         PG_CATCH();
 995         {
 996                 Tcl_DStringFree(&tcl_cmd);
 997                 Tcl_DStringFree(&tcl_trigtup);
 998                 Tcl_DStringFree(&tcl_newtup);
 999                 PG_RE_THROW();
1000         }
1001         PG_END_TRY();
1002         Tcl_DStringFree(&tcl_trigtup);
1003         Tcl_DStringFree(&tcl_newtup);
1004
1005         /************************************************************
1006          * Call the Tcl function
1007          *
1008          * We assume no PG error can be thrown directly from this call.
1009          ************************************************************/
1010         tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
1011         Tcl_DStringFree(&tcl_cmd);
1012
1013         /************************************************************
1014          * Check for errors reported by Tcl.
1015          ************************************************************/
1016         if (tcl_rc != TCL_OK)
1017                 throw_tcl_error(interp, prodesc->user_proname);
1018
1019         /************************************************************
1020          * The return value from the procedure might be one of
1021          * the magic strings OK or SKIP or a list from array get.
1022          * We can check for OK or SKIP without worrying about encoding.
1023          ************************************************************/
1024         if (SPI_finish() != SPI_OK_FINISH)
1025                 elog(ERROR, "SPI_finish() failed");
1026
1027         result = Tcl_GetStringResult(interp);
1028
1029         if (strcmp(result, "OK") == 0)
1030                 return rettup;
1031         if (strcmp(result, "SKIP") == 0)
1032                 return (HeapTuple) NULL;
1033
1034         /************************************************************
1035          * Convert the result value from the Tcl interpreter
1036          * and setup structures for SPI_modifytuple();
1037          ************************************************************/
1038         if (Tcl_SplitList(interp, result,
1039                                           &ret_numvals, &ret_values) != TCL_OK)
1040         {
1041                 UTF_BEGIN;
1042                 elog(ERROR, "could not split return value from trigger: %s",
1043                          UTF_U2E(Tcl_GetStringResult(interp)));
1044                 UTF_END;
1045         }
1046
1047         /* Use a TRY to ensure ret_values will get freed */
1048         PG_TRY();
1049         {
1050                 if (ret_numvals % 2 != 0)
1051                         elog(ERROR, "invalid return list from trigger - must have even # of elements");
1052
1053                 modattrs = (int *) palloc(tupdesc->natts * sizeof(int));
1054                 modvalues = (Datum *) palloc(tupdesc->natts * sizeof(Datum));
1055                 for (i = 0; i < tupdesc->natts; i++)
1056                 {
1057                         modattrs[i] = i + 1;
1058                         modvalues[i] = (Datum) NULL;
1059                 }
1060
1061                 modnulls = palloc(tupdesc->natts);
1062                 memset(modnulls, 'n', tupdesc->natts);
1063
1064                 for (i = 0; i < ret_numvals; i += 2)
1065                 {
1066                         CONST84 char *ret_name = ret_values[i];
1067                         CONST84 char *ret_value = ret_values[i + 1];
1068                         int                     attnum;
1069                         HeapTuple       typeTup;
1070                         Oid                     typinput;
1071                         Oid                     typioparam;
1072                         FmgrInfo        finfo;
1073
1074                         /************************************************************
1075                          * Ignore ".tupno" pseudo elements (see pltcl_set_tuple_values)
1076                          ************************************************************/
1077                         if (strcmp(ret_name, ".tupno") == 0)
1078                                 continue;
1079
1080                         /************************************************************
1081                          * Get the attribute number
1082                          ************************************************************/
1083                         attnum = SPI_fnumber(tupdesc, ret_name);
1084                         if (attnum == SPI_ERROR_NOATTRIBUTE)
1085                                 elog(ERROR, "invalid attribute \"%s\"", ret_name);
1086                         if (attnum <= 0)
1087                                 elog(ERROR, "cannot set system attribute \"%s\"", ret_name);
1088
1089                         /************************************************************
1090                          * Ignore dropped columns
1091                          ************************************************************/
1092                         if (tupdesc->attrs[attnum - 1]->attisdropped)
1093                                 continue;
1094
1095                         /************************************************************
1096                          * Lookup the attribute type in the syscache
1097                          * for the input function
1098                          ************************************************************/
1099                         typeTup = SearchSysCache1(TYPEOID,
1100                                          ObjectIdGetDatum(tupdesc->attrs[attnum - 1]->atttypid));
1101                         if (!HeapTupleIsValid(typeTup))
1102                                 elog(ERROR, "cache lookup failed for type %u",
1103                                          tupdesc->attrs[attnum - 1]->atttypid);
1104                         typinput = ((Form_pg_type) GETSTRUCT(typeTup))->typinput;
1105                         typioparam = getTypeIOParam(typeTup);
1106                         ReleaseSysCache(typeTup);
1107
1108                         /************************************************************
1109                          * Set the attribute to NOT NULL and convert the contents
1110                          ************************************************************/
1111                         modnulls[attnum - 1] = ' ';
1112                         fmgr_info(typinput, &finfo);
1113                         UTF_BEGIN;
1114                         modvalues[attnum - 1] = InputFunctionCall(&finfo,
1115                                                                                                  (char *) UTF_U2E(ret_value),
1116                                                                                                           typioparam,
1117                                                                           tupdesc->attrs[attnum - 1]->atttypmod);
1118                         UTF_END;
1119                 }
1120
1121                 rettup = SPI_modifytuple(trigdata->tg_relation, rettup, tupdesc->natts,
1122                                                                  modattrs, modvalues, modnulls);
1123
1124                 pfree(modattrs);
1125                 pfree(modvalues);
1126                 pfree(modnulls);
1127
1128                 if (rettup == NULL)
1129                         elog(ERROR, "SPI_modifytuple() failed - RC = %d", SPI_result);
1130
1131         }
1132         PG_CATCH();
1133         {
1134                 ckfree((char *) ret_values);
1135                 PG_RE_THROW();
1136         }
1137         PG_END_TRY();
1138         ckfree((char *) ret_values);
1139
1140         return rettup;
1141 }
1142
1143 /**********************************************************************
1144  * pltcl_event_trigger_handler()        - Handler for event trigger calls
1145  **********************************************************************/
1146 static void
1147 pltcl_event_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
1148 {
1149         pltcl_proc_desc *prodesc;
1150         Tcl_Interp *volatile interp;
1151         EventTriggerData *tdata = (EventTriggerData *) fcinfo->context;
1152         Tcl_DString tcl_cmd;
1153         int                     tcl_rc;
1154
1155         /* Connect to SPI manager */
1156         if (SPI_connect() != SPI_OK_CONNECT)
1157                 elog(ERROR, "could not connect to SPI manager");
1158
1159         /* Find or compile the function */
1160         prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
1161                                                                          InvalidOid, true, pltrusted);
1162
1163         pltcl_current_prodesc = prodesc;
1164
1165         interp = prodesc->interp_desc->interp;
1166
1167         /* Create the tcl command and call the internal proc */
1168         Tcl_DStringInit(&tcl_cmd);
1169         Tcl_DStringAppendElement(&tcl_cmd, prodesc->internal_proname);
1170         Tcl_DStringAppendElement(&tcl_cmd, tdata->event);
1171         Tcl_DStringAppendElement(&tcl_cmd, tdata->tag);
1172
1173         tcl_rc = Tcl_GlobalEval(interp, Tcl_DStringValue(&tcl_cmd));
1174         Tcl_DStringFree(&tcl_cmd);
1175
1176         /* Check for errors reported by Tcl. */
1177         if (tcl_rc != TCL_OK)
1178                 throw_tcl_error(interp, prodesc->user_proname);
1179
1180         if (SPI_finish() != SPI_OK_FINISH)
1181                 elog(ERROR, "SPI_finish() failed");
1182 }
1183
1184
1185 /**********************************************************************
1186  * throw_tcl_error      - ereport an error returned from the Tcl interpreter
1187  **********************************************************************/
1188 static void
1189 throw_tcl_error(Tcl_Interp *interp, const char *proname)
1190 {
1191         /*
1192          * Caution is needed here because Tcl_GetVar could overwrite the
1193          * interpreter result (even though it's not really supposed to), and we
1194          * can't control the order of evaluation of ereport arguments. Hence, make
1195          * real sure we have our own copy of the result string before invoking
1196          * Tcl_GetVar.
1197          */
1198         char       *emsg;
1199         char       *econtext;
1200
1201         UTF_BEGIN;
1202         emsg = pstrdup(UTF_U2E(Tcl_GetStringResult(interp)));
1203         UTF_END;
1204         UTF_BEGIN;
1205         econtext = UTF_U2E((char *) Tcl_GetVar(interp, "errorInfo",
1206                                                                                    TCL_GLOBAL_ONLY));
1207         ereport(ERROR,
1208                         (errmsg("%s", emsg),
1209                          errcontext("%s\nin PL/Tcl function \"%s\"",
1210                                                 econtext, proname)));
1211         UTF_END;
1212 }
1213
1214
1215 /**********************************************************************
1216  * compile_pltcl_function       - compile (or hopefully just look up) function
1217  *
1218  * tgreloid is the OID of the relation when compiling a trigger, or zero
1219  * (InvalidOid) when compiling a plain function.
1220  **********************************************************************/
1221 static pltcl_proc_desc *
1222 compile_pltcl_function(Oid fn_oid, Oid tgreloid,
1223                                            bool is_event_trigger, bool pltrusted)
1224 {
1225         HeapTuple       procTup;
1226         Form_pg_proc procStruct;
1227         pltcl_proc_key proc_key;
1228         pltcl_proc_ptr *proc_ptr;
1229         bool            found;
1230         pltcl_proc_desc *prodesc;
1231
1232         /* We'll need the pg_proc tuple in any case... */
1233         procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(fn_oid));
1234         if (!HeapTupleIsValid(procTup))
1235                 elog(ERROR, "cache lookup failed for function %u", fn_oid);
1236         procStruct = (Form_pg_proc) GETSTRUCT(procTup);
1237
1238         /* Try to find function in pltcl_proc_htab */
1239         proc_key.proc_id = fn_oid;
1240         proc_key.is_trigger = OidIsValid(tgreloid);
1241         proc_key.user_id = pltrusted ? GetUserId() : InvalidOid;
1242
1243         proc_ptr = hash_search(pltcl_proc_htab, &proc_key,
1244                                                    HASH_ENTER,
1245                                                    &found);
1246         if (!found)
1247                 proc_ptr->proc_ptr = NULL;
1248
1249         prodesc = proc_ptr->proc_ptr;
1250
1251         /************************************************************
1252          * If it's present, must check whether it's still up to date.
1253          * This is needed because CREATE OR REPLACE FUNCTION can modify the
1254          * function's pg_proc entry without changing its OID.
1255          ************************************************************/
1256         if (prodesc != NULL)
1257         {
1258                 bool            uptodate;
1259
1260                 uptodate = (prodesc->fn_xmin == HeapTupleHeaderGetRawXmin(procTup->t_data) &&
1261                                         ItemPointerEquals(&prodesc->fn_tid, &procTup->t_self));
1262
1263                 if (!uptodate)
1264                 {
1265                         proc_ptr->proc_ptr = NULL;
1266                         prodesc = NULL;
1267                 }
1268         }
1269
1270         /************************************************************
1271          * If we haven't found it in the hashtable, we analyze
1272          * the functions arguments and returntype and store
1273          * the in-/out-functions in the prodesc block and create
1274          * a new hashtable entry for it.
1275          *
1276          * Then we load the procedure into the Tcl interpreter.
1277          ************************************************************/
1278         if (prodesc == NULL)
1279         {
1280                 bool            is_trigger = OidIsValid(tgreloid);
1281                 char            internal_proname[128];
1282                 HeapTuple       typeTup;
1283                 Form_pg_type typeStruct;
1284                 Tcl_DString proc_internal_def;
1285                 Tcl_DString proc_internal_body;
1286                 char            proc_internal_args[33 * FUNC_MAX_ARGS];
1287                 Datum           prosrcdatum;
1288                 bool            isnull;
1289                 char       *proc_source;
1290                 char            buf[32];
1291                 Tcl_Interp *interp;
1292                 int                     i;
1293                 int                     tcl_rc;
1294
1295                 /************************************************************
1296                  * Build our internal proc name from the function's Oid.  Append
1297                  * "_trigger" when appropriate to ensure the normal and trigger
1298                  * cases are kept separate.
1299                  ************************************************************/
1300                 if (!is_trigger && !is_event_trigger)
1301                         snprintf(internal_proname, sizeof(internal_proname),
1302                                          "__PLTcl_proc_%u", fn_oid);
1303                 else if (is_event_trigger)
1304                         snprintf(internal_proname, sizeof(internal_proname),
1305                                          "__PLTcl_proc_%u_evttrigger", fn_oid);
1306                 else if (is_trigger)
1307                         snprintf(internal_proname, sizeof(internal_proname),
1308                                          "__PLTcl_proc_%u_trigger", fn_oid);
1309
1310                 /************************************************************
1311                  * Allocate a new procedure description block
1312                  ************************************************************/
1313                 prodesc = (pltcl_proc_desc *) malloc(sizeof(pltcl_proc_desc));
1314                 if (prodesc == NULL)
1315                         ereport(ERROR,
1316                                         (errcode(ERRCODE_OUT_OF_MEMORY),
1317                                          errmsg("out of memory")));
1318                 MemSet(prodesc, 0, sizeof(pltcl_proc_desc));
1319                 prodesc->user_proname = strdup(NameStr(procStruct->proname));
1320                 prodesc->internal_proname = strdup(internal_proname);
1321                 if (prodesc->user_proname == NULL || prodesc->internal_proname == NULL)
1322                         ereport(ERROR,
1323                                         (errcode(ERRCODE_OUT_OF_MEMORY),
1324                                          errmsg("out of memory")));
1325                 prodesc->fn_xmin = HeapTupleHeaderGetRawXmin(procTup->t_data);
1326                 prodesc->fn_tid = procTup->t_self;
1327
1328                 /* Remember if function is STABLE/IMMUTABLE */
1329                 prodesc->fn_readonly =
1330                         (procStruct->provolatile != PROVOLATILE_VOLATILE);
1331                 /* And whether it is trusted */
1332                 prodesc->lanpltrusted = pltrusted;
1333
1334                 /************************************************************
1335                  * Identify the interpreter to use for the function
1336                  ************************************************************/
1337                 prodesc->interp_desc = pltcl_fetch_interp(prodesc->lanpltrusted);
1338                 interp = prodesc->interp_desc->interp;
1339
1340                 /************************************************************
1341                  * Get the required information for input conversion of the
1342                  * return value.
1343                  ************************************************************/
1344                 if (!is_trigger && !is_event_trigger)
1345                 {
1346                         typeTup =
1347                                 SearchSysCache1(TYPEOID,
1348                                                                 ObjectIdGetDatum(procStruct->prorettype));
1349                         if (!HeapTupleIsValid(typeTup))
1350                         {
1351                                 free(prodesc->user_proname);
1352                                 free(prodesc->internal_proname);
1353                                 free(prodesc);
1354                                 elog(ERROR, "cache lookup failed for type %u",
1355                                          procStruct->prorettype);
1356                         }
1357                         typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
1358
1359                         /* Disallow pseudotype result, except VOID */
1360                         if (typeStruct->typtype == TYPTYPE_PSEUDO)
1361                         {
1362                                 if (procStruct->prorettype == VOIDOID)
1363                                          /* okay */ ;
1364                                 else if (procStruct->prorettype == TRIGGEROID ||
1365                                                  procStruct->prorettype == EVTTRIGGEROID)
1366                                 {
1367                                         free(prodesc->user_proname);
1368                                         free(prodesc->internal_proname);
1369                                         free(prodesc);
1370                                         ereport(ERROR,
1371                                                         (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1372                                                          errmsg("trigger functions can only be called as triggers")));
1373                                 }
1374                                 else
1375                                 {
1376                                         free(prodesc->user_proname);
1377                                         free(prodesc->internal_proname);
1378                                         free(prodesc);
1379                                         ereport(ERROR,
1380                                                         (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1381                                                          errmsg("PL/Tcl functions cannot return type %s",
1382                                                                         format_type_be(procStruct->prorettype))));
1383                                 }
1384                         }
1385
1386                         if (typeStruct->typtype == TYPTYPE_COMPOSITE)
1387                         {
1388                                 free(prodesc->user_proname);
1389                                 free(prodesc->internal_proname);
1390                                 free(prodesc);
1391                                 ereport(ERROR,
1392                                                 (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1393                                   errmsg("PL/Tcl functions cannot return composite types")));
1394                         }
1395
1396                         perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
1397                         prodesc->result_typioparam = getTypeIOParam(typeTup);
1398
1399                         ReleaseSysCache(typeTup);
1400                 }
1401
1402                 /************************************************************
1403                  * Get the required information for output conversion
1404                  * of all procedure arguments
1405                  ************************************************************/
1406                 if (!is_trigger && !is_event_trigger)
1407                 {
1408                         prodesc->nargs = procStruct->pronargs;
1409                         proc_internal_args[0] = '\0';
1410                         for (i = 0; i < prodesc->nargs; i++)
1411                         {
1412                                 typeTup = SearchSysCache1(TYPEOID,
1413                                                 ObjectIdGetDatum(procStruct->proargtypes.values[i]));
1414                                 if (!HeapTupleIsValid(typeTup))
1415                                 {
1416                                         free(prodesc->user_proname);
1417                                         free(prodesc->internal_proname);
1418                                         free(prodesc);
1419                                         elog(ERROR, "cache lookup failed for type %u",
1420                                                  procStruct->proargtypes.values[i]);
1421                                 }
1422                                 typeStruct = (Form_pg_type) GETSTRUCT(typeTup);
1423
1424                                 /* Disallow pseudotype argument */
1425                                 if (typeStruct->typtype == TYPTYPE_PSEUDO)
1426                                 {
1427                                         free(prodesc->user_proname);
1428                                         free(prodesc->internal_proname);
1429                                         free(prodesc);
1430                                         ereport(ERROR,
1431                                                         (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
1432                                                          errmsg("PL/Tcl functions cannot accept type %s",
1433                                                 format_type_be(procStruct->proargtypes.values[i]))));
1434                                 }
1435
1436                                 if (typeStruct->typtype == TYPTYPE_COMPOSITE)
1437                                 {
1438                                         prodesc->arg_is_rowtype[i] = true;
1439                                         snprintf(buf, sizeof(buf), "__PLTcl_Tup_%d", i + 1);
1440                                 }
1441                                 else
1442                                 {
1443                                         prodesc->arg_is_rowtype[i] = false;
1444                                         perm_fmgr_info(typeStruct->typoutput,
1445                                                                    &(prodesc->arg_out_func[i]));
1446                                         snprintf(buf, sizeof(buf), "%d", i + 1);
1447                                 }
1448
1449                                 if (i > 0)
1450                                         strcat(proc_internal_args, " ");
1451                                 strcat(proc_internal_args, buf);
1452
1453                                 ReleaseSysCache(typeTup);
1454                         }
1455                 }
1456                 else if (is_trigger)
1457                 {
1458                         /* trigger procedure has fixed args */
1459                         strcpy(proc_internal_args,
1460                                    "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");
1461                 }
1462                 else if (is_event_trigger)
1463                 {
1464                         /* event trigger procedure has fixed args */
1465                         strcpy(proc_internal_args, "TG_event TG_tag");
1466                 }
1467
1468                 /************************************************************
1469                  * Create the tcl command to define the internal
1470                  * procedure
1471                  ************************************************************/
1472                 Tcl_DStringInit(&proc_internal_def);
1473                 Tcl_DStringInit(&proc_internal_body);
1474                 Tcl_DStringAppendElement(&proc_internal_def, "proc");
1475                 Tcl_DStringAppendElement(&proc_internal_def, internal_proname);
1476                 Tcl_DStringAppendElement(&proc_internal_def, proc_internal_args);
1477
1478                 /************************************************************
1479                  * prefix procedure body with
1480                  * upvar #0 <internal_procname> GD
1481                  * and with appropriate setting of arguments
1482                  ************************************************************/
1483                 Tcl_DStringAppend(&proc_internal_body, "upvar #0 ", -1);
1484                 Tcl_DStringAppend(&proc_internal_body, internal_proname, -1);
1485                 Tcl_DStringAppend(&proc_internal_body, " GD\n", -1);
1486                 if (is_trigger)
1487                 {
1488                         Tcl_DStringAppend(&proc_internal_body,
1489                                                           "array set NEW $__PLTcl_Tup_NEW\n", -1);
1490                         Tcl_DStringAppend(&proc_internal_body,
1491                                                           "array set OLD $__PLTcl_Tup_OLD\n", -1);
1492
1493                         Tcl_DStringAppend(&proc_internal_body,
1494                                                           "set i 0\n"
1495                                                           "set v 0\n"
1496                                                           "foreach v $args {\n"
1497                                                           "  incr i\n"
1498                                                           "  set $i $v\n"
1499                                                           "}\n"
1500                                                           "unset i v\n\n", -1);
1501                 }
1502                 else if (is_event_trigger)
1503                 {
1504                         /* no argument support for event triggers */
1505                 }
1506                 else
1507                 {
1508                         for (i = 0; i < prodesc->nargs; i++)
1509                         {
1510                                 if (prodesc->arg_is_rowtype[i])
1511                                 {
1512                                         snprintf(buf, sizeof(buf),
1513                                                          "array set %d $__PLTcl_Tup_%d\n",
1514                                                          i + 1, i + 1);
1515                                         Tcl_DStringAppend(&proc_internal_body, buf, -1);
1516                                 }
1517                         }
1518                 }
1519
1520                 /************************************************************
1521                  * Add user's function definition to proc body
1522                  ************************************************************/
1523                 prosrcdatum = SysCacheGetAttr(PROCOID, procTup,
1524                                                                           Anum_pg_proc_prosrc, &isnull);
1525                 if (isnull)
1526                         elog(ERROR, "null prosrc");
1527                 proc_source = TextDatumGetCString(prosrcdatum);
1528                 UTF_BEGIN;
1529                 Tcl_DStringAppend(&proc_internal_body, UTF_E2U(proc_source), -1);
1530                 UTF_END;
1531                 pfree(proc_source);
1532                 Tcl_DStringAppendElement(&proc_internal_def,
1533                                                                  Tcl_DStringValue(&proc_internal_body));
1534                 Tcl_DStringFree(&proc_internal_body);
1535
1536                 /************************************************************
1537                  * Create the procedure in the interpreter
1538                  ************************************************************/
1539                 tcl_rc = Tcl_GlobalEval(interp,
1540                                                                 Tcl_DStringValue(&proc_internal_def));
1541                 Tcl_DStringFree(&proc_internal_def);
1542                 if (tcl_rc != TCL_OK)
1543                 {
1544                         free(prodesc->user_proname);
1545                         free(prodesc->internal_proname);
1546                         free(prodesc);
1547                         UTF_BEGIN;
1548                         elog(ERROR, "could not create internal procedure \"%s\": %s",
1549                                  internal_proname, UTF_U2E(Tcl_GetStringResult(interp)));
1550                         UTF_END;
1551                 }
1552
1553                 /************************************************************
1554                  * Add the proc description block to the hashtable.  Note we do not
1555                  * attempt to free any previously existing prodesc block.  This is
1556                  * annoying, but necessary since there could be active calls using
1557                  * the old prodesc.
1558                  ************************************************************/
1559                 proc_ptr->proc_ptr = prodesc;
1560         }
1561
1562         ReleaseSysCache(procTup);
1563
1564         return prodesc;
1565 }
1566
1567
1568 /**********************************************************************
1569  * pltcl_elog()         - elog() support for PLTcl
1570  **********************************************************************/
1571 static int
1572 pltcl_elog(ClientData cdata, Tcl_Interp *interp,
1573                    int argc, CONST84 char *argv[])
1574 {
1575         volatile int level;
1576         MemoryContext oldcontext;
1577
1578         if (argc != 3)
1579         {
1580                 Tcl_SetResult(interp, "syntax error - 'elog level msg'", TCL_STATIC);
1581                 return TCL_ERROR;
1582         }
1583
1584         if (strcmp(argv[1], "DEBUG") == 0)
1585                 level = DEBUG2;
1586         else if (strcmp(argv[1], "LOG") == 0)
1587                 level = LOG;
1588         else if (strcmp(argv[1], "INFO") == 0)
1589                 level = INFO;
1590         else if (strcmp(argv[1], "NOTICE") == 0)
1591                 level = NOTICE;
1592         else if (strcmp(argv[1], "WARNING") == 0)
1593                 level = WARNING;
1594         else if (strcmp(argv[1], "ERROR") == 0)
1595                 level = ERROR;
1596         else if (strcmp(argv[1], "FATAL") == 0)
1597                 level = FATAL;
1598         else
1599         {
1600                 Tcl_AppendResult(interp, "Unknown elog level '", argv[1],
1601                                                  "'", NULL);
1602                 return TCL_ERROR;
1603         }
1604
1605         if (level == ERROR)
1606         {
1607                 /*
1608                  * We just pass the error back to Tcl.  If it's not caught, it'll
1609                  * eventually get converted to a PG error when we reach the call
1610                  * handler.
1611                  */
1612                 Tcl_SetResult(interp, (char *) argv[2], TCL_VOLATILE);
1613                 return TCL_ERROR;
1614         }
1615
1616         /*
1617          * For non-error messages, just pass 'em to elog().  We do not expect that
1618          * this will fail, but just on the off chance it does, report the error
1619          * back to Tcl.  Note we are assuming that elog() can't have any internal
1620          * failures that are so bad as to require a transaction abort.
1621          *
1622          * This path is also used for FATAL errors, which aren't going to come
1623          * back to us at all.
1624          */
1625         oldcontext = CurrentMemoryContext;
1626         PG_TRY();
1627         {
1628                 UTF_BEGIN;
1629                 elog(level, "%s", UTF_U2E(argv[2]));
1630                 UTF_END;
1631         }
1632         PG_CATCH();
1633         {
1634                 ErrorData  *edata;
1635
1636                 /* Must reset elog.c's state */
1637                 MemoryContextSwitchTo(oldcontext);
1638                 edata = CopyErrorData();
1639                 FlushErrorState();
1640
1641                 /* Pass the error message to Tcl */
1642                 UTF_BEGIN;
1643                 Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
1644                 UTF_END;
1645                 FreeErrorData(edata);
1646
1647                 return TCL_ERROR;
1648         }
1649         PG_END_TRY();
1650
1651         return TCL_OK;
1652 }
1653
1654
1655 /**********************************************************************
1656  * pltcl_quote()        - quote literal strings that are to
1657  *                        be used in SPI_execute query strings
1658  **********************************************************************/
1659 static int
1660 pltcl_quote(ClientData cdata, Tcl_Interp *interp,
1661                         int argc, CONST84 char *argv[])
1662 {
1663         char       *tmp;
1664         const char *cp1;
1665         char       *cp2;
1666
1667         /************************************************************
1668          * Check call syntax
1669          ************************************************************/
1670         if (argc != 2)
1671         {
1672                 Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC);
1673                 return TCL_ERROR;
1674         }
1675
1676         /************************************************************
1677          * Allocate space for the maximum the string can
1678          * grow to and initialize pointers
1679          ************************************************************/
1680         tmp = palloc(strlen(argv[1]) * 2 + 1);
1681         cp1 = argv[1];
1682         cp2 = tmp;
1683
1684         /************************************************************
1685          * Walk through string and double every quote and backslash
1686          ************************************************************/
1687         while (*cp1)
1688         {
1689                 if (*cp1 == '\'')
1690                         *cp2++ = '\'';
1691                 else
1692                 {
1693                         if (*cp1 == '\\')
1694                                 *cp2++ = '\\';
1695                 }
1696                 *cp2++ = *cp1++;
1697         }
1698
1699         /************************************************************
1700          * Terminate the string and set it as result
1701          ************************************************************/
1702         *cp2 = '\0';
1703         Tcl_SetResult(interp, tmp, TCL_VOLATILE);
1704         pfree(tmp);
1705         return TCL_OK;
1706 }
1707
1708
1709 /**********************************************************************
1710  * pltcl_argisnull()    - determine if a specific argument is NULL
1711  **********************************************************************/
1712 static int
1713 pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
1714                                 int argc, CONST84 char *argv[])
1715 {
1716         int                     argno;
1717         FunctionCallInfo fcinfo = pltcl_current_fcinfo;
1718
1719         /************************************************************
1720          * Check call syntax
1721          ************************************************************/
1722         if (argc != 2)
1723         {
1724                 Tcl_SetResult(interp, "syntax error - 'argisnull argno'",
1725                                           TCL_STATIC);
1726                 return TCL_ERROR;
1727         }
1728
1729         /************************************************************
1730          * Check that we're called as a normal function
1731          ************************************************************/
1732         if (fcinfo == NULL)
1733         {
1734                 Tcl_SetResult(interp, "argisnull cannot be used in triggers",
1735                                           TCL_STATIC);
1736                 return TCL_ERROR;
1737         }
1738
1739         /************************************************************
1740          * Get the argument number
1741          ************************************************************/
1742         if (Tcl_GetInt(interp, argv[1], &argno) != TCL_OK)
1743                 return TCL_ERROR;
1744
1745         /************************************************************
1746          * Check that the argno is valid
1747          ************************************************************/
1748         argno--;
1749         if (argno < 0 || argno >= fcinfo->nargs)
1750         {
1751                 Tcl_SetResult(interp, "argno out of range", TCL_STATIC);
1752                 return TCL_ERROR;
1753         }
1754
1755         /************************************************************
1756          * Get the requested NULL state
1757          ************************************************************/
1758         if (PG_ARGISNULL(argno))
1759                 Tcl_SetResult(interp, "1", TCL_STATIC);
1760         else
1761                 Tcl_SetResult(interp, "0", TCL_STATIC);
1762
1763         return TCL_OK;
1764 }
1765
1766
1767 /**********************************************************************
1768  * pltcl_returnnull()   - Cause a NULL return from a function
1769  **********************************************************************/
1770 static int
1771 pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
1772                                  int argc, CONST84 char *argv[])
1773 {
1774         FunctionCallInfo fcinfo = pltcl_current_fcinfo;
1775
1776         /************************************************************
1777          * Check call syntax
1778          ************************************************************/
1779         if (argc != 1)
1780         {
1781                 Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC);
1782                 return TCL_ERROR;
1783         }
1784
1785         /************************************************************
1786          * Check that we're called as a normal function
1787          ************************************************************/
1788         if (fcinfo == NULL)
1789         {
1790                 Tcl_SetResult(interp, "return_null cannot be used in triggers",
1791                                           TCL_STATIC);
1792                 return TCL_ERROR;
1793         }
1794
1795         /************************************************************
1796          * Set the NULL return flag and cause Tcl to return from the
1797          * procedure.
1798          ************************************************************/
1799         fcinfo->isnull = true;
1800
1801         return TCL_RETURN;
1802 }
1803
1804
1805 /*----------
1806  * Support for running SPI operations inside subtransactions
1807  *
1808  * Intended usage pattern is:
1809  *
1810  *      MemoryContext oldcontext = CurrentMemoryContext;
1811  *      ResourceOwner oldowner = CurrentResourceOwner;
1812  *
1813  *      ...
1814  *      pltcl_subtrans_begin(oldcontext, oldowner);
1815  *      PG_TRY();
1816  *      {
1817  *              do something risky;
1818  *              pltcl_subtrans_commit(oldcontext, oldowner);
1819  *      }
1820  *      PG_CATCH();
1821  *      {
1822  *              pltcl_subtrans_abort(interp, oldcontext, oldowner);
1823  *              return TCL_ERROR;
1824  *      }
1825  *      PG_END_TRY();
1826  *      return TCL_OK;
1827  *----------
1828  */
1829 static void
1830 pltcl_subtrans_begin(MemoryContext oldcontext, ResourceOwner oldowner)
1831 {
1832         BeginInternalSubTransaction(NULL);
1833
1834         /* Want to run inside function's memory context */
1835         MemoryContextSwitchTo(oldcontext);
1836 }
1837
1838 static void
1839 pltcl_subtrans_commit(MemoryContext oldcontext, ResourceOwner oldowner)
1840 {
1841         /* Commit the inner transaction, return to outer xact context */
1842         ReleaseCurrentSubTransaction();
1843         MemoryContextSwitchTo(oldcontext);
1844         CurrentResourceOwner = oldowner;
1845
1846         /*
1847          * AtEOSubXact_SPI() should not have popped any SPI context, but just in
1848          * case it did, make sure we remain connected.
1849          */
1850         SPI_restore_connection();
1851 }
1852
1853 static void
1854 pltcl_subtrans_abort(Tcl_Interp *interp,
1855                                          MemoryContext oldcontext, ResourceOwner oldowner)
1856 {
1857         ErrorData  *edata;
1858
1859         /* Save error info */
1860         MemoryContextSwitchTo(oldcontext);
1861         edata = CopyErrorData();
1862         FlushErrorState();
1863
1864         /* Abort the inner transaction */
1865         RollbackAndReleaseCurrentSubTransaction();
1866         MemoryContextSwitchTo(oldcontext);
1867         CurrentResourceOwner = oldowner;
1868
1869         /*
1870          * If AtEOSubXact_SPI() popped any SPI context of the subxact, it will
1871          * have left us in a disconnected state.  We need this hack to return to
1872          * connected state.
1873          */
1874         SPI_restore_connection();
1875
1876         /* Pass the error message to Tcl */
1877         UTF_BEGIN;
1878         Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
1879         UTF_END;
1880         FreeErrorData(edata);
1881 }
1882
1883
1884 /**********************************************************************
1885  * pltcl_SPI_execute()          - The builtin SPI_execute command
1886  *                                for the Tcl interpreter
1887  **********************************************************************/
1888 static int
1889 pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
1890                                   int argc, CONST84 char *argv[])
1891 {
1892         int                     my_rc;
1893         int                     spi_rc;
1894         int                     query_idx;
1895         int                     i;
1896         int                     count = 0;
1897         CONST84 char *volatile arrayname = NULL;
1898         CONST84 char *volatile loop_body = NULL;
1899         MemoryContext oldcontext = CurrentMemoryContext;
1900         ResourceOwner oldowner = CurrentResourceOwner;
1901
1902         char       *usage = "syntax error - 'SPI_exec "
1903         "?-count n? "
1904         "?-array name? query ?loop body?";
1905
1906         /************************************************************
1907          * Check the call syntax and get the options
1908          ************************************************************/
1909         if (argc < 2)
1910         {
1911                 Tcl_SetResult(interp, usage, TCL_STATIC);
1912                 return TCL_ERROR;
1913         }
1914
1915         i = 1;
1916         while (i < argc)
1917         {
1918                 if (strcmp(argv[i], "-array") == 0)
1919                 {
1920                         if (++i >= argc)
1921                         {
1922                                 Tcl_SetResult(interp, usage, TCL_STATIC);
1923                                 return TCL_ERROR;
1924                         }
1925                         arrayname = argv[i++];
1926                         continue;
1927                 }
1928
1929                 if (strcmp(argv[i], "-count") == 0)
1930                 {
1931                         if (++i >= argc)
1932                         {
1933                                 Tcl_SetResult(interp, usage, TCL_STATIC);
1934                                 return TCL_ERROR;
1935                         }
1936                         if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
1937                                 return TCL_ERROR;
1938                         continue;
1939                 }
1940
1941                 break;
1942         }
1943
1944         query_idx = i;
1945         if (query_idx >= argc || query_idx + 2 < argc)
1946         {
1947                 Tcl_SetResult(interp, usage, TCL_STATIC);
1948                 return TCL_ERROR;
1949         }
1950         if (query_idx + 1 < argc)
1951                 loop_body = argv[query_idx + 1];
1952
1953         /************************************************************
1954          * Execute the query inside a sub-transaction, so we can cope with
1955          * errors sanely
1956          ************************************************************/
1957
1958         pltcl_subtrans_begin(oldcontext, oldowner);
1959
1960         PG_TRY();
1961         {
1962                 UTF_BEGIN;
1963                 spi_rc = SPI_execute(UTF_U2E(argv[query_idx]),
1964                                                          pltcl_current_prodesc->fn_readonly, count);
1965                 UTF_END;
1966
1967                 my_rc = pltcl_process_SPI_result(interp,
1968                                                                                  arrayname,
1969                                                                                  loop_body,
1970                                                                                  spi_rc,
1971                                                                                  SPI_tuptable,
1972                                                                                  SPI_processed);
1973
1974                 pltcl_subtrans_commit(oldcontext, oldowner);
1975         }
1976         PG_CATCH();
1977         {
1978                 pltcl_subtrans_abort(interp, oldcontext, oldowner);
1979                 return TCL_ERROR;
1980         }
1981         PG_END_TRY();
1982
1983         return my_rc;
1984 }
1985
1986 /*
1987  * Process the result from SPI_execute or SPI_execute_plan
1988  *
1989  * Shared code between pltcl_SPI_execute and pltcl_SPI_execute_plan
1990  */
1991 static int
1992 pltcl_process_SPI_result(Tcl_Interp *interp,
1993                                                  CONST84 char *arrayname,
1994                                                  CONST84 char *loop_body,
1995                                                  int spi_rc,
1996                                                  SPITupleTable *tuptable,
1997                                                  int ntuples)
1998 {
1999         int                     my_rc = TCL_OK;
2000         char            buf[64];
2001         int                     i;
2002         int                     loop_rc;
2003         HeapTuple  *tuples;
2004         TupleDesc       tupdesc;
2005
2006         switch (spi_rc)
2007         {
2008                 case SPI_OK_SELINTO:
2009                 case SPI_OK_INSERT:
2010                 case SPI_OK_DELETE:
2011                 case SPI_OK_UPDATE:
2012                         snprintf(buf, sizeof(buf), "%d", ntuples);
2013                         Tcl_SetResult(interp, buf, TCL_VOLATILE);
2014                         break;
2015
2016                 case SPI_OK_UTILITY:
2017                 case SPI_OK_REWRITTEN:
2018                         if (tuptable == NULL)
2019                         {
2020                                 Tcl_SetResult(interp, "0", TCL_STATIC);
2021                                 break;
2022                         }
2023                         /* FALL THRU for utility returning tuples */
2024
2025                 case SPI_OK_SELECT:
2026                 case SPI_OK_INSERT_RETURNING:
2027                 case SPI_OK_DELETE_RETURNING:
2028                 case SPI_OK_UPDATE_RETURNING:
2029
2030                         /*
2031                          * Process the tuples we got
2032                          */
2033                         tuples = tuptable->vals;
2034                         tupdesc = tuptable->tupdesc;
2035
2036                         if (loop_body == NULL)
2037                         {
2038                                 /*
2039                                  * If there is no loop body given, just set the variables from
2040                                  * the first tuple (if any)
2041                                  */
2042                                 if (ntuples > 0)
2043                                         pltcl_set_tuple_values(interp, arrayname, 0,
2044                                                                                    tuples[0], tupdesc);
2045                         }
2046                         else
2047                         {
2048                                 /*
2049                                  * There is a loop body - process all tuples and evaluate the
2050                                  * body on each
2051                                  */
2052                                 for (i = 0; i < ntuples; i++)
2053                                 {
2054                                         pltcl_set_tuple_values(interp, arrayname, i,
2055                                                                                    tuples[i], tupdesc);
2056
2057                                         loop_rc = Tcl_Eval(interp, loop_body);
2058
2059                                         if (loop_rc == TCL_OK)
2060                                                 continue;
2061                                         if (loop_rc == TCL_CONTINUE)
2062                                                 continue;
2063                                         if (loop_rc == TCL_RETURN)
2064                                         {
2065                                                 my_rc = TCL_RETURN;
2066                                                 break;
2067                                         }
2068                                         if (loop_rc == TCL_BREAK)
2069                                                 break;
2070                                         my_rc = TCL_ERROR;
2071                                         break;
2072                                 }
2073                         }
2074
2075                         if (my_rc == TCL_OK)
2076                         {
2077                                 snprintf(buf, sizeof(buf), "%d", ntuples);
2078                                 Tcl_SetResult(interp, buf, TCL_VOLATILE);
2079                         }
2080                         break;
2081
2082                 default:
2083                         Tcl_AppendResult(interp, "pltcl: SPI_execute failed: ",
2084                                                          SPI_result_code_string(spi_rc), NULL);
2085                         my_rc = TCL_ERROR;
2086                         break;
2087         }
2088
2089         SPI_freetuptable(tuptable);
2090
2091         return my_rc;
2092 }
2093
2094
2095 /**********************************************************************
2096  * pltcl_SPI_prepare()          - Builtin support for prepared plans
2097  *                                The Tcl command SPI_prepare
2098  *                                always saves the plan using
2099  *                                SPI_keepplan and returns a key for
2100  *                                access. There is no chance to prepare
2101  *                                and not save the plan currently.
2102  **********************************************************************/
2103 static int
2104 pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
2105                                   int argc, CONST84 char *argv[])
2106 {
2107         int                     nargs;
2108         CONST84 char **args;
2109         pltcl_query_desc *qdesc;
2110         int                     i;
2111         Tcl_HashEntry *hashent;
2112         int                     hashnew;
2113         Tcl_HashTable *query_hash;
2114         MemoryContext oldcontext = CurrentMemoryContext;
2115         ResourceOwner oldowner = CurrentResourceOwner;
2116
2117         /************************************************************
2118          * Check the call syntax
2119          ************************************************************/
2120         if (argc != 3)
2121         {
2122                 Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
2123                                           TCL_STATIC);
2124                 return TCL_ERROR;
2125         }
2126
2127         /************************************************************
2128          * Split the argument type list
2129          ************************************************************/
2130         if (Tcl_SplitList(interp, argv[2], &nargs, &args) != TCL_OK)
2131                 return TCL_ERROR;
2132
2133         /************************************************************
2134          * Allocate the new querydesc structure
2135          ************************************************************/
2136         qdesc = (pltcl_query_desc *) malloc(sizeof(pltcl_query_desc));
2137         snprintf(qdesc->qname, sizeof(qdesc->qname), "%p", qdesc);
2138         qdesc->nargs = nargs;
2139         qdesc->argtypes = (Oid *) malloc(nargs * sizeof(Oid));
2140         qdesc->arginfuncs = (FmgrInfo *) malloc(nargs * sizeof(FmgrInfo));
2141         qdesc->argtypioparams = (Oid *) malloc(nargs * sizeof(Oid));
2142
2143         /************************************************************
2144          * Execute the prepare inside a sub-transaction, so we can cope with
2145          * errors sanely
2146          ************************************************************/
2147
2148         pltcl_subtrans_begin(oldcontext, oldowner);
2149
2150         PG_TRY();
2151         {
2152                 /************************************************************
2153                  * Resolve argument type names and then look them up by oid
2154                  * in the system cache, and remember the required information
2155                  * for input conversion.
2156                  ************************************************************/
2157                 for (i = 0; i < nargs; i++)
2158                 {
2159                         Oid                     typId,
2160                                                 typInput,
2161                                                 typIOParam;
2162                         int32           typmod;
2163
2164                         parseTypeString(args[i], &typId, &typmod);
2165
2166                         getTypeInputInfo(typId, &typInput, &typIOParam);
2167
2168                         qdesc->argtypes[i] = typId;
2169                         perm_fmgr_info(typInput, &(qdesc->arginfuncs[i]));
2170                         qdesc->argtypioparams[i] = typIOParam;
2171                 }
2172
2173                 /************************************************************
2174                  * Prepare the plan and check for errors
2175                  ************************************************************/
2176                 UTF_BEGIN;
2177                 qdesc->plan = SPI_prepare(UTF_U2E(argv[1]), nargs, qdesc->argtypes);
2178                 UTF_END;
2179
2180                 if (qdesc->plan == NULL)
2181                         elog(ERROR, "SPI_prepare() failed");
2182
2183                 /************************************************************
2184                  * Save the plan into permanent memory (right now it's in the
2185                  * SPI procCxt, which will go away at function end).
2186                  ************************************************************/
2187                 if (SPI_keepplan(qdesc->plan))
2188                         elog(ERROR, "SPI_keepplan() failed");
2189
2190                 pltcl_subtrans_commit(oldcontext, oldowner);
2191         }
2192         PG_CATCH();
2193         {
2194                 pltcl_subtrans_abort(interp, oldcontext, oldowner);
2195
2196                 free(qdesc->argtypes);
2197                 free(qdesc->arginfuncs);
2198                 free(qdesc->argtypioparams);
2199                 free(qdesc);
2200                 ckfree((char *) args);
2201
2202                 return TCL_ERROR;
2203         }
2204         PG_END_TRY();
2205
2206         /************************************************************
2207          * Insert a hashtable entry for the plan and return
2208          * the key to the caller
2209          ************************************************************/
2210         query_hash = &pltcl_current_prodesc->interp_desc->query_hash;
2211
2212         hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
2213         Tcl_SetHashValue(hashent, (ClientData) qdesc);
2214
2215         ckfree((char *) args);
2216
2217         /* qname is ASCII, so no need for encoding conversion */
2218         Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
2219         return TCL_OK;
2220 }
2221
2222
2223 /**********************************************************************
2224  * pltcl_SPI_execute_plan()             - Execute a prepared plan
2225  **********************************************************************/
2226 static int
2227 pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
2228                                            int argc, CONST84 char *argv[])
2229 {
2230         int                     my_rc;
2231         int                     spi_rc;
2232         int                     i;
2233         int                     j;
2234         Tcl_HashEntry *hashent;
2235         pltcl_query_desc *qdesc;
2236         const char *volatile nulls = NULL;
2237         CONST84 char *volatile arrayname = NULL;
2238         CONST84 char *volatile loop_body = NULL;
2239         int                     count = 0;
2240         int                     callnargs;
2241         CONST84 char **callargs = NULL;
2242         Datum      *argvalues;
2243         MemoryContext oldcontext = CurrentMemoryContext;
2244         ResourceOwner oldowner = CurrentResourceOwner;
2245         Tcl_HashTable *query_hash;
2246
2247         char       *usage = "syntax error - 'SPI_execp "
2248         "?-nulls string? ?-count n? "
2249         "?-array name? query ?args? ?loop body?";
2250
2251         /************************************************************
2252          * Get the options and check syntax
2253          ************************************************************/
2254         i = 1;
2255         while (i < argc)
2256         {
2257                 if (strcmp(argv[i], "-array") == 0)
2258                 {
2259                         if (++i >= argc)
2260                         {
2261                                 Tcl_SetResult(interp, usage, TCL_STATIC);
2262                                 return TCL_ERROR;
2263                         }
2264                         arrayname = argv[i++];
2265                         continue;
2266                 }
2267                 if (strcmp(argv[i], "-nulls") == 0)
2268                 {
2269                         if (++i >= argc)
2270                         {
2271                                 Tcl_SetResult(interp, usage, TCL_STATIC);
2272                                 return TCL_ERROR;
2273                         }
2274                         nulls = argv[i++];
2275                         continue;
2276                 }
2277                 if (strcmp(argv[i], "-count") == 0)
2278                 {
2279                         if (++i >= argc)
2280                         {
2281                                 Tcl_SetResult(interp, usage, TCL_STATIC);
2282                                 return TCL_ERROR;
2283                         }
2284                         if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
2285                                 return TCL_ERROR;
2286                         continue;
2287                 }
2288
2289                 break;
2290         }
2291
2292         /************************************************************
2293          * Get the prepared plan descriptor by its key
2294          ************************************************************/
2295         if (i >= argc)
2296         {
2297                 Tcl_SetResult(interp, usage, TCL_STATIC);
2298                 return TCL_ERROR;
2299         }
2300
2301         query_hash = &pltcl_current_prodesc->interp_desc->query_hash;
2302
2303         hashent = Tcl_FindHashEntry(query_hash, argv[i]);
2304         if (hashent == NULL)
2305         {
2306                 Tcl_AppendResult(interp, "invalid queryid '", argv[i], "'", NULL);
2307                 return TCL_ERROR;
2308         }
2309         qdesc = (pltcl_query_desc *) Tcl_GetHashValue(hashent);
2310         i++;
2311
2312         /************************************************************
2313          * If a nulls string is given, check for correct length
2314          ************************************************************/
2315         if (nulls != NULL)
2316         {
2317                 if (strlen(nulls) != qdesc->nargs)
2318                 {
2319                         Tcl_SetResult(interp,
2320                                            "length of nulls string doesn't match # of arguments",
2321                                                   TCL_STATIC);
2322                         return TCL_ERROR;
2323                 }
2324         }
2325
2326         /************************************************************
2327          * If there was a argtype list on preparation, we need
2328          * an argument value list now
2329          ************************************************************/
2330         if (qdesc->nargs > 0)
2331         {
2332                 if (i >= argc)
2333                 {
2334                         Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
2335                         return TCL_ERROR;
2336                 }
2337
2338                 /************************************************************
2339                  * Split the argument values
2340                  ************************************************************/
2341                 if (Tcl_SplitList(interp, argv[i++], &callnargs, &callargs) != TCL_OK)
2342                         return TCL_ERROR;
2343
2344                 /************************************************************
2345                  * Check that the # of arguments matches
2346                  ************************************************************/
2347                 if (callnargs != qdesc->nargs)
2348                 {
2349                         Tcl_SetResult(interp,
2350                            "argument list length doesn't match # of arguments for query",
2351                                                   TCL_STATIC);
2352                         ckfree((char *) callargs);
2353                         return TCL_ERROR;
2354                 }
2355         }
2356         else
2357                 callnargs = 0;
2358
2359         /************************************************************
2360          * Get loop body if present
2361          ************************************************************/
2362         if (i < argc)
2363                 loop_body = argv[i++];
2364
2365         if (i != argc)
2366         {
2367                 Tcl_SetResult(interp, usage, TCL_STATIC);
2368                 return TCL_ERROR;
2369         }
2370
2371         /************************************************************
2372          * Execute the plan inside a sub-transaction, so we can cope with
2373          * errors sanely
2374          ************************************************************/
2375
2376         pltcl_subtrans_begin(oldcontext, oldowner);
2377
2378         PG_TRY();
2379         {
2380                 /************************************************************
2381                  * Setup the value array for SPI_execute_plan() using
2382                  * the type specific input functions
2383                  ************************************************************/
2384                 argvalues = (Datum *) palloc(callnargs * sizeof(Datum));
2385
2386                 for (j = 0; j < callnargs; j++)
2387                 {
2388                         if (nulls && nulls[j] == 'n')
2389                         {
2390                                 argvalues[j] = InputFunctionCall(&qdesc->arginfuncs[j],
2391                                                                                                  NULL,
2392                                                                                                  qdesc->argtypioparams[j],
2393                                                                                                  -1);
2394                         }
2395                         else
2396                         {
2397                                 UTF_BEGIN;
2398                                 argvalues[j] = InputFunctionCall(&qdesc->arginfuncs[j],
2399                                                                                            (char *) UTF_U2E(callargs[j]),
2400                                                                                                  qdesc->argtypioparams[j],
2401                                                                                                  -1);
2402                                 UTF_END;
2403                         }
2404                 }
2405
2406                 if (callargs)
2407                         ckfree((char *) callargs);
2408                 callargs = NULL;
2409
2410                 /************************************************************
2411                  * Execute the plan
2412                  ************************************************************/
2413                 spi_rc = SPI_execute_plan(qdesc->plan, argvalues, nulls,
2414                                                                   pltcl_current_prodesc->fn_readonly, count);
2415
2416                 my_rc = pltcl_process_SPI_result(interp,
2417                                                                                  arrayname,
2418                                                                                  loop_body,
2419                                                                                  spi_rc,
2420                                                                                  SPI_tuptable,
2421                                                                                  SPI_processed);
2422
2423                 pltcl_subtrans_commit(oldcontext, oldowner);
2424         }
2425         PG_CATCH();
2426         {
2427                 pltcl_subtrans_abort(interp, oldcontext, oldowner);
2428
2429                 if (callargs)
2430                         ckfree((char *) callargs);
2431
2432                 return TCL_ERROR;
2433         }
2434         PG_END_TRY();
2435
2436         return my_rc;
2437 }
2438
2439
2440 /**********************************************************************
2441  * pltcl_SPI_lastoid()  - return the last oid. To
2442  *                be used after insert queries
2443  **********************************************************************/
2444 static int
2445 pltcl_SPI_lastoid(ClientData cdata, Tcl_Interp *interp,
2446                                   int argc, CONST84 char *argv[])
2447 {
2448         char            buf[64];
2449
2450         snprintf(buf, sizeof(buf), "%u", SPI_lastoid);
2451         Tcl_SetResult(interp, buf, TCL_VOLATILE);
2452         return TCL_OK;
2453 }
2454
2455
2456 /**********************************************************************
2457  * pltcl_set_tuple_values() - Set variables for all attributes
2458  *                                of a given tuple
2459  **********************************************************************/
2460 static void
2461 pltcl_set_tuple_values(Tcl_Interp *interp, CONST84 char *arrayname,
2462                                            int tupno, HeapTuple tuple, TupleDesc tupdesc)
2463 {
2464         int                     i;
2465         char       *outputstr;
2466         char            buf[64];
2467         Datum           attr;
2468         bool            isnull;
2469
2470         CONST84 char *attname;
2471         HeapTuple       typeTup;
2472         Oid                     typoutput;
2473
2474         CONST84 char **arrptr;
2475         CONST84 char **nameptr;
2476         CONST84 char *nullname = NULL;
2477
2478         /************************************************************
2479          * Prepare pointers for Tcl_SetVar2() below and in array
2480          * mode set the .tupno element
2481          ************************************************************/
2482         if (arrayname == NULL)
2483         {
2484                 arrptr = &attname;
2485                 nameptr = &nullname;
2486         }
2487         else
2488         {
2489                 arrptr = &arrayname;
2490                 nameptr = &attname;
2491                 snprintf(buf, sizeof(buf), "%d", tupno);
2492                 Tcl_SetVar2(interp, arrayname, ".tupno", buf, 0);
2493         }
2494
2495         for (i = 0; i < tupdesc->natts; i++)
2496         {
2497                 /* ignore dropped attributes */
2498                 if (tupdesc->attrs[i]->attisdropped)
2499                         continue;
2500
2501                 /************************************************************
2502                  * Get the attribute name
2503                  ************************************************************/
2504                 attname = NameStr(tupdesc->attrs[i]->attname);
2505
2506                 /************************************************************
2507                  * Get the attributes value
2508                  ************************************************************/
2509                 attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
2510
2511                 /************************************************************
2512                  * Lookup the attribute type in the syscache
2513                  * for the output function
2514                  ************************************************************/
2515                 typeTup = SearchSysCache1(TYPEOID,
2516                                                           ObjectIdGetDatum(tupdesc->attrs[i]->atttypid));
2517                 if (!HeapTupleIsValid(typeTup))
2518                         elog(ERROR, "cache lookup failed for type %u",
2519                                  tupdesc->attrs[i]->atttypid);
2520
2521                 typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
2522                 ReleaseSysCache(typeTup);
2523
2524                 /************************************************************
2525                  * If there is a value, set the variable
2526                  * If not, unset it
2527                  *
2528                  * Hmmm - Null attributes will cause functions to
2529                  *                crash if they don't expect them - need something
2530                  *                smarter here.
2531                  ************************************************************/
2532                 if (!isnull && OidIsValid(typoutput))
2533                 {
2534                         outputstr = OidOutputFunctionCall(typoutput, attr);
2535                         UTF_BEGIN;
2536                         Tcl_SetVar2(interp, *arrptr, *nameptr, UTF_E2U(outputstr), 0);
2537                         UTF_END;
2538                         pfree(outputstr);
2539                 }
2540                 else
2541                         Tcl_UnsetVar2(interp, *arrptr, *nameptr, 0);
2542         }
2543 }
2544
2545
2546 /**********************************************************************
2547  * pltcl_build_tuple_argument() - Build a string usable for 'array set'
2548  *                                from all attributes of a given tuple
2549  **********************************************************************/
2550 static void
2551 pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
2552                                                    Tcl_DString *retval)
2553 {
2554         int                     i;
2555         char       *outputstr;
2556         Datum           attr;
2557         bool            isnull;
2558
2559         char       *attname;
2560         HeapTuple       typeTup;
2561         Oid                     typoutput;
2562
2563         for (i = 0; i < tupdesc->natts; i++)
2564         {
2565                 /* ignore dropped attributes */
2566                 if (tupdesc->attrs[i]->attisdropped)
2567                         continue;
2568
2569                 /************************************************************
2570                  * Get the attribute name
2571                  ************************************************************/
2572                 attname = NameStr(tupdesc->attrs[i]->attname);
2573
2574                 /************************************************************
2575                  * Get the attributes value
2576                  ************************************************************/
2577                 attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
2578
2579                 /************************************************************
2580                  * Lookup the attribute type in the syscache
2581                  * for the output function
2582                  ************************************************************/
2583                 typeTup = SearchSysCache1(TYPEOID,
2584                                                           ObjectIdGetDatum(tupdesc->attrs[i]->atttypid));
2585                 if (!HeapTupleIsValid(typeTup))
2586                         elog(ERROR, "cache lookup failed for type %u",
2587                                  tupdesc->attrs[i]->atttypid);
2588
2589                 typoutput = ((Form_pg_type) GETSTRUCT(typeTup))->typoutput;
2590                 ReleaseSysCache(typeTup);
2591
2592                 /************************************************************
2593                  * If there is a value, append the attribute name and the
2594                  * value to the list
2595                  *
2596                  * Hmmm - Null attributes will cause functions to
2597                  *                crash if they don't expect them - need something
2598                  *                smarter here.
2599                  ************************************************************/
2600                 if (!isnull && OidIsValid(typoutput))
2601                 {
2602                         outputstr = OidOutputFunctionCall(typoutput, attr);
2603                         Tcl_DStringAppendElement(retval, attname);
2604                         UTF_BEGIN;
2605                         Tcl_DStringAppendElement(retval, UTF_E2U(outputstr));
2606                         UTF_END;
2607                         pfree(outputstr);
2608                 }
2609         }
2610 }