open-dsi
/
postgres
mirror of https://github.com/postgres/postgres
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Improve memory management for PL/Perl functions.

Browse Source 
Unlike PL/Tcl, PL/Perl at least made an attempt to clean up after itself
when a function gets redefined.  But it was still using TopMemoryContext
for the fn_mcxt of argument/result I/O functions, resulting in the
potential for memory leaks depending on what those functions did, and the
retail alloc/free logic was pretty bulky as well.  Fix things to use a
per-function memory context like the other PLs now do.  Tweak a couple of
places where things were being done in a not-very-safe order (on the
principle that a memory leak is better than leaving global state
inconsistent after an error).  Also make some minor cosmetic adjustments,
mostly in field names, to make the code look similar to the way PL/Tcl does
now wherever it's essentially the same logic.

Michael Paquier and Tom Lane

Discussion: <CAB7nPqSOyAsHC6jL24J1B+oK3p=yyNoFU0Vs_B6fd2kdd5g5WQ@mail.gmail.com>
pull/17/head
Tom Lane 9 years ago
parent d062245b5b
commit 6f7c0ea32f
1 changed files with 122 additions and 115 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 237
      src/pl/plperl/plperl.c

237
src/pl/plperl/plperl.c
Unescape View File

@ -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;

Write Preview
Loading…
Cancel
Save