From fc3b083b752d31975bf8530c09497a89dd3d9a35 Mon Sep 17 00:00:00 2001
From: Nathan Bossart <nathandbossart@gmail.com>
Date: Tue, 22 Feb 2022 15:26:35 -0800
Subject: [PATCH v1 1/3] Do not use pg_language to determine whether PL/Perl is
 trusted.

Presently, PL/Perl and PL/PerlU use the same handler and validator
functions, and we determine whether to use the trusted or untrusted
code paths by inspecting the language's pg_language tuple.  This
can lead to unexpected behavior (e.g., using the untrusted code
paths despite specifying the trusted handler/validator functions),
and it complicates building the trusted and untrusted versions of
the language separately, which we intend to support in a follow-up
change.

This change creates separate handler/validator functions for the
trusted and untrusted versions of PL/Perl so that we no longer need
to inspect pg_language to determine which code path to take.  Since
this makes it easier to tell whether we are using trusted or
untrusted PL/Perl, this change has the added benefit of simplifying
function lookup in plperl_proc_hash.
---
 src/pl/plperl/expected/plperl.out |   8 ++
 src/pl/plperl/plperl.c            | 117 ++++++++++++++++--------------
 src/pl/plperl/sql/plperl.sql      |   7 ++
 3 files changed, 76 insertions(+), 56 deletions(-)

diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out
index d8a1ff5dd8..f92848602b 100644
--- a/src/pl/plperl/expected/plperl.out
+++ b/src/pl/plperl/expected/plperl.out
@@ -792,3 +792,11 @@ SELECT self_modify(42);
          126
 (1 row)
 
+-- make sure lanpltrusted is ignored
+CREATE OR REPLACE LANGUAGE mylang
+	HANDLER plperl_call_handler
+	INLINE plperl_inline_handler
+	VALIDATOR plperl_validator;
+CREATE OR REPLACE FUNCTION myfunc(TEXT) RETURNS TEXT LANGUAGE mylang AS $$ return `$_[0]`; $$;
+ERROR:  'quoted execution (``, qx)' trapped by operation mask at line 1.
+CONTEXT:  compilation of PL/Perl function "myfunc"
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index edb93ec1c4..9bc6793a30 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -252,15 +252,20 @@ static void plperl_destroy_interp(PerlInterpreter **);
 static void plperl_fini(int code, Datum arg);
 static void set_interp_require(bool trusted);
 
-static Datum plperl_func_handler(PG_FUNCTION_ARGS);
-static Datum plperl_trigger_handler(PG_FUNCTION_ARGS);
-static void plperl_event_trigger_handler(PG_FUNCTION_ARGS);
+static Datum plperl_call_handler_internal(PG_FUNCTION_ARGS, bool trusted);
+static Datum plperl_inline_handler_internal(PG_FUNCTION_ARGS, bool trusted);
+static Datum plperl_validator_internal(PG_FUNCTION_ARGS, bool trusted);
+
+static Datum plperl_func_handler(PG_FUNCTION_ARGS, bool trusted);
+static Datum plperl_trigger_handler(PG_FUNCTION_ARGS, bool trusted);
+static void plperl_event_trigger_handler(PG_FUNCTION_ARGS, bool trusted);
 
 static void free_plperl_function(plperl_proc_desc *prodesc);
 
 static plperl_proc_desc *compile_plperl_function(Oid fn_oid,
 												 bool is_trigger,
-												 bool is_event_trigger);
+												 bool is_event_trigger,
+												 bool trusted);
 
 static SV  *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc, bool include_generated);
 static SV  *plperl_hash_from_datum(Datum attr);
@@ -1824,19 +1829,12 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
 }
 
 
-/*
- * There are three externally visible pieces to plperl: plperl_call_handler,
- * plperl_inline_handler, and plperl_validator.
- */
-
 /*
  * The call handler is called to run normal functions (including trigger
  * functions) that are defined in pg_proc.
  */
-PG_FUNCTION_INFO_V1(plperl_call_handler);
-
 Datum
