http://www.perlmonks.org?node_id=75905


in reply to Re: Re: My pipe gets the SIGINT. And I dont want that...
in thread My pipe gets the SIGINT. And I dont want that...

This is gonna require some fork games and some fun signal handling. I should publish the standard warnings that perl's signal handling leaves a lot to be desired and do not blame me if this causes all your hair to fall out and sets your workstation on fire :)

Basically, what I am going to do is to spawn the PIPE process off as a child process. The parent process will watch for two signals: SIGINT will cause the parent to kill the child off and SIGHUP will cause the parent to kill the child and then itself. To avoid perl's signal problems, I am keeping the handlers very, very simple - they each set a variable and let the main loop handle it. There are still race conditions in the code, which may or may not be able to be fixed.

Also, not to put too much of a point on it, I am not using a SIGCHLD handler. I use waitpid and reap the children myself.

I am also gonna do this a bit of pseudo-code here - I am currently too lazy to cut'n'paste :)

sub spawn { my ( $interesting, $vars, $here ) = @_; my $pid = 0; # The parent process returns the spawned process's pid. # The spawned process does the work if ( $pid = fork ) { return $pid; } else { # do lots of interesting things # Either exit or exec - just make sure the kid # never returns. exit 0; } } my $stop_all = 0; my $stop_kid = 0; my $kid_pid = 0; # Trying to minimize my risk here, I simply set a variable # and let the later code handle it. It isn't perfect, # but it works. # SIGINT stops the kid. SIGHUP stops everything $SIG{SIGHUP} = sub { $stop_all = 1; } $SIG{INT} = sub { $stop_kid = 1; } # This loops forever. You may not want that :) The 5 second sleep # also keeps you from eating too many CPU cycles. Note it # will also mean a maximum 5 second delay between sending the # SIGINT or SIGHUP and anything happening. If that is not # acceptable, use select(undef,undef,undef,0.5) while( 1 ) { sleep 5; if ( $stop_all ) { kill 9, $kid_pid if ( $kid_pid && $kid_pid != -1 ); exit; } # Race conditions ahead! Don't lean too heavily on the # CTRL-C key if ( $stop_kid ) { kill 9, $kid_pid if ( $kid_pid > 0 ); $stop_kid = 0; } # I am a bad man and do not use POSIX. The 1 may # change depending on the OS - this works for # Solaris and FreeBSD my $dpid = waitpid( -1, 1 ); $kid_pid = spawn() if ( $dpid == $kid_pid || $dpid = -1 ); }
This is untested, but there is also a lot of code to be found on perlmonks dealing with forking and reaping child processes. I have a very extensive example playing games like this but do not have the source code immediately available. I will check when I get home and make sure this example is mostly correct.

Mik mikfire