On Sun, Aug 7, 2011 at 17:06, Tim Bunce <tim.bu...@pobox.com> wrote:
> On Sat, Aug 06, 2011 at 12:37:28PM -0600, Alex Hunsaker wrote:
>> ...
>> Find attached a version that does the equivalent of local %SIG for
>> each pl/perl(u) call.
>
>> + gv = gv_fetchpv("SIG", 0, SVt_PVHV);
>> + save_hash(gv); /* local %SIG */
>
> ... [ local %SIG dosn't work ] The %SIG does become empty but the OS
> level handlers, even those installed by perl, *aren't changed*:
Looks like I trusted in $SIG{'ALRM'} being undef after it had been set
in a different scope too much :-( Thanks for pointing this out.
> That sure seems like a bug (I'll check with the perl5-porters list).
Well even if it was deemed a bug, it dont do us any good.
> Localizing an individual element of %SIG works fine.
> In C that's something like this (untested):
>
> hv = gv_fetchpv("SIG", 0, SVt_PVHV);
> keysv = ...SV containing "ALRM"...
> he = hv_fetch_ent(hv, keysv, 0, 0);
> if (he) { /* arrange to restore existing elem */
> save_helem_flags(hv, keysv, &HeVAL(he), SAVEf_SETMAGIC);
> }
> else { /* arrange to delete a new elem */
> SAVEHDELETE(hv, keysv);
> }
I played with this a bit... and found yes, it locals them but no it
does not fix the reported problem. After playing with things a bit
more I found even "local $SIG{'ALRM'} = .,..; alarm(1);" still results
in postgres crashing. To wit, local does squat. AFAICT it just resets
the signal handler back to the default with SIG_DFL. (Which in
hindsight I don't know what else I expected it to-do...)
So I think for this to be robust we would have to detect what signals
they set and then reset those back to what postgres wants. Doable, but
is it worth it? Anyone else have any bright ideas?
Find below my test case and attached a patch that locals individual
%SIG elements the way mentioned above.
=> set statement_timeout to '5s';
SET
=> create or replace function test_alarm() returns void as $$ local
$SIG{'ALRM'} = sub { warn "alarm"; }; alarm(1); sleep 2; $$ language
plperlu;
CREATE FUNCTION
=> select test_alarm();
WARNING: alarm at line 1.
CONTEXT: PL/Perl function "test_alarm"
test_alarm
------------
(1 row)
=> select pg_sleep(6);
server closed the connection unexpectedly
This probably means the server terminated abnormally
before or while processing the request.
The connection to the server was lost. Attempting reset: Failed.
Server Log:
WARNING: alarm at line 1.
CONTEXT: PL/Perl function "test_alarm"
LOG: server process (PID 32659) was terminated by signal 14: Alarm clock
LOG: terminating any other active server processes
WARNING: terminating connection because of crash of another server process
DETAIL: The postmaster has commanded this server process to roll back
the current transaction and exit, because another server process
exited abnormally and possibly corrupted shared memory.
HINT: In a moment you should be able to reconnect to the database and
repeat your command.
FATAL: the database system is in recovery mode
*** 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;
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
