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
| 