plperl_local_sig_v2.patch

*** a/src/pl/plperl/expected/plperl.out
--- b/src/pl/plperl/expected/plperl.out
***************
*** 639,641 **** CONTEXT:  PL/Perl anonymous code block
--- 639,643 ----
  DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl;
  ERROR:  Useless use of sort in scalar context at line 1.
  CONTEXT:  PL/Perl anonymous code block
+ DO $do$ die "SIG ALRM is set: $SIG{'ALRM'}" if($SIG{'ALRM'}); $SIG{'ALRM'} = sub { print "alarm!\n"}; $do$ LANGUAGE plperl;
+ DO $do$ die "SIG ALRM is set: $SIG{'ALRM'}" if($SIG{'ALRM'}); $do$ LANGUAGE plperl;
*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
***************
*** 268,273 **** static void plperl_inline_callback(void *arg);
--- 268,275 ----
  static char *strip_trailing_ws(const char *msg);
  static OP  *pp_require_safe(pTHX);
  static void activate_interpreter(plperl_interp_desc *interp_desc);
+ static void local_sigs(void);
+ static void local_sig(HV *hv, SV *tmpsv, const char *signame);
  
  #ifdef WIN32
  static char *setlocale_perl(int category, char *locale);
***************
*** 1901,1906 **** plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
--- 1903,1910 ----
  	ENTER;
  	SAVETMPS;
  
+ 	local_sigs();
+ 
  	PUSHMARK(SP);
  	EXTEND(sp, desc->nargs);
  
***************
*** 1968,1973 **** plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
--- 1972,2028 ----
  	return retval;
  }
  
+ /*
+  * local all of our sig handlers some modules like LWP like to set an alarm sig
+  * handler for things like network timeouts, this can cause bad stuff to happen
+  * (not to mention what happens if someone sets USR1)
+  *
+  * for now we just local() them all so they should get reset back to what
+  * postgres expects when their pl function is done
+  */
+ static void
+ local_sigs(void)
+ {
+ 	HV	*hv;
+ 	SV	*sv = newSV(9);
+ 	int i;
+ 
+ 	hv = get_hv("SIG", 0);
+ 	if (!hv)
+ 		elog(ERROR, "couldn't fetch %%SIG");
+ 
+ 	/*
+ 	 * char *PL_sig_name[] has the signal name in %SIG indexed by the signal
+ 	 * number
+ 	 */
+ 	for ( i= 1; i < SIG_SIZE; i++)
+ 		local_sig(hv, sv, PL_sig_name[i]);
+ 
+ 	/*
+ 	 * Note, __DIE__ and __WARN__ are not handled by the above and you can't
+ 	 * really do the same thing with them you would need to save PL_diehook and
+ 	 * pl_warnhook somewhere. err well I think you can but then it breaks our
+ 	 * default warn and die handlers set in plc_perlboot.pl
+ 	 */
+ }
+ 
+ /*
+  * local an individual sig, helper for local_sigs
+  */
+ static void
+ local_sig(HV *hv, SV *tmpsv, const char *signame)
+ {
+ 	HE *he;
+ 	sv_setpvn(tmpsv, signame, strlen(signame));
+ 
+ 	he = hv_fetch_ent(hv, tmpsv, 0, 0);
+ 	if (he)
+ 		/* arrange to restore existing elem */
+ 		save_helem_flags(hv, tmpsv, &HeVAL(he), SAVEf_SETMAGIC);
+ 	else
+ 		/* arrange to delete new elem */
+ 		SAVEHDELETE(hv, tmpsv);
+ }
  
  static SV  *
  plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
***************
*** 1986,1995 **** plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
  	TDsv = get_sv("_TD", 0);
  	if (!TDsv)
  		elog(ERROR, "couldn't fetch $_TD");
- 
  	save_item(TDsv);			/* local $_TD */
  	sv_setsv(TDsv, td);
  
  	PUSHMARK(sp);
  	EXTEND(sp, tg_trigger->tgnargs);
  
--- 2041,2051 ----
  	TDsv = get_sv("_TD", 0);
  	if (!TDsv)
  		elog(ERROR, "couldn't fetch $_TD");
  	save_item(TDsv);			/* local $_TD */
  	sv_setsv(TDsv, td);
  
+ 	local_sigs();
+ 
  	PUSHMARK(sp);
  	EXTEND(sp, tg_trigger->tgnargs);
  
*** a/src/pl/plperl/sql/plperl.sql
--- b/src/pl/plperl/sql/plperl.sql
***************
*** 415,417 **** DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl;
--- 415,420 ----
  -- check that we can "use warnings" (in this case to turn a warn into an error)
  -- yields "ERROR:  Useless use of sort in scalar context."
  DO $do$ use warnings FATAL => qw(void) ; my @y; my $x = sort @y; 1; $do$ LANGUAGE plperl;
+ 
+ DO $do$ die "SIG ALRM is set: $SIG{'ALRM'}" if($SIG{'ALRM'}); $SIG{'ALRM'} = sub { print "alarm!\n"}; $do$ LANGUAGE plperl;
+ DO $do$ die "SIG ALRM is set: $SIG{'ALRM'}" if($SIG{'ALRM'}); $do$ LANGUAGE plperl;