-plperl_call_handler(PG_FUNCTION_ARGS)
+plperl_call_handler_internal(PG_FUNCTION_ARGS, bool trusted)
 {
 	Datum		retval = (Datum) 0;
 	plperl_call_data *volatile save_call_data = current_call_data;
@@ -1851,14 +1849,14 @@ plperl_call_handler(PG_FUNCTION_ARGS)
 	{
 		current_call_data = &this_call_data;
 		if (CALLED_AS_TRIGGER(fcinfo))
-			retval = PointerGetDatum(plperl_trigger_handler(fcinfo));
+			retval = PointerGetDatum(plperl_trigger_handler(fcinfo, trusted));
 		else if (CALLED_AS_EVENT_TRIGGER(fcinfo))
 		{
-			plperl_event_trigger_handler(fcinfo);
+			plperl_event_trigger_handler(fcinfo, trusted);
 			retval = (Datum) 0;
 		}
 		else
-			retval = plperl_func_handler(fcinfo);
+			retval = plperl_func_handler(fcinfo, trusted);
 	}
 	PG_FINALLY();
 	{
@@ -1875,10 +1873,8 @@ plperl_call_handler(PG_FUNCTION_ARGS)
 /*
  * The inline handler runs anonymous code blocks (DO blocks).
  */
-PG_FUNCTION_INFO_V1(plperl_inline_handler);
-
 Datum
-plperl_inline_handler(PG_FUNCTION_ARGS)
+plperl_inline_handler_internal(PG_FUNCTION_ARGS, bool trusted)
 {
 	LOCAL_FCINFO(fake_fcinfo, 0);
 	InlineCodeBlock *codeblock = (InlineCodeBlock *) PG_GETARG_POINTER(0);
@@ -1915,7 +1911,7 @@ plperl_inline_handler(PG_FUNCTION_ARGS)
 
 	desc.lang_oid = codeblock->langOid;
 	desc.trftypes = NIL;
-	desc.lanpltrusted = codeblock->langIsTrusted;
+	desc.lanpltrusted = trusted;
 
 	desc.fn_retistuple = false;
 	desc.fn_retisset = false;
@@ -1970,10 +1966,8 @@ plperl_inline_handler(PG_FUNCTION_ARGS)
  * being created/replaced. The precise behavior of the validator may be
  * modified by the check_function_bodies GUC.
  */
-PG_FUNCTION_INFO_V1(plperl_validator);
-
 Datum
-plperl_validator(PG_FUNCTION_ARGS)
+plperl_validator_internal(PG_FUNCTION_ARGS, bool trusted)
 {
 	Oid			funcoid = PG_GETARG_OID(0);
 	HeapTuple	tuple;
@@ -2032,7 +2026,8 @@ plperl_validator(PG_FUNCTION_ARGS)
 	/* Postpone body checks if !check_function_bodies */
 	if (check_function_bodies)
 	{
-		(void) compile_plperl_function(funcoid, is_trigger, is_event_trigger);
+		(void) compile_plperl_function(funcoid, is_trigger, is_event_trigger,
+									   trusted);
 	}
 
 	/* the result of a validator is ignored */
@@ -2040,12 +2035,39 @@ plperl_validator(PG_FUNCTION_ARGS)
 }
 
 
+/*
+ * There are three externally visible pieces to plperl: plperl_call_handler,
+ * plperl_inline_handler, and plperl_validator.
+ */
+
+PG_FUNCTION_INFO_V1(plperl_call_handler);
+
+Datum
+plperl_call_handler(PG_FUNCTION_ARGS)
+{
+	return plperl_call_handler_internal(fcinfo, true);
+}
+
+PG_FUNCTION_INFO_V1(plperl_inline_handler);
+
+Datum
+plperl_inline_handler(PG_FUNCTION_ARGS)
+{
+	return plperl_inline_handler_internal(fcinfo, true);
+}
+
+PG_FUNCTION_INFO_V1(plperl_validator);
+
+Datum
+plperl_validator(PG_FUNCTION_ARGS)
+{
+	return plperl_validator_internal(fcinfo, true);
+}
+
+
 /*
  * plperlu likewise requires three externally visible functions:
  * plperlu_call_handler, plperlu_inline_handler, and plperlu_validator.
- * These are currently just aliases that send control to the plperl
- * handler functions, and we decide whether a particular function is
- * trusted or not by inspecting the actual pg_language tuple.
  */
 
 PG_FUNCTION_INFO_V1(plperlu_call_handler);
@@ -2053,7 +2075,7 @@ PG_FUNCTION_INFO_V1(plperlu_call_handler);
 Datum
 plperlu_call_handler(PG_FUNCTION_ARGS)
 {
-	return plperl_call_handler(fcinfo);
+	return plperl_call_handler_internal(fcinfo, false);
 }
 
 PG_FUNCTION_INFO_V1(plperlu_inline_handler);
@@ -2061,7 +2083,7 @@ PG_FUNCTION_INFO_V1(plperlu_inline_handler);
 Datum
 plperlu_inline_handler(PG_FUNCTION_ARGS)
 {
-	return plperl_inline_handler(fcinfo);
+	return plperl_inline_handler_internal(fcinfo, false);
 }
 
 PG_FUNCTION_INFO_V1(plperlu_validator);
@@ -2070,7 +2092,7 @@ Datum
 plperlu_validator(PG_FUNCTION_ARGS)
 {
 	/* call plperl validator with our fcinfo so it gets our oid */
-	return plperl_validator(fcinfo);
+	return plperl_validator_internal(fcinfo, false);
 }
 
 
@@ -2386,7 +2408,7 @@ plperl_call_perl_event_trigger_func(plperl_proc_desc *desc,
 }
 
 static Datum
-plperl_func_handler(PG_FUNCTION_ARGS)
+plperl_func_handler(PG_FUNCTION_ARGS, bool trusted)
 {
 	bool		nonatomic;
 	plperl_proc_desc *prodesc;
@@ -2402,7 +2424,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 	if (SPI_connect_ext(nonatomic ? SPI_OPT_NONATOMIC : 0) != SPI_OK_CONNECT)
 		elog(ERROR, "could not connect to SPI manager");
 
-	prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false, false);
+	prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false, false, trusted);
 	current_call_data->prodesc = prodesc;
 	increment_prodesc_refcount(prodesc);
 
@@ -2505,7 +2527,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 
 
 static Datum
-plperl_trigger_handler(PG_FUNCTION_ARGS)
+plperl_trigger_handler(PG_FUNCTION_ARGS, bool trusted)
 {
 	plperl_proc_desc *prodesc;
 	SV		   *perlret;
@@ -2526,7 +2548,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
 	Assert(rc >= 0);
 
 	/* Find or compile the function */
-	prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, true, false);
+	prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, true, false, trusted);
 	current_call_data->prodesc = prodesc;
 	increment_prodesc_refcount(prodesc);
 
@@ -2618,7 +2640,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
 
 
 static void
-plperl_event_trigger_handler(PG_FUNCTION_ARGS)
+plperl_event_trigger_handler(PG_FUNCTION_ARGS, bool trusted)
 {
 	plperl_proc_desc *prodesc;
 	SV		   *svTD;
@@ -2629,7 +2651,7 @@ plperl_event_trigger_handler(PG_FUNCTION_ARGS)
 		elog(ERROR, "could not connect to SPI manager");
 
 	/* Find or compile the function */
-	prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false, true);
+	prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false, true, trusted);
 	current_call_data->prodesc = prodesc;
 	increment_prodesc_refcount(prodesc);
 
@@ -2702,7 +2724,7 @@ free_plperl_function(plperl_proc_desc *prodesc)
 
 
 static plperl_proc_desc *
-compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
+compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger, bool trusted)
 {
 	HeapTuple	procTup;
 	Form_pg_proc procStruct;
@@ -2719,31 +2741,14 @@ 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);
 
-	/*
-	 * 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.
-	 */
+	/* Try to find function in plperl_proc_hash. */
 	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_key.user_id = trusted ? GetUserId() : InvalidOid;
 	proc_ptr = hash_search(plperl_proc_hash, &proc_key,
 						   HASH_FIND, NULL);
 	if (validate_plperl_function(proc_ptr, procTup))
 	{
-		/* Found valid plperlu entry */
 		ReleaseSysCache(procTup);
 		return proc_ptr->proc_ptr;
 	}
@@ -2797,6 +2802,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 		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));
+		prodesc->lanpltrusted = trusted;
 		MemoryContextSwitchTo(oldcontext);
 
 		/* Remember if function is STABLE/IMMUTABLE */
@@ -2820,7 +2826,6 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 				 procStruct->prolang);
 		langStruct = (Form_pg_language) GETSTRUCT(langTup);
 		prodesc->lang_oid = langStruct->oid;
-		prodesc->lanpltrusted = langStruct->lanpltrusted;
 		ReleaseSysCache(langTup);
 
 		/************************************************************
diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql
index b0d950b230..1e4ced735c 100644
--- a/src/pl/plperl/sql/plperl.sql
+++ b/src/pl/plperl/sql/plperl.sql
@@ -521,3 +521,10 @@ $$ LANGUAGE plperl;
 
 SELECT self_modify(42);
 SELECT self_modify(42);
+
+-- make sure lanpltrusted is ignored
+CREATE OR REPLACE LANGUAGE mylang
+	HANDLER plperl_call_handler
+	INLINE plperl_inline_handler
+	VALIDATOR plperl_validator;
+CREATE OR REPLACE FUNCTION myfunc(TEXT) RETURNS TEXT LANGUAGE mylang AS $$ return `$_[0]`; $$;
-- 
2.25.1

