Front page | perl.perl5.porters |
Postings from March 2001
[ID 20010307.005] POSIX::sigaction has various problems
Thread Next
From:
anders
Date:
March 7, 2001 14:35
Subject:
[ID 20010307.005] POSIX::sigaction has various problems
Message ID:
200103072235.OAA25368@dt-sj1-130.sj.broadcom.com
This is a bug report for perl from anders@ieee.org,
generated with the help of perlbug 1.13 running under perl 5.00503.
Problems with POSIX::sigaction under perl5.6.0:
+ Can't call sigaction without setting new disposition.
+ Getting old disposition generates spurious warning if never set before.
+ Can't install a coderef handler.
+ Can't install a 'DEFAULT' or 'IGNORE' handler.
+ Can't get old disposition's mask or flags if new disposition set.
+ Old disposition contains stringified version of a previously installed
coderef.
+ Intalling new disposition is not atomic. (This is hard to detect.)
I've fixed the problem in POSIX.xs and written a new test called sigaction.t.
Here is the patch file:
----- BEGIN patch -----
diff -Naur perl-5.6.0/ext/POSIX/POSIX.xs perl-5.6.0-sigaction/ext/POSIX/POSIX.xs
--- perl-5.6.0/ext/POSIX/POSIX.xs Sat Feb 19 08:08:47 2000
+++ perl-5.6.0-sigaction/ext/POSIX/POSIX.xs Wed Mar 7 14:12:18 2001
@@ -2766,6 +2766,17 @@
return 0;
}
+static void
+restore_sigmask(sigset_t *ossetp)
+{
+ /* Fortunately, restoring the signal mask can't fail, because
+ * there's nothing we can do about it if it does -- we're not
+ * supposed to return -1 from sigaction unless the disposition
+ * was unaffected.
+ */
+ (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
+}
+
MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
POSIX::SigSet
@@ -3363,9 +3374,9 @@
double x
SysRet
-sigaction(sig, action, oldaction = 0)
+sigaction(sig, optaction, oldaction = 0)
int sig
- POSIX::SigAction action
+ SV * optaction
POSIX::SigAction oldaction
CODE:
#ifdef WIN32
@@ -3375,9 +3386,12 @@
# interface look beautiful, which is hard.
{
+ POSIX__SigAction action;
GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
struct sigaction act;
struct sigaction oact;
+ sigset_t sset;
+ sigset_t osset;
POSIX__SigSet sigset;
SV** svp;
SV** sigsvp = hv_fetch(GvHVn(siggv),
@@ -3386,11 +3400,62 @@
TRUE);
STRLEN n_a;
- /* Remember old handler name if desired. */
+ /* Check optaction and set action */
+ if(SvTRUE(optaction)) {
+ if(sv_isa(optaction, "POSIX::SigAction"))
+ action = (HV*)SvRV(optaction);
+ else
+ croak("action is not of type POSIX::SigAction");
+ }
+ else {
+ action=0;
+ }
+
+ /* sigaction() is supposed to look atomic. In particular, any
+ * signal handler invoked during a sigaction() call should
+ * see either the old or the new disposition, and not something
+ * in between. We use sigprocmask() to make it so.
+ */
+ sigfillset(&sset);
+ RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
+ if(RETVAL == -1)
+ XSRETURN(1);
+ ENTER;
+ /* Restore signal mask no matter how we exit this block. */
+ SAVEDESTRUCTOR(restore_sigmask, &osset);
+
+ RETVAL=-1; /* In case both oldaction and action are 0. */
+
+ /* Remember old disposition if desired. */
if (oldaction) {
- char *hand = SvPVx(*sigsvp, n_a);
svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
- sv_setpv(*svp, *hand ? hand : "DEFAULT");
+ if(!svp)
+ croak("Can't supply an oldaction without a HANDLER");
+ if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
+ sv_setsv(*svp, *sigsvp);
+ }
+ else {
+ sv_setpv(*svp, "DEFAULT");
+ }
+ RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
+ if(RETVAL == -1)
+ XSRETURN(1);
+ /* Get back the mask. */
+ svp = hv_fetch(oldaction, "MASK", 4, TRUE);
+ if (sv_isa(*svp, "POSIX::SigSet")) {
+ unsigned long tmp;
+ tmp = (unsigned long)SvNV((SV*)SvRV(*svp));
+ sigset = (sigset_t*) tmp;
+ }
+ else {
+ New(0, sigset, 1, sigset_t);
+ sv_setptrobj(*svp, sigset, "POSIX::SigSet");
+ }
+ *sigset = oact.sa_mask;
+
+ /* Get back the flags. */
+ svp = hv_fetch(oldaction, "FLAGS", 5, TRUE);
+ sv_setiv(*svp, oact.sa_flags);
}
if (action) {
@@ -3399,9 +3464,23 @@
svp = hv_fetch(action, "HANDLER", 7, FALSE);
if (!svp)
croak("Can't supply an action without a HANDLER");
- sv_setpv(*sigsvp, SvPV(*svp, n_a));
+ sv_setsv(*sigsvp, *svp);
mg_set(*sigsvp); /* handles DEFAULT and IGNORE */
- act.sa_handler = PL_sighandlerp;
+ if(SvPOK(*svp)) {
+ char *s=SvPVX(*svp);
+ if(strEQ(s,"IGNORE")) {
+ act.sa_handler = SIG_IGN;
+ }
+ else if(strEQ(s,"DEFAULT")) {
+ act.sa_handler = SIG_DFL;
+ }
+ else {
+ act.sa_handler = PL_sighandlerp;
+ }
+ }
+ else {
+ act.sa_handler = PL_sighandlerp;
+ }
/* Set up any desired mask. */
svp = hv_fetch(action, "MASK", 4, FALSE);
@@ -3417,36 +3496,16 @@
/* Set up any desired flags. */
svp = hv_fetch(action, "FLAGS", 5, FALSE);
act.sa_flags = svp ? SvIV(*svp) : 0;
- }
- /* Now work around sigaction oddities */
- if (action && oldaction)
- RETVAL = sigaction(sig, & act, & oact);
- else if (action)
+ /* Don't worry about cleaning up *sigsvp if this fails,
+ * because that means we tried to disposition a
+ * nonblockable signal, in which case *sigsvp is
+ * essentially meaningless anyway.
+ */
RETVAL = sigaction(sig, & act, (struct sigaction *)0);
- else if (oldaction)
- RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
- else
- RETVAL = -1;
-
- if (oldaction) {
- /* Get back the mask. */
- svp = hv_fetch(oldaction, "MASK", 4, TRUE);
- if (sv_isa(*svp, "POSIX::SigSet")) {
- unsigned long tmp;
- tmp = (unsigned long)SvNV((SV*)SvRV(*svp));
- sigset = (sigset_t*) tmp;
- }
- else {
- New(0, sigset, 1, sigset_t);
- sv_setptrobj(*svp, sigset, "POSIX::SigSet");
- }
- *sigset = oact.sa_mask;
-
- /* Get back the flags. */
- svp = hv_fetch(oldaction, "FLAGS", 5, TRUE);
- sv_setiv(*svp, oact.sa_flags);
}
+
+ LEAVE;
}
#endif
OUTPUT:
diff -Naur perl-5.6.0/t/lib/sigaction.t perl-5.6.0-sigaction/t/lib/sigaction.t
--- perl-5.6.0/t/lib/sigaction.t Wed Dec 31 16:00:00 1969
+++ perl-5.6.0-sigaction/t/lib/sigaction.t Wed Mar 7 14:17:21 2001
@@ -0,0 +1,118 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+}
+
+BEGIN{
+ # Don't do anything if POSIX is missing, or sigaction missing.
+ eval { use POSIX; };
+ if($@ || $^O eq 'MSWin32') {
+ print "1..0\n";
+ exit 0;
+ }
+}
+
+use strict;
+use vars qw/$bad7 $ok10 $bad18 $ok/;
+
+$^W=1;
+
+print "1..18\n";
+
+sub IGNORE {
+ $bad7=1;
+}
+
+sub DEFAULT {
+ $bad18=1;
+}
+
+sub foo {
+ $ok=1;
+}
+
+my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
+my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0);
+
+{
+ my $bad;
+ local($SIG{__WARN__})=sub { $bad=1; };
+ sigaction(SIGHUP, $newaction, $oldaction);
+ if($bad) { print "not ok 1\n" } else { print "ok 1\n"}
+}
+
+if($oldaction->{HANDLER} eq 'DEFAULT')
+ { print "ok 2\n" } else { print "not ok 2\n"}
+print $SIG{HUP} eq '::foo' ? "ok 3\n" : "not ok 3\n";
+
+sigaction(SIGHUP, $newaction, $oldaction);
+if($oldaction->{HANDLER} eq '::foo')
+ { print "ok 4\n" } else { print "not ok 4\n"}
+if($oldaction->{MASK}->ismember(SIGUSR1))
+ { print "ok 5\n" } else { print "not ok 5\n"}
+if($oldaction->{FLAGS}) { print "not ok 6\n" } else { print "ok 6\n"}
+
+$newaction=POSIX::SigAction->new('IGNORE');
+sigaction(SIGHUP, $newaction);
+kill 'HUP', $$;
+print $bad7 ? "not ok 7\n" : "ok 7\n";
+
+print $SIG{HUP} eq 'IGNORE' ? "ok 8\n" : "not ok 8\n";
+sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
+print $SIG{HUP} eq 'DEFAULT' ? "ok 9\n" : "not ok 9\n";
+
+$newaction=POSIX::SigAction->new(sub { $ok10=1; });
+sigaction(SIGHUP, $newaction);
+{
+ local($^W)=0;
+ kill 'HUP', $$;
+}
+print $ok10 ? "ok 10\n" : "not ok 10\n";
+
+print ref($SIG{HUP}) eq 'CODE' ? "ok 11\n" : "not ok 11\n";
+
+sigaction(SIGHUP, POSIX::SigAction->new('::foo'));
+# Make sure the signal mask gets restored after sigaction croak()s.
+eval {
+ my $act=POSIX::SigAction->new('::foo');
+ delete $act->{HANDLER};
+ sigaction(SIGINT, $act);
+};
+kill 'HUP', $$;
+print $@ && $ok ? "ok 12\n" : "not ok 12\n";
+
+undef $ok;
+# Make sure the signal mask gets restored after sigaction returns early.
+my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
+kill 'HUP', $$;
+print !$x && $ok ? "ok 13\n" : "not ok 13\n";
+
+$SIG{HUP}=sub {};
+sigaction(SIGHUP, $newaction, $oldaction);
+print ref($oldaction->{HANDLER}) eq 'CODE' ? "ok 14\n" : "not ok 14\n";
+
+eval {
+ sigaction(SIGHUP, undef, $oldaction);
+};
+print $@ ? "not ok 15\n" : "ok 15\n";
+
+eval {
+ sigaction(SIGHUP, 0, $oldaction);
+};
+print $@ ? "not ok 16\n" : "ok 16\n";
+
+eval {
+ sigaction(SIGHUP, bless({},'Class'), $oldaction);
+};
+print $@ ? "ok 17\n" : "not ok 17\n";
+
+$newaction=POSIX::SigAction->new(sub { $ok10=1; });
+sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
+{
+ local($^W)=0;
+ kill 'CONT', $$;
+}
+print $bad18 ? "not ok 18\n" : "ok 18\n";
+
----- END patch -----
Site configuration information for perl 5.00503:
Configured by root at Fri Jun 16 10:37:29 PDT 2000.
Summary of my perl5 (5.0 patchlevel 5 subversion 3) configuration:
Platform:
osname=solaris, osvers=2.6, archname=sun4-solaris
uname='sunos dns-sj1-4 5.6 generic_105181-19 sun4u sparc sunw,ultra-5_10 '
hint=recommended, useposix=true, d_sigaction=define
usethreads=undef useperlio=undef d_sfio=undef
Compiler:
cc='cc', optimize='-O', gccversion=
cppflags=''
ccflags =''
stdchar='unsigned char', d_stdstdio=define, usevfork=false
intsize=4, longsize=4, ptrsize=4, doublesize=8
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
alignbytes=8, usemymalloc=y, prototype=define
Linker and Libraries:
ld='cc', ldflags =''
libpth=/lib /usr/lib /usr/ccs/lib
libs=-lsocket -lnsl -ldl -lm -lc -lcrypt
libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
cccdlflags='-KPIC', lddlflags='-G'
Thread Next
-
[ID 20010307.005] POSIX::sigaction has various problems
by anders