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

Signal handler - correct way to hijack TSTP

by seki (Monk)
on Apr 02, 2019 at 18:14 UTC ( [id://1232039]=perlquestion: print w/replies, xml ) Need Help??

seki has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks.

On a Linux machine, writing a domain specific HTTP::Daemon based service, I am trying to handle several signals in order to have accurate logs, and possibly doing some clean-up and housekeeping tasks.

My problem to to manage correctly the TSTP supend signal in order to trace it correctly BEFORE actually suspending. I then resend the TSTP to the default signal handler.

My production code does not handle correctly the TSTP signal as it is logging the signal when receiving but not suspending. Note it is also always started in background, and it is forking each time a connection is accept()ed - less than 1 per minute. I have stripped-down my program to a minimal logging toy that seems to run correctly (but not with childs after I have added the fork()).

Can you tell if it is the correct way to suspend, and how I should take care of forked childs for terminating cases?

#!/usr/bin/perl use strict; use warnings; use feature 'say'; use constant { FATAL => 0, ERROR => 1, INFO => 2, DEBUG => 3, TRACE => 4 }; $|++; my $stop_flag = 0; BEGIN { my $LOG_LVL = TRACE; sub suspend_trap { logger(INFO, "SIGTSTP / CTRL-Z received. Suspen +ding..."); # $SIG{TSTP} = 'IGNORE'; $SIG{TSTP} = 'DEFAULT'; kill 'TSTP', -(getpgrp $$); # $SIG{TSTP} = \&suspend_trap; # Paranoid - for + unreliable signals - see Perl cookbook ch16.17.3 } # 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(); logger(INFO, "Child PID $pid has been forke +d.") if $pid; }; $SIG{INT} = sub { logger(INFO, "SIGINT / CTRL-C received (Int +errupt from keyboard). Leaving..."); $stop_flag++; }; $SIG{QUIT} = sub { logger(INFO, "SIGQUIT / CTRL-\\ received (Q +uit from keyboard). Leaving..."); $stop_flag++; }; $SIG{ABRT} = sub { logger(INFO, "SIGABRT received (Probable ab +normal process termination requested by a library). Leaving..."); $st +op_flag++; }; $SIG{TERM} = sub { logger(INFO, "SIGTERM - External terminatio +n request. Leaving..."); $stop_flag++; }; $SIG{TSTP} = \&suspend_trap; $SIG{CONT} = sub { $SIG{TSTP} = \&suspend_trap; logger(INFO, " +SIGCONT received - continue after suspension.") }; # 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, "Program PID $$ has started"); logger(INFO, sprintf("We %s connected to a TTY", -t ? 'ARE' : 'ARE NOT +')); while (!$stop_flag){ say "[$$] In loop; sleeping..."; sleep 3; }; logger(INFO, "Reached normal end. Ciao.");
The best programs are the ones written when the programmer is supposed to be working on something else. - Melinda Varian

Replies are listed 'Best First'.
Re: Signal handler - correct way to hijack TSTP
by hippo (Bishop) on Apr 02, 2019 at 20:57 UTC

    I've tried your code but it required a small change to run for me under perl v5.20.3. As it stands, the -t causes it grief:

    [11541] START [02@21:54:27] Warning: Use of "-t" without parentheses i +s ambiguous at ./sigs.pl line 61. [11541] START [02@21:54:27] Use of ?PATTERN? without explicit operator + is deprecated at ./sigs.pl line 61. [11541] START [02@21:54:27] Search pattern not terminated or ternary o +perator parsed as search pattern at ./sigs.pl line 61. Leaving...

    So changing line 61 to be this:

    logger(INFO, sprintf("We %s connected to a TTY", -t () ? 'ARE' : 'ARE +NOT'));

    It then runs and appears to handle the TSTP and subsequent CONT perfectly well. Which version of perl are you running and on which OS?

      Hi and thank you for your suggestion that I did missed.

      By testing the same code on 5.22.0 I encountered the same ambiguity warning as you. The code was initially written for a Perl 5.16.3 that runs on a Linux RHEL 6. By doing some more tests today, it seems that my problem was probably related to a mix of logs from different processes -a forgotten previous instance and a new one- in the same nohup.out i see different pids

      258135 START 11@11:54:00 Setting up signal handlers
      258135 RUN 11@11:54:00 Program PID 258135 has started
      258135 RUN 11@11:54:00 We ARE NOT connected to a TTY
      258135 In loop; sleeping...
      257458 In loop; sleeping...
      258135 RUN 11@11:54:02 SIGTSTP / CTRL-Z received. Suspending...
      257458 In loop; sleeping...
      257458 In loop; sleeping...
      

      Anyway i have improved my sscce by adding a proper propagation of the CONT signal to the childs. And I of course noticed that in case of a TERM to a child, it remains as a 'defunct' process until the parent terminates. I know about waitpid() that should fix that but am unsure of its correct use. Where to put it?

      here is my upgraded example:

      #!/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 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"); sub suspend_trap { logger(INFO, "SIGTSTP / CTRL-Z received. Suspen +ding..."); # $SIG{TSTP} = 'IGNORE'; $SIG{TSTP} = 'DEFAULT'; kill 'TSTP', -(getpgrp $$); # $SIG{TSTP} = \&suspend_trap; # Paranoid - for + unreliable signals - see Perl cookbook ch16.17.3 } # 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; }; my @childs = (); $SIG{HUP} = sub { logger(INFO, "SIGHUP received. Forking."); my $pid = fork(); if ($pid){ logger(INFO, "Child PID $pid has been f +orked."); push @childs, $pid; } }; $SIG{INT} = sub { logger(INFO, "SIGINT / CTRL-C received (Int +errupt from keyboard). Leaving..."); $stop_flag++; }; $SIG{QUIT} = sub { logger(INFO, "SIGQUIT / CTRL-\\ received (Q +uit from keyboard). Leaving..."); $stop_flag++; }; $SIG{ABRT} = sub { logger(INFO, "SIGABRT received (Probable ab +normal process termination requested by a library). Leaving..."); $st +op_flag++; }; $SIG{TERM} = sub { logger(INFO, "SIGTERM - External terminatio +n request. Leaving..."); $stop_flag++; }; $SIG{TSTP} = \&suspend_trap; $SIG{CONT} = sub { $SIG{TSTP} = \&suspend_trap; logger(INFO, "SIGCONT received - continue a +fter suspension."); kill 'CONT', @childs; }; # 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, "Program PID $$ has started"); logger(INFO, sprintf("We %s connected to a TTY", -t () ? 'ARE' : 'ARE +NOT')); while (!$stop_flag){ say "[$$] 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
        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'

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1232039]
Front-paged by haukex
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others goofing around in the Monastery: (5)
As of 2024-04-18 23:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found