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.");
[download]