Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Re^3: Signal handler - correct way to hijack TSTP

by shmem (Chancellor)
on Jan 11, 2021 at 11:52 UTC ( #11126743=note: print w/replies, xml ) Need Help??


in reply to Re^2: Signal handler - correct way to hijack TSTP
in thread Signal handler - correct way to hijack TSTP

I know about waitpid() that should fix that but am unsure of its correct use. Where to put it?

Put that into the signal handler for $SIG{CHLD} in the parent. This is the signal a process gets if a subprocess goes away. See perlipc.

perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'

Replies are listed 'Best First'.
Re^4: Signal handler - correct way to hijack TSTP
by seki (Scribe) on Jan 11, 2021 at 19:27 UTC

    Thank you, it is becoming actually satisfactory!

    htop helped much to test. My signal experimentation is now

    #!/usr/bin/perl # test_signal.pl - Testing signals handlers # to test without TTY, you can use 'nohup perl test_signal.pl' # to test the suspend/continue either # in foreground: C-z then 'bg' or 'fg' # in background: kill -tstp <pid> / kill -cont <pid> use strict; use warnings; use feature 'say'; use POSIX qw(:signal_h :errno_h :sys_wait_h); use constant { FATAL => 0, ERROR => 1, INFO => 2, DEBUG => 3, TRACE => 4 }; $|++; my $stop_flag = 0; BEGIN { my $LOG_LVL = TRACE; logger(INFO, "Setting up signal handlers"); my $childs = {}; sub suspend_trap { logger(INFO, "SIGTSTP / CTRL-Z (Terminal Stop) +received. Suspending..."); # there is also SIGSTOP that is untrappable STO +P # $SIG{TSTP} = 'IGNORE'; $SIG{TSTP} = 'DEFAULT'; kill 'TSTP', -(getpgrp $$); # propagate the si +gnal to the whole pgroup # $SIG{TSTP} = \&suspend_trap; # DISABLED due t +o endless notifications - Paranoid - for unreliable signals - see Per +l cookbook ch16.17.3 } sub child_reaper { logger(INFO, "SIGCHLD received."); my $pid; while (($pid = waitpid(-1, &WNOHANG)) > 0){ # note # $exit_value = $? >> 8; -> WEXITSTATUS # $signal_num = $? & 127; -> WTERMSIG # $dumped_core = $? & 128; if(WIFEXITED($?)){ logger(INFO, sprintf("Child %d exited n +ormally with value %d", $pid, WEXITSTATUS($?))); delete $childs->{$pid}; } elsif (WIFSIGNALED($?)){ logger(INFO, sprintf("Child %d was kill +ed by a signal %d", $pid, WTERMSIG($?))); delete $childs->{$pid}; } else { logger(INFO, "False alarm for child $pi +d"); # "false alarm" WTF?!! - Perl cookbook ch16.20 } logger(INFO, "Child $pid dumped core") if $ +? & 128; } $SIG{CHLD} = \&child_reaper; # Paranoid - for u +nreliable signals - see Perl cookbook ch16.20 } # A handler can be # code ref (sub) # name of sub # 'IGNORE' # 'DEFAULT' $SIG{__WARN__} = sub { my $m = shift; chomp $m; logger(ERROR, $m); + }; $SIG{__DIE__} = sub { my $m = shift; chomp $m; logger(FATAL, $m . + " Leaving..."); exit; }; $SIG{HUP} = sub { logger(INFO, "SIGHUP received. Forking."); my $pid = fork(); if ($pid){ logger(INFO, "Child PID $pid has been f +orked."); $childs->{$pid}++;; } }; $SIG{INT} = sub { logger(INFO, "SIGINT / CTRL-C received (Int +errupt from keyboard). Leaving..."); $stop_flag++; kill 'INT', keys % +$childs; }; $SIG{QUIT} = sub { logger(INFO, "SIGQUIT / CTRL-\\ received (Q +uit from keyboard). Leaving..."); $stop_flag++; kill 'QUIT', keys %$c +hilds; }; $SIG{ABRT} = sub { logger(INFO, "SIGABRT received (Probable ab +normal process termination requested by a library). Leaving..."); $st +op_flag++; kill 'ABRT', keys %$childs; }; $SIG{TERM} = sub { logger(INFO, "SIGTERM - External terminatio +n request. Leaving..."); $stop_flag++; kill 'TERM', keys %$childs;}; $SIG{TSTP} = \&suspend_trap; $SIG{CONT} = sub { $SIG{TSTP} = \&suspend_trap; logger(INFO, "SIGCONT received - continue a +fter suspension."); kill 'CONT', keys %$childs; # we could also + send to the whole pgroup like for TSTP }; $SIG{CHLD} = \&child_reaper; # Log some text, depending on the current log level sub logger { my ($lvl, $msg) = @_; say __stamp($msg) if ($LOG_LVL >= $lvl); } # This sub Copyright (c) 1996,97,98,99,2000,01 by Randal L. Schwar +tz sub __stamp { my ($message) = @_; my $stamp = sprintf "[%d] %s [%02d@%02d:%02d:%02d] ", $$, ${^G +LOBAL_PHASE}, (localtime)[3,2,1,0]; $message =~ s/^/$stamp/gm; $message; } logger(INFO, "End of BEGIN (...or beginning of end? ;o)"); } logger(INFO, "Program PID $$ has started"); logger(INFO, sprintf("We %s connected to a TTY", -t () ? 'ARE' : 'ARE +NOT')); while (!$stop_flag){ logger(INFO, "In loop; sleeping..."); sleep 3; }; logger(INFO, "Reached normal end. Ciao."); END { logger(INFO, "That's all folks!") };

    The best programs are the ones written when the programmer is supposed to be working on something else. - Melinda Varian

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://11126743]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (4)
As of 2021-02-28 17:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?