Perl reports SIGINT handler "IGNORE" not defined in multi-threaded apps #10913
Comments
From jens.schmidt35@arcor.deCreated by jens.schmidt35@arcor.deConsider the following testcase: ---- snip ---- my $th = threads->create( sub { $SIG{INT} = 'IGNORE'; while ( 1 ) { sleep( 10 ) } } ); $SIG{INT} = sub{ print threads->tid(), "\n" }; Run it in the background as "perl test.pl 1>test.out 2>&1 &". bash$ while true; do kill -INT %1; done In my set-up, the generated file test.out contains warnings The same happens for "inter-thread signals" delivered via Perl Info |
From jens.schmidt35@arcor.deStill reproduces in Perl 5.16.2. |
|
jens.schmidt35@arcor.de - Status changed from 'new' to 'open' |
From @tonycozOn Tue Dec 21 03:46:33 2010, jeschmid wrote:
I can reproduce this, and I think I understand why it's happening. Perl only sets operating system signal handlers in the main thread, since signal handlers are part of the process state, so the $SIG{INT} = 'IGNORE' in the child thread only sets $SIG{"INT"} without changing the OS level signal handler or actually ignoring the signal. In the root thread, setting $SIG{INT = "IGNORE" results in setting the signal handler to SIG_DFL, so perl's signal handler isn't call, but that doesn't happen in the child thread. On Linux, signals are preferably delivered to the root thread, so for a slow signal delivery rate, everything works just fine, but if we flood the process with signals they're delivered to the root thread *and* to the child thread, which is where things go wrong. When our flood of signals delivers a signal to the child thread, it loads initializes aTHX (or my_perl) from TLS and then goes on to mark the signal for delivery in the child thread. The attached patch fixes the problem (fairly inefficiently.) We can't just use the main thread to initialize my_perl at the top of the function - if we need to croak, we'll be fiddling with the state of another thread which could lead to corruption of the SV pool. I'll produce a better patch, assuming no-one objects to the general solution. Another problem that comes up with safe signals and fast signal delivery is a signal being delivered while we're running the perl signal handler, producing warnings like: Deep recursion on anonymous subroutine at /home/tony/play/perl-rt-81074/test.pl line 8.
Do you mean $th->kill("INT") ? Tony [1] http://stackoverflow.com/questions/11679568/signal-handling-with-multiple-threads-in-linux#11679770 |
From @tonycoz0001-perl-81074-deliver-OS-signals-to-the-main-thread.patchFrom 71914eb559ff630a565f78111571372fbcd9dc6e Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 25 Nov 2013 15:22:38 +1100
Subject: [perl #81074] deliver OS signals to the main thread
---
mg.c | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/mg.c b/mg.c
index 4a5311c..aab3776 100644
--- a/mg.c
+++ b/mg.c
@@ -1364,6 +1364,8 @@ Perl_csighandler(int sig)
(*PL_sighandlerp)(sig);
#endif
else {
+ dTHXa(PL_curinterp);
+
if (!PL_psig_pend) return;
/* Set a flag to say this signal is pending, that is awaiting delivery after
* the current Perl opcode completes */
@@ -1373,9 +1375,11 @@ Perl_csighandler(int sig)
# define SIG_PENDING_DIE_COUNT 120
#endif
/* Add one to say _a_ signal is pending */
- if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT)
+ if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT) {
+ dTHX;
Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded",
(unsigned long)SIG_PENDING_DIE_COUNT);
+ }
}
}
--
1.7.10.4
|
From @tonycozOn Sun Nov 24 20:27:17 2013, tonyc wrote:
This failed win32/signal.t on Win32 because pseudo-forked processes are just threads, and the signals were no longer being delivered to the correct thread <sigh>. So is it safe to not force delivery to PL_curinterp on Win32? I think it is. Win32 accepts signals through two different mechanisms: a) win32_kill() which delivers non-process-termination[1] signals to pseudo-processes via a message passing mechanism that means that the signal is handled in the thread the signal is targetted to. b) SetConsoleCtrlHandler() delivers an OS level signal as a callback to an operating system created thread - *not* to a perl created thread. The Win32 PERL_GET_SIG_CONTEXT definition ensures that is delivered to PL_curinterp. Tony [1] for process termination it just TerminateProcess()s the target |
From @tonycoz0001-perl-81074-deliver-OS-signals-to-the-main-thread.patchFrom 49be7f4be1d6c259234e250518b7159a935eaedd Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 3 Dec 2013 11:48:23 +1100
Subject: [PATCH] [perl #81074] deliver OS signals to the main thread
---
mg.c | 31 ++++++++++++++++++++++++++++++-
1 files changed, 30 insertions(+), 1 deletions(-)
diff --git a/mg.c b/mg.c
index 4b1deaf..fab5865 100644
--- a/mg.c
+++ b/mg.c
@@ -1384,6 +1384,23 @@ Perl_csighandler(int sig)
(*PL_sighandlerp)(sig);
#endif
else {
+ /* Make sure we deliver signals to the main thread, since we
+ * only set OS signal handlers for the main thread.
+ *
+ * On Win32 signals are sent either by:
+ * a) win32_kill(), which delivers to the main thread or
+ * pseudo-forked processes via message passing that always
+ * delivers the signal to the active thread, or
+ * b) SetConsoleCtrlHandler() which delivers the signal to a
+ * separate (non-perl) thread, Win32's PERL_GET_SIG_CONTEXT
+ * forces that to deliver to the main thread.
+ * So delivering to the thread object above is correct on
+ * Win32.
+ */
+#ifndef WIN32
+ dTHXa(PL_curinterp);
+#endif
+
if (!PL_psig_pend) return;
/* Set a flag to say this signal is pending, that is awaiting delivery after
* the current Perl opcode completes */
@@ -1393,9 +1410,21 @@ Perl_csighandler(int sig)
# define SIG_PENDING_DIE_COUNT 120
#endif
/* Add one to say _a_ signal is pending */
- if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT)
+ if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT) {
+ /* switch back to the current thread so we don't have two
+ * threads working with the same data structures at the
+ * same time.
+ * Using PERL_GET_SIG_CONTEXT isn't necessary on Win32, but
+ * might be on other platforms with PERL_GET_SIG_CONTEXT.
+ */
+#ifdef PERL_GET_SIG_CONTEXT
+ dTHXa(PERL_GET_SIG_CONTEXT);
+#else
+ dTHX;
+#endif
Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded",
(unsigned long)SIG_PENDING_DIE_COUNT);
+ }
}
}
--
1.7.4.msysgit.0
|
From @LeontOn Tue, Dec 21, 2010 at 12:46 PM, jens.schmidt35@arcor.de <
I can't quite reproduce this, but that may be because threading related If I were you I'd reconsider this approach.
"Signals" is a good description :-/ Leon |
From @tonycozOn Sun Nov 24 20:27:17 2013, tonyc wrote:
I discussed my solution with Leon in #p5p, and he objected since signals sent So I'm suggesting a more complex solution: 1) If the signal handler is set in the main thread, unless also set in the child thread, the signal is delivered to the main thread. This solves the case of the operating system delivering a process targetted signal to a child thread. 2) If a child thread set $SIG{FOO} then FOO signals received by that thread are delivered to the thread. This allows child threads to handle signals, possibled sent with raise() or pthread_kill(). 3) For signals to be handled by a child thread, there must also be a non-IGNORE, non-DEFAULT handler in the main thread, which sets the POSIX level signal handler. Since POSIX signal handlers are a process level resource, we control the actual C level signal handler in the main thread.** 4) If we receive a signal in a child thread and the set handler is IGNORE or DEFAULT, it's delivered to the main thread. This allows for the case of a signal sent to a process being delivered to the the child thread, eg. if the child briefly ignored the signal. 5) If the main thread receives a signal where the handler is IGNORE, it drops the signal on the floor. This handles the case of a child setting a handler with POSIX::sigaction() and then terminating. All of that I believe: 1) solves this ticket 2) provides at least a way for a developer to solve 108758. And hopefully that's all coherent. Tony ** I considered keeping a reference count of handlers for each signal, but then we need to worry about what happens if the thread terminates without cleaning up *** Leon hasn't reviewed this possible solution. |
From @tonycozOn Wed Dec 11 19:24:18 2013, tonyc wrote:
Here, finally, is a candidate patch. Tony |
From @tonycoz0001-perl-81074-signals-to-the-main-thread-if-the-child-d.patchFrom 699dc4689ba4b4437dd3ce789096d638202fd432 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 28 Jul 2014 11:34:46 +1000
Subject: [PATCH] [perl #81074] signals to the main thread if the child
doesn't request them
Also fixes [perl #120951] so that signal handlers called outside of a
perl thread are marked via the safe signals mechanism to be delivered
to the main thread.
These changes fix the following circumstances:
- the operating system delivers a signal sent to a process to a child
thread instead of the main thread when only the main thread has a
signal handler set. Linux preferably sends signals to the main
thread, but can send them to a child thread instead if the
main thread is busy. Previously perl would attempt to deliver the
signal to the child, now it delivers the signal to the main thread
unless the child has itself set a handler. [perl #81074]
- a signal is received in the context of a child thread created outside
of perl itself (eg. by Gtk). Previously perl would crash.
[perl #120951]
The code treats a handler set to DEFAULT or IGNORE in a child thread
as unset for that child, so a child thread can enable and disable
itself receiving signals.
While testing this patch I found in a bug in NetBSD, which doesn't
always initialize thread specific storage to NULL, see:
http://gnats.netbsd.org/cgi-bin/query-pr-single.pl?number=49006
---
MANIFEST | 1 +
embedvar.h | 1 +
ext/XS-APItest/APItest.xs | 63 ++++++++++++-
intrpvar.h | 4 +
makedef.pl | 1 +
mg.c | 96 +++++++++++++++++--
perl.c | 7 ++
sv.c | 4 +
t/op/magic_threads.t | 231 +++++++++++++++++++++++++++++++++++++++++++++
9 files changed, 401 insertions(+), 7 deletions(-)
create mode 100644 t/op/magic_threads.t
diff --git a/MANIFEST b/MANIFEST
index 1bb915f..a168f80 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5106,6 +5106,7 @@ t/op/loopctl.t See if next/last/redo work
t/op/lop.t See if logical operators work
t/op/magic-27839.t Test for #27839, skipped for minitest
t/op/magic.t See if magic variables work
+t/op/magic_threads.t Check signal delivery under threads
t/op/method.t See if method calls work
t/op/mkdir.t See if mkdir works
t/op/mydef.t See if "my $_" works
diff --git a/embedvar.h b/embedvar.h
index 454c1ee..9308e81 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -270,6 +270,7 @@
#define PL_secondgv (vTHX->Isecondgv)
#define PL_sharehook (vTHX->Isharehook)
#define PL_sig_pending (vTHX->Isig_pending)
+#define PL_sighand_set (vTHX->Isighand_set)
#define PL_sighandlerp (vTHX->Isighandlerp)
#define PL_signalhook (vTHX->Isignalhook)
#define PL_signals (vTHX->Isignals)
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 54ee2da..93c61c2 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -4,6 +4,11 @@
#include "XSUB.h"
#include "fakesdio.h" /* Causes us to use PerlIO below */
+#if defined(I_PTHREAD) && defined(USE_ITHREADS)
+#define THREAD_SIGNAL_TESTS
+#include <pthread.h>
+#endif
+
typedef SV *SVREF;
typedef PTR_TBL_t *XS__APItest__PtrTable;
@@ -1133,6 +1138,33 @@ my_ck_rv2cv(pTHX_ OP *o)
return old_ck_rv2cv(aTHX_ o);
}
+#ifdef THREAD_SIGNAL_TESTS
+
+static pthread_t dummy_thread;
+
+static void *
+dummy_thread_routine(void *unused) {
+ sleep(5);
+}
+
+static UV
+create_dummy_thread(void) {
+ if (!pthread_create(&dummy_thread, NULL, dummy_thread_routine, NULL)) {
+ return (PTR2UV(&dummy_thread));
+ }
+ else {
+ return 0;
+ }
+}
+
+static void
+join_dummy_thread(void) {
+ void *tmp;
+ pthread_join(dummy_thread, &tmp);
+}
+
+#endif
+
#include "const-c.inc"
MODULE = XS::APItest PACKAGE = XS::APItest
@@ -3256,7 +3288,36 @@ CODE:
exit(0);
}
-#endif /* USE_ITHREDS */
+#ifdef THREAD_SIGNAL_TESTS
+
+# used by t/op/magic_threads.t
+
+int
+pthread_kill(SV *thread_sv, SV * sig_sv)
+ PREINIT:
+ int sig;
+ pthread_t thread;
+ CODE:
+ sig = SvIOK(sig_sv) && SvIV(sig_sv) ? SvIV(sig_sv) : whichsig_sv(sig_sv);
+ thread = *INT2PTR(pthread_t*, SvUV(thread_sv));
+ if (sig >= 0) {
+ RETVAL = pthread_kill((pthread_t)thread, sig);
+ }
+ else {
+ RETVAL = EINVAL;
+ }
+ OUTPUT:
+ RETVAL
+
+UV
+create_dummy_thread()
+
+void
+join_dummy_thread()
+
+#endif /* THREAD_SIGNAL_TESTS */
+
+#endif /* USE_ITHREADS */
SV*
take_svref(SVREF sv)
diff --git a/intrpvar.h b/intrpvar.h
index 9dd4e16..3b4928f 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -345,6 +345,10 @@ PERLVAR(I, statusvalue_posix, I32)
PERLVARI(I, sig_pending, int, 0) /* Number if highest signal pending */
PERLVAR(I, psig_pend, int *) /* per-signal "count" of pending */
+#ifdef USE_ITHREADS
+PERLVAR(I, sighand_set, int *) /* which signal handlers have been set in the current thread */
+#endif
+
/* shortcuts to various I/O objects */
PERLVAR(I, stdingv, GV *) /* *STDIN */
PERLVAR(I, stderrgv, GV *) /* *STDERR */
diff --git a/makedef.pl b/makedef.pl
index 83f0c91..cdcfbf5 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -366,6 +366,7 @@ unless ($define{'USE_ITHREADS'}) {
PL_hints_mutex
PL_my_ctx_mutex
PL_perlio_mutex
+ PL_sighand_set
PL_stashpad
PL_stashpadix
PL_stashpadmax
diff --git a/mg.c b/mg.c
index e1fc578..73d47c0 100644
--- a/mg.c
+++ b/mg.c
@@ -1353,6 +1353,15 @@ Perl_csighandler(int sig)
PERL_UNUSED_ARG(sip);
PERL_UNUSED_ARG(uap);
#endif
+#ifdef USE_ITHREADS
+ /* handle a signal received in a non-perl thread, eg. a thread
+ created by a framework */
+ if (!my_perl) {
+ my_perl = PL_curinterp;
+ PERL_SET_THX(my_perl);
+ }
+#endif
+
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
(void) rsignal(sig, PL_csighandlerp);
if (PL_sig_ignoring[sig]) return;
@@ -1384,16 +1393,33 @@ Perl_csighandler(int sig)
(*PL_sighandlerp)(sig);
#endif
else {
+ int pending;
if (!PL_psig_pend) return;
/* Set a flag to say this signal is pending, that is awaiting delivery after
* the current Perl opcode completes */
- PL_psig_pend[sig]++;
+#ifdef USE_ITHREADS
+ /* Only deliver to the current thread if it has a non-default
+ signal handler set */
+ if (PL_sighand_set && PL_sighand_set[sig]) {
+ PL_psig_pend[sig]++;
+ pending = ++PL_sig_pending;
+ }
+ else {
+ /* no handler specific to thread, deliver to the main thread */
+ dTHXa(PL_curinterp);
+ PL_psig_pend[sig]++;
+ pending = ++PL_sig_pending;
+ }
+#else
+ /* Add one to say _a_ signal is pending */
+ PL_psig_pend[sig]++;
+ pending = ++PL_sig_pending;
+#endif
#ifndef SIG_PENDING_DIE_COUNT
# define SIG_PENDING_DIE_COUNT 120
#endif
- /* Add one to say _a_ signal is pending */
- if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT)
+ if (pending >= SIG_PENDING_DIE_COUNT)
Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded",
(unsigned long)SIG_PENDING_DIE_COUNT);
}
@@ -1573,9 +1599,17 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
PL_psig_ptr[i] = NULL;
}
}
+#ifdef USE_ITHREADS
+ if (!PL_sighand_set) {
+ Newxz(PL_sighand_set, SIG_SIZE, int);
+ }
+#endif
if (sv && (isGV_with_GP(sv) || SvROK(sv))) {
if (i) {
(void)rsignal(i, PL_csighandlerp);
+#ifdef USE_ITHREADS
+ PL_sighand_set[i] = 1;
+#endif
}
else
*svp = SvREFCNT_inc_simple_NN(sv);
@@ -1593,6 +1627,9 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
#else
(void)rsignal(i, (Sighandler_t) SIG_IGN);
#endif
+#ifdef USE_ITHREADS
+ PL_sighand_set[i] = 0;
+#endif
}
}
else if (!sv || memEQs(s, len,"DEFAULT") || !len) {
@@ -1603,6 +1640,9 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
#else
(void)rsignal(i, (Sighandler_t) SIG_DFL);
#endif
+#ifdef USE_ITHREADS
+ PL_sighand_set[i] = 0;
+#endif
}
}
else {
@@ -1614,8 +1654,12 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
if (!strchr(s,':') && !strchr(s,'\''))
Perl_sv_insert_flags(aTHX_ sv, 0, 0, STR_WITH_LEN("main::"),
SV_GMAGIC);
- if (i)
+ if (i) {
(void)rsignal(i, PL_csighandlerp);
+#ifdef USE_ITHREADS
+ PL_sighand_set[i] = 1;
+#endif
+ }
else
*svp = SvREFCNT_inc_simple_NN(sv);
}
@@ -3094,6 +3138,7 @@ Perl_sighandler(int sig)
GV *gv = NULL;
SV *sv = NULL;
SV * const tSv = PL_Sv;
+ SV * sig_ptr = PL_psig_ptr[sig];
CV *cv = NULL;
OP *myop = PL_op;
U32 flags = 0;
@@ -3101,8 +3146,7 @@ Perl_sighandler(int sig)
I32 old_ss_ix = PL_savestack_ix;
SV *errsv_save = NULL;
-
- if (!PL_psig_ptr[sig]) {
+ if (!sig_ptr) {
PerlIO_printf(Perl_error_log, "Signal SIG%s received, but no signal handler set.\n",
PL_sig_name[sig]);
exit(sig);
@@ -3117,6 +3161,46 @@ Perl_sighandler(int sig)
SAVEDESTRUCTOR_X(S_unwind_handler_stack, NULL);
}
}
+
+#ifdef USE_ITHREADS
+ if (!isGV_with_GP(sig_ptr) && !SvROK(sig_ptr) && SvOK(sig_ptr)) {
+ /* handle a thread receiving a signal it isn't expecting,
+ there's a few ways this can occur, see [perl #81074] and
+ [perl #120951] for some examples and discussion.
+ */
+ STRLEN siglen;
+ const char *signame = SvPV_const(sig_ptr, siglen);
+ if (memEQs(signame, siglen, "IGNORE")) {
+ if (aTHX != PL_curinterp) {
+ dTHXa(PL_curinterp);
+ PL_psig_pend[sig]++;
+ ++PL_sig_pending;
+ }
+ /* else drop it on the floor, since it's ignored */
+
+ goto cleanup;
+ }
+ else if (memEQs(signame, siglen, "DEFAULT")) {
+ if (aTHX == PL_curinterp) {
+ /* what to do here? The user is probably doing
+ something fairly strange or advanced, beat them
+ with a stick */
+ PerlIO_printf(Perl_error_log, "Signal SIG%s received with DEFAULT signal handler set.\n",
+ PL_sig_name[sig]);
+ exit(sig);
+ }
+ else {
+ /* hopefully the main thread knows what to do with it */
+ dTHXa(PL_curinterp);
+ PL_psig_pend[sig]++;
+ ++PL_sig_pending;
+
+ goto cleanup;
+ }
+ }
+ }
+#endif
+
/* sv_2cv is too complicated, try a simpler variant first: */
if (!SvROK(PL_psig_ptr[sig]) || !(cv = MUTABLE_CV(SvRV(PL_psig_ptr[sig])))
|| SvTYPE(cv) != SVt_PVCV) {
diff --git a/perl.c b/perl.c
index e84f1d5..6cb188b 100644
--- a/perl.c
+++ b/perl.c
@@ -1283,6 +1283,13 @@ perl_destruct(pTHXx)
PL_psig_pend = (int*)NULL;
Safefree(psig_save);
}
+#ifdef USE_ITHREADS
+ {
+ int *sighand_save = PL_sighand_set;
+ PL_sighand_set = (int*)NULL;
+ Safefree(sighand_save);
+ }
+#endif
nuke_stacks();
TAINTING_set(FALSE);
TAINT_WARN_set(FALSE);
diff --git a/sv.c b/sv.c
index afd4376..751eaf2 100644
--- a/sv.c
+++ b/sv.c
@@ -13973,6 +13973,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
PL_psig_name = (SV**)NULL;
}
+#ifdef USE_ITHREADS
+ PL_sighand_set = NULL;
+#endif
+
if (flags & CLONEf_COPY_STACKS) {
Newx(PL_tmps_stack, PL_tmps_max, SV*);
sv_dup_inc_multiple(proto_perl->Itmps_stack, PL_tmps_stack,
diff --git a/t/op/magic_threads.t b/t/op/magic_threads.t
new file mode 100644
index 0000000..cc0e19b
--- /dev/null
+++ b/t/op/magic_threads.t
@@ -0,0 +1,231 @@
+#!./perl
+
+BEGIN {
+ $| = 1;
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+ skip_all_if_miniperl();
+ require Config; import Config;
+
+ $Config{useithreads} && $Config{i_pthread}
+ or skip_all("No pthreads or no useithreads");
+}
+
+use threads;
+use Thread::Semaphore;
+use strict;
+use POSIX qw(SIGINT sigaction);
+use XS::APItest;
+
+watchdog(60);
+
+++$|;
+
+my $got_int = 0;
+$SIG{INT} = sub {
+ print "# main thread handler\n";
+ ++$got_int;
+};
+
+# used for synchronization
+my $child_ready = Thread::Semaphore->new(0);
+my $parent_ready = Thread::Semaphore->new(0);
+
+# signals across threads, see [perl #81074]
+# if the child doesn't set a handler, it's delivered to the parent
+{
+ note "signals sent to a child that doesn't set a handler are sent to the parent\n";
+ my $thread = threads->create(
+ sub {
+ $child_ready->up;
+ $parent_ready->down;
+ 1; # anything
+ });
+ $child_ready->down;
+ my $sent_error = XS::APItest::pthread_kill($thread->_handle, "INT");
+ $parent_ready->up;
+ ok(!$sent_error, "send a signal to the child thread")
+ or diag "Signal send error: $sent_error";
+ $thread->join();
+ is($got_int, 1, "signal handled by main thread");
+}
+
+# if the child resets its handler, it's delivered to the parent
+{
+ note "signals sent to a child that resets its handler are sent to the parent\n";
+ for my $reset (qw(IGNORE DEFAULT)) {
+ $got_int = 0;
+ my $thread = threads->create(
+ sub {
+ my $got_int;
+ $SIG{INT} = sub {
+ print "# child thread handler\n";
+ ++$got_int;
+ };
+ $SIG{INT} = $reset;
+ $child_ready->up;
+ $parent_ready->down;
+ ok(!$got_int, "signal not received by child after $reset reset");
+ });
+ $child_ready->down;
+ my $sent_error = XS::APItest::pthread_kill($thread->_handle, "INT");
+ $parent_ready->up;
+ $thread->join();
+ curr_test(curr_test()+1);
+ ok(!$sent_error, "send a signal to the child thread ($reset)")
+ or diag "Signal send error: $sent_error";
+ is($got_int, 1, "signal handled by main thread after child reset with $reset");
+ }
+}
+
+# send to child handler
+{
+ note "signals sent to a child that sets a handler are sent to the child\n";
+ $got_int = 0;
+ my $thread = threads->create(
+ sub {
+ my $got_int;
+ $SIG{INT} = sub {
+ print "# child thread handler\n";
+ ++$got_int;
+ };
+ $child_ready->up;
+ $parent_ready->down;
+ ok($got_int, "signal received by child");
+ });
+ $child_ready->down;
+ my $sent_error = XS::APItest::pthread_kill($thread->_handle, "INT");
+ $parent_ready->up;
+ $thread->join();
+ curr_test(curr_test()+1);
+ ok(!$sent_error, "send a signal to the child thread")
+ or diag "Signal send error: $sent_error";
+ is(!$got_int, 1, "signal not seen by main thread");
+}
+
+$SIG{INT} = "DEFAULT";
+
+# child handler set via sigaction
+{
+ note "child handler set by sigaction\n";
+ # catch any warnings in case we attempt to deliver the signal to
+ # the parent which won't be able to find sub "DEFAULT".
+ my $warn = '';
+ local $SIG{__WARN__} = sub { $warn .= "@_"; print STDERR @_; };
+ my $thread = threads->create(
+ sub {
+ my $got_int;
+ my $handler = sub {
+ print "# action handler\n";
+ ++$got_int;
+ };
+ my $sigset = POSIX::SigSet->new(SIGINT);
+ my $handler_action = POSIX::SigAction->new
+ (
+ $handler,
+ $sigset,
+ 0
+ );
+ my $default_action = POSIX::SigAction->new
+ (
+ "DEFAULT",
+ $sigset,
+ 0
+ );
+ $handler_action->safe(1);
+ sigaction(SIGINT, $handler_action);
+ $child_ready->up();
+ $parent_ready->down();
+ sigaction(SIGINT, $default_action);
+ ok($got_int, "child received signal");
+ is($warn, "", "no warnings raised in child");
+ });
+ $child_ready->down;
+ my $sent_error = XS::APItest::pthread_kill($thread->_handle, "INT");
+ $parent_ready->up;
+ $thread->join();
+ curr_test(curr_test()+2);
+ ok(!$sent_error, "send a signal to the child thread")
+ or diag "Signal send error: $sent_error";
+ is($warn, "", "no warnings raised in parent");
+}
+
+# signal arriving at perl's signal handler in a non-perl thread, see
+# [perl #120951]
+SKIP:
+{
+ # see http://gnats.netbsd.org/cgi-bin/query-pr-single.pl?number=49006
+ $^O eq 'netbsd'
+ and skip "NetBSD 5.1.2 and 6.1.3 didn't initialize the thread specific storage to NULL", 2;
+ local $SIG{INT} = sub {
+ print "# main thread handler\n";
+ ++$got_int;
+ };
+ $got_int = 0;
+ my $handle = XS::APItest::create_dummy_thread()
+ or skip("Can't create non-perl thread", 2);
+ sleep 1; # wait for child to initialize
+ my $sent_error = XS::APItest::pthread_kill($handle, "INT");
+ XS::APItest::join_dummy_thread();
+ ok(!$sent_error, "sent signal to non-perl thread")
+ or diag("signal send error $sent_error");
+ ok($got_int, "signal should have been delivered to main thread");
+}
+
+
+# signal arriving at the main thread because a finished child used
+# sigaction to set up a handler.
+{
+ note "child handler set with sigaction, but child finished";
+ # catch any warnings in case we attempt to deliver the signal to
+ # the parent which won't be able to find sub "DEFAULT".
+ my $warn = '';
+ local $SIG{INT} = "IGNORE";
+ local $SIG{__WARN__} = sub { $warn .= "@_"; print STDERR @_; };
+ my $thread = threads->create(
+ sub {
+ my $got_int;
+ my $handler = sub {
+ print "# action handler\n";
+ ++$got_int;
+ };
+ my $sigset = POSIX::SigSet->new(SIGINT);
+ my $handler_action = POSIX::SigAction->new
+ (
+ $handler,
+ $sigset,
+ 0
+ );
+ $handler_action->safe(1);
+ ok(sigaction(SIGINT, $handler_action), "set signal handler in child")
+ or diag("sigaction: $!");
+ # fall off the end without removing our handler
+ });
+ $thread->join();
+ my $sent_ok = kill "INT", $$;
+ # sometimes (most noticably on NetBSD), the Perl's "safe signals"
+ # (or possibly the OS) will deliver the signal *after* we reset
+ # the signal handler below. I tried a few approaches, including
+ # looping a while, but only the sleep below seems to handle this
+ # reliably.
+ #
+ # On NetBSD 5.1.2, rarely, without the sleep the signal would
+ # arrive from the OS and kill the process with SIGINT, so
+ # presumably after the signal handle has been changed to the
+ # default below.
+ sleep 1;
+ my $sigset = POSIX::SigSet->new(SIGINT);
+ my $default_action = POSIX::SigAction->new
+ (
+ "DEFAULT",
+ $sigset,
+ 0
+ );
+ sigaction(SIGINT, $default_action);
+ curr_test(curr_test()+1);
+ ok($sent_ok, "send a signal to the main thread");
+ is($warn, "", "no warnings raised in parent");
+}
+
+done_testing();
--
1.7.10.4
|
From @LeontOn Mon, Jul 28, 2014 at 6:15 AM, Tony Cook via RT <perlbug-followup@perl.org
You're peeking and poking into an interpreter owned by another thread. This
The else block is racy too, though over a smaller scope than the previous
I don't see the logic of sending a signal to the main thread when we asked
I can think of at least one race condition that could cause that, but that
Again, this is racy for the previously mentioned reasons. Also, it should be noted that your additions feature is enabled on Leon |
From @bulk88On Fri Oct 03 17:29:52 2014, LeonT wrote:
If you grep / and /win32 for "curinterp" you will see that is already done in win32.c . I am not saying it is right or wrong. On win32 Perl there is a race condition that nobody ever solved regarding the Ctrl-C signal on Win32. Win32 API will always call the Ctrl-C function from a fresh thread. If perl is at 100% cpu in runloop without being stuck in kernel mode, and Ctrl-C is pressed, there is a race between my_exit() and the code executing in runloop. Usually the OP * is freed while the PP func is running and somehow usually a NULL is returned and the runloop quickly exits if the sign handler thread doesn't reach C lib exit() first. Maybe this code is needed for Win32 too.
C doesn't require that PL_psig_pend[sig]++; be atomic, but if the type is 8/16/32 bits and it is on x86 single core, it is atomic since a HW interupt or kernel preemption can't cause half a machine instruction ("inc *(reg+constant)" is an x86 op) to execute. For safety on x86 multicore, you must the correct atomic APIs http://preshing.com/20130618/atomic-vs-non-atomic-operations/ .
I agree. AFAIK MULTIPLICITY is dead but the token remains for backcompat since 5.005 threads are gone. PERL_IMPLICIT_CONTEXT is what you probably want. PERL_IMPLICIT_CONTEXT *without* USE_ITHREADS means you want multiple perl threads/interps in 1 process for embedding reasons, but you do not want the ithreads module. So what happens if the signal is delivered to a 3rd party GUI or IO OS thread while the OS thread with Perl is blocked? @@ -1573,9 +1599,17 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) Can PL_sighand_set be an inline array in interp struct? Im not sure of details since this is unix, but I'm afraid this array will wind up always getting allocated in every run of the interp, and therefore malloc overhead for something that will be unconditionally allocated if an interp struct was allocated. Also if the malloc design stays. Dont let Newxz use PL_sighand_set, instead let it use a C auto void pointer, then assign the C auto to PL_sighand_set, that way the sig handler func wont see half zero-ed data where PL_sighand_set was set, but memset hasnt been called yet, or memset is half way done zeroing the block. I didn't trace exactly how the Newxz macros work but assume Newxz can cause half zeroed data. -- |
From @LeontOn Sat, Oct 4, 2014 at 10:41 AM, bulk88 via RT <perlbug-followup@perl.org>
I'm not aware of a pthread_kill equivalent on Windows, nor do I really know
If you define one of MULTIPLICITY and PERL_IMPLICIT_CONTEXT the other will
AFAICT it will be alloced when a %SIG entry is set, which isn't Leon |
Migrated from rt.perl.org#81074 (status was 'open')
Searchable as RT81074$
The text was updated successfully, but these errors were encountered: