diff options
| -rw-r--r-- | src/pl/plperl/plperl.c | 237 |
1 files changed, 122 insertions, 115 deletions
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 2cd761496d..87113f0fb1 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -98,17 +98,19 @@ typedef struct plperl_interp_desc /********************************************************************** * The information we cache about loaded procedures * - * The refcount field counts the struct's reference from the hash table shown - * below, plus one reference for each function call level that is using the - * struct. We can release the struct, and the associated Perl sub, when the - * refcount goes to zero. + * The fn_refcount field counts the struct's reference from the hash table + * shown below, plus one reference for each function call level that is using + * the struct. We can release the struct, and the associated Perl sub, when + * the fn_refcount goes to zero. Releasing the struct itself is done by + * deleting the fn_cxt, which also gets rid of all subsidiary data. **********************************************************************/ typedef struct plperl_proc_desc { char *proname; /* user name of procedure */ + MemoryContext fn_cxt; /* memory context for this procedure */ + unsigned long fn_refcount; /* number of active references */ TransactionId fn_xmin; /* xmin/TID of procedure's pg_proc tuple */ ItemPointerData fn_tid; - int refcount; /* reference count of this struct */ SV *reference; /* CODE reference for Perl sub */ plperl_interp_desc *interp; /* interpreter it's created in */ bool fn_readonly; /* is function readonly (not volatile)? */ @@ -122,18 +124,19 @@ typedef struct plperl_proc_desc Oid result_oid; /* Oid of result type */ FmgrInfo result_in_func; /* I/O function and arg for result type */ Oid result_typioparam; - /* Conversion info for function's argument types: */ + /* Per-argument info for function's argument types: */ int nargs; - FmgrInfo arg_out_func[FUNC_MAX_ARGS]; - bool arg_is_rowtype[FUNC_MAX_ARGS]; - Oid arg_arraytype[FUNC_MAX_ARGS]; /* InvalidOid if not an array */ + FmgrInfo *arg_out_func; /* output fns for arg types */ + bool *arg_is_rowtype; /* is each arg composite? */ + Oid *arg_arraytype; /* InvalidOid if not an array */ } plperl_proc_desc; #define increment_prodesc_refcount(prodesc) \ - ((prodesc)->refcount++) + ((prodesc)->fn_refcount++) #define decrement_prodesc_refcount(prodesc) \ do { \ - if (--((prodesc)->refcount) <= 0) \ + Assert((prodesc)->fn_refcount > 0); \ + if (--((prodesc)->fn_refcount) == 0) \ free_plperl_function(prodesc); \ } while(0) @@ -353,23 +356,6 @@ hek2cstr(HE *he) return ret; } -/* - * This routine is a crock, and so is everyplace that calls it. The problem - * is that the cached form of plperl functions/queries is allocated permanently - * (mostly via malloc()) and never released until backend exit. Subsidiary - * data structures such as fmgr info records therefore must live forever - * as well. A better implementation would store all this stuff in a per- - * function memory context that could be reclaimed at need. In the meantime, - * fmgr_info_cxt must be called specifying TopMemoryContext so that whatever - * it might allocate, and whatever the eventual function might allocate using - * fn_mcxt, will live forever too. - */ -static void -perm_fmgr_info(Oid functionId, FmgrInfo *finfo) -{ - fmgr_info_cxt(functionId, finfo, TopMemoryContext); -} - /* * _PG_init() - library load-time initialization @@ -1433,6 +1419,10 @@ plperl_ref_from_pg_array(Datum arg, Oid typid) SV *av; HV *hv; + /* + * Currently we make no effort to cache any of the stuff we look up here, + * which is bad. + */ info = palloc0(sizeof(plperl_array_info)); /* get element type information, including output conversion function */ @@ -1440,10 +1430,16 @@ plperl_ref_from_pg_array(Datum arg, Oid typid) &typlen, &typbyval, &typalign, &typdelim, &typioparam, &typoutputfunc); - if ((transform_funcid = get_transform_fromsql(elementtype, current_call_data->prodesc->lang_oid, current_call_data->prodesc->trftypes))) - perm_fmgr_info(transform_funcid, &info->transform_proc); + /* Check for a transform function */ + transform_funcid = get_transform_fromsql(elementtype, + current_call_data->prodesc->lang_oid, + current_call_data->prodesc->trftypes); + + /* Look up transform or output function as appropriate */ + if (OidIsValid(transform_funcid)) + fmgr_info(transform_funcid, &info->transform_proc); else - perm_fmgr_info(typoutputfunc, &info->proc); + fmgr_info(typoutputfunc, &info->proc); info->elem_is_rowtype = type_is_rowtype(elementtype); @@ -1791,18 +1787,18 @@ plperl_call_handler(PG_FUNCTION_ARGS) } PG_CATCH(); { - if (this_call_data.prodesc) - decrement_prodesc_refcount(this_call_data.prodesc); current_call_data = save_call_data; activate_interpreter(oldinterp); + if (this_call_data.prodesc) + decrement_prodesc_refcount(this_call_data.prodesc); PG_RE_THROW(); } PG_END_TRY(); - if (this_call_data.prodesc) - decrement_prodesc_refcount(this_call_data.prodesc); current_call_data = save_call_data; activate_interpreter(oldinterp); + if (this_call_data.prodesc) + decrement_prodesc_refcount(this_call_data.prodesc); return retval; } @@ -2616,7 +2612,7 @@ validate_plperl_function(plperl_proc_ptr *proc_ptr, HeapTuple procTup) static void free_plperl_function(plperl_proc_desc *prodesc) { - Assert(prodesc->refcount <= 0); + Assert(prodesc->fn_refcount == 0); /* Release CODE reference, if we have one, from the appropriate interp */ if (prodesc->reference) { @@ -2626,12 +2622,8 @@ free_plperl_function(plperl_proc_desc *prodesc) SvREFCNT_dec(prodesc->reference); activate_interpreter(oldinterp); } - /* Get rid of what we conveniently can of our own structs */ - /* (FmgrInfo subsidiary info will get leaked ...) */ - if (prodesc->proname) - free(prodesc->proname); - list_free(prodesc->trftypes); - free(prodesc); + /* Release all PG-owned data for this proc */ + MemoryContextDelete(prodesc->fn_cxt); } @@ -2642,8 +2634,8 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger) Form_pg_proc procStruct; plperl_proc_key proc_key; plperl_proc_ptr *proc_ptr; - plperl_proc_desc *prodesc = NULL; - int i; + plperl_proc_desc *volatile prodesc = NULL; + volatile MemoryContext proc_cxt = NULL; plperl_interp_desc *oldinterp = plperl_active_interp; ErrorContextCallback plperl_error_context; @@ -2653,41 +2645,50 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger) elog(ERROR, "cache lookup failed for function %u", fn_oid); procStruct = (Form_pg_proc) GETSTRUCT(procTup); - /* Set a callback for reporting compilation errors */ - plperl_error_context.callback = plperl_compile_callback; - plperl_error_context.previous = error_context_stack; - plperl_error_context.arg = NameStr(procStruct->proname); - error_context_stack = &plperl_error_context; - - /* Try to find function in plperl_proc_hash */ + /* + * Try to find function in plperl_proc_hash. The reason for this + * overcomplicated-seeming lookup procedure is that we don't know whether + * it's plperl or plperlu, and don't want to spend a lookup in pg_language + * to find out. + */ proc_key.proc_id = fn_oid; proc_key.is_trigger = is_trigger; proc_key.user_id = GetUserId(); - proc_ptr = hash_search(plperl_proc_hash, &proc_key, HASH_FIND, NULL); + if (validate_plperl_function(proc_ptr, procTup)) + { + /* Found valid plperl entry */ + ReleaseSysCache(procTup); + return proc_ptr->proc_ptr; + } + /* If not found or obsolete, maybe it's plperlu */ + proc_key.user_id = InvalidOid; + proc_ptr = hash_search(plperl_proc_hash, &proc_key, + HASH_FIND, NULL); if (validate_plperl_function(proc_ptr, procTup)) - prodesc = proc_ptr->proc_ptr; - else { - /* If not found or obsolete, maybe it's plperlu */ - proc_key.user_id = InvalidOid; - proc_ptr = hash_search(plperl_proc_hash, &proc_key, - HASH_FIND, NULL); - if (validate_plperl_function(proc_ptr, procTup)) - prodesc = proc_ptr->proc_ptr; + /* Found valid plperlu entry */ + ReleaseSysCache(procTup); + return proc_ptr->proc_ptr; } /************************************************************ * If we haven't found it in the hashtable, we analyze * the function's arguments and return type and store - * the in-/out-functions in the prodesc block and create - * a new hashtable entry for it. - * - * Then we load the procedure into the Perl interpreter. + * the in-/out-functions in the prodesc block, + * then we load the procedure into the Perl interpreter, + * and last we create a new hashtable entry for it. ************************************************************/ - if (prodesc == NULL) + + /* Set a callback for reporting compilation errors */ + plperl_error_context.callback = plperl_compile_callback; + plperl_error_context.previous = error_context_stack; + plperl_error_context.arg = NameStr(procStruct->proname); + error_context_stack = &plperl_error_context; + + PG_TRY(); { HeapTuple langTup; HeapTuple typeTup; @@ -2697,42 +2698,42 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger) Datum prosrcdatum; bool isnull; char *proc_source; + MemoryContext oldcontext; /************************************************************ - * Allocate a new procedure description block + * Allocate a context that will hold all PG data for the procedure. ************************************************************/ - prodesc = (plperl_proc_desc *) malloc(sizeof(plperl_proc_desc)); - if (prodesc == NULL) - ereport(ERROR, - (errcode(ERRCODE_OUT_OF_MEMORY), - errmsg("out of memory"))); - /* Initialize all fields to 0 so free_plperl_function is safe */ - MemSet(prodesc, 0, sizeof(plperl_proc_desc)); + proc_cxt = AllocSetContextCreate(TopMemoryContext, + NameStr(procStruct->proname), + ALLOCSET_SMALL_SIZES); - prodesc->proname = strdup(NameStr(procStruct->proname)); - if (prodesc->proname == NULL) - { - free_plperl_function(prodesc); - ereport(ERROR, - (errcode(ERRCODE_OUT_OF_MEMORY), - errmsg("out of memory"))); - } + /************************************************************ + * Allocate and fill a new procedure description block. + * struct prodesc and subsidiary data must all live in proc_cxt. + ************************************************************/ + oldcontext = MemoryContextSwitchTo(proc_cxt); + prodesc = (plperl_proc_desc *) palloc0(sizeof(plperl_proc_desc)); + prodesc->proname = pstrdup(NameStr(procStruct->proname)); + prodesc->fn_cxt = proc_cxt; + prodesc->fn_refcount = 0; prodesc->fn_xmin = HeapTupleHeaderGetRawXmin(procTup->t_data); prodesc->fn_tid = procTup->t_self; + prodesc->nargs = procStruct->pronargs; + prodesc->arg_out_func = (FmgrInfo *) palloc0(prodesc->nargs * sizeof(FmgrInfo)); + prodesc->arg_is_rowtype = (bool *) palloc0(prodesc->nargs * sizeof(bool)); + prodesc->arg_arraytype = (Oid *) palloc0(prodesc->nargs * sizeof(Oid)); + MemoryContextSwitchTo(oldcontext); /* Remember if function is STABLE/IMMUTABLE */ prodesc->fn_readonly = (procStruct->provolatile != PROVOLATILE_VOLATILE); - { - MemoryContext oldcxt; - - protrftypes_datum = SysCacheGetAttr(PROCOID, procTup, + /* Fetch protrftypes */ + protrftypes_datum = SysCacheGetAttr(PROCOID, procTup, Anum_pg_proc_protrftypes, &isnull); - oldcxt = MemoryContextSwitchTo(TopMemoryContext); - prodesc->trftypes = isnull ? NIL : oid_array_to_list(protrftypes_datum); - MemoryContextSwitchTo(oldcxt); - } + MemoryContextSwitchTo(proc_cxt); + prodesc->trftypes = isnull ? NIL : oid_array_to_list(protrftypes_datum); + MemoryContextSwitchTo(oldcontext); /************************************************************ * Lookup the pg_language tuple by Oid @@ -2740,11 +2741,8 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger) langTup = SearchSysCache1(LANGOID, ObjectIdGetDatum(procStruct->prolang)); if (!HeapTupleIsValid(langTup)) - { - free_plperl_function(prodesc); elog(ERROR, "cache lookup failed for language %u", procStruct->prolang); - } langStruct = (Form_pg_language) GETSTRUCT(langTup); prodesc->lang_oid = HeapTupleGetOid(langTup); prodesc->lanpltrusted = langStruct->lanpltrusted; @@ -2760,11 +2758,8 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger) SearchSysCache1(TYPEOID, ObjectIdGetDatum(procStruct->prorettype)); if (!HeapTupleIsValid(typeTup)) - { - free_plperl_function(prodesc); elog(ERROR, "cache lookup failed for type %u", procStruct->prorettype); - } typeStruct = (Form_pg_type) GETSTRUCT(typeTup); /* Disallow pseudotype result, except VOID or RECORD */ @@ -2775,21 +2770,15 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger) /* okay */ ; else if (procStruct->prorettype == TRIGGEROID || procStruct->prorettype == EVTTRIGGEROID) - { - free_plperl_function(prodesc); ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("trigger functions can only be called " "as triggers"))); - } else - { - free_plperl_function(prodesc); ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("PL/Perl functions cannot return type %s", format_type_be(procStruct->prorettype)))); - } } prodesc->result_oid = procStruct->prorettype; @@ -2800,7 +2789,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger) prodesc->fn_retisarray = (typeStruct->typlen == -1 && typeStruct->typelem); - perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func)); + fmgr_info_cxt(typeStruct->typinput, + &(prodesc->result_in_func), + proc_cxt); prodesc->result_typioparam = getTypeIOParam(typeTup); ReleaseSysCache(typeTup); @@ -2812,29 +2803,24 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger) ************************************************************/ if (!is_trigger && !is_event_trigger) { - prodesc->nargs = procStruct->pronargs; + int i; + for (i = 0; i < prodesc->nargs; i++) { typeTup = SearchSysCache1(TYPEOID, ObjectIdGetDatum(procStruct->proargtypes.values[i])); if (!HeapTupleIsValid(typeTup)) - { - free_plperl_function(prodesc); elog(ERROR, "cache lookup failed for type %u", procStruct->proargtypes.values[i]); - } typeStruct = (Form_pg_type) GETSTRUCT(typeTup); /* Disallow pseudotype argument */ if (typeStruct->typtype == TYPTYPE_PSEUDO && procStruct->proargtypes.values[i] != RECORDOID) - { - free_plperl_function(prodesc); ereport(ERROR, (errcode(ERRCODE_FEATURE_NOT_SUPPORTED), errmsg("PL/Perl functions cannot accept type %s", format_type_be(procStruct->proargtypes.values[i])))); - } if (typeStruct->typtype == TYPTYPE_COMPOSITE || procStruct->proargtypes.values[i] == RECORDOID) @@ -2842,8 +2828,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger) else { prodesc->arg_is_rowtype[i] = false; - perm_fmgr_info(typeStruct->typoutput, - &(prodesc->arg_out_func[i])); + fmgr_info_cxt(typeStruct->typoutput, + &(prodesc->arg_out_func[i]), + proc_cxt); } /* Identify array attributes */ @@ -2880,22 +2867,42 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger) activate_interpreter(oldinterp); pfree(proc_source); + if (!prodesc->reference) /* can this happen? */ - { - free_plperl_function(prodesc); elog(ERROR, "could not create PL/Perl internal procedure"); - } /************************************************************ - * OK, link the procedure into the correct hashtable entry + * OK, link the procedure into the correct hashtable entry. + * Note we assume that the hashtable entry either doesn't exist yet, + * or we already cleared its proc_ptr during the validation attempts + * above. So no need to decrement an old refcount here. ************************************************************/ proc_key.user_id = prodesc->lanpltrusted ? GetUserId() : InvalidOid; proc_ptr = hash_search(plperl_proc_hash, &proc_key, HASH_ENTER, NULL); + /* We assume these two steps can't throw an error: */ proc_ptr->proc_ptr = prodesc; increment_prodesc_refcount(prodesc); } + PG_CATCH(); + { + /* + * If we got as far as creating a reference, we should be able to use + * free_plperl_function() to clean up. If not, then at most we have + * some PG memory resources in proc_cxt, which we can just delete. + */ + if (prodesc && prodesc->reference) + free_plperl_function(prodesc); + else if (proc_cxt) + MemoryContextDelete(proc_cxt); + + /* Be sure to restore the previous interpreter, too, for luck */ + activate_interpreter(oldinterp); + + PG_RE_THROW(); + } + PG_END_TRY(); /* restore previous error callback */ error_context_stack = plperl_error_context.previous; |