Usually, there is an escalation in signals you sent to a program to stop it. You start with SIGINT, if that does not help, you send SIGTERM after a while, and as a last resort, you send SIGKILL. On the receiver side, you can set up signal handlers for SIGINT and SIGTERM, but not for SIGKILL.

So, you propably want to set up a signal handler for SIGINT and/or SIGTERM. See %SIG in perlvar and "Signals" in perlipc. accept(), like almost all syscalls, will return with an error (EINTR) after a signal was sent to the process. In the signal handler, you set some "I want to exit" flag, and check that flag after accept() has returned an error.

Alexander

You could use something like this:

my $exit_requested = 0;

local $SIG{ INT  } = sub { ++$exit_requested; };
local $SIG{ TERM } = sub { ++$exit_requested; };

while ( !$exit_requested ) {
   my $client_sock = $server->accept();
   if ( !$client_sock ) {
      next if $!${ EINTR };
      die( "accept: $!\n" );
   }

   ...
}
[download]

You need to be prepared to get EINTR from system calls, though.

I could be wrong, but this smells like an XY Problem problem to me.

If you describe the bigger picture, what problem you're trying to solve, on which platform/s (Unix or Windows or both), we may be able to suggest better alternatives.

A popular alternative to a forking server in Perl is a single-threaded event-driven server.

You could have the parent send a "GO AWAY" message to the child. That would be done in sequence and not kill the child in the middle of processing something else.

Something like this:

#!/usr/bin/perl

use strict; # https://www.perlmonks.org/?node_id=11154445
use warnings;
use IO::Socket;
$SIG{__WARN__} = sub { die @_ };

my $port = 3333; # FIXME
my $listen = IO::Socket::INET->new( LocalPort => $port,
  Listen => 100, ReusePort => 1,) or die $&;

if( my $pid = fork ) # parent
  {
  print "Hit <ENTER> to quit\n";
  <STDIN>;
  print "parent starting shutdown\n";
  my $child = IO::Socket::INET->new("localhost:$port") or die $@;
  print $child "GO AWAY\n\n";
  close $child;
  print "parent waiting for child to exit\n";
  1 while wait > 0;
  print "parent exiting\n";
  exit;
  }
elsif( defined $pid ) # child
  {
  my $more = 1;
  while( $more )
    {
    my $live_socket = $listen->accept;
    if( $live_socket )
      {
      my $input = '';
      while( <$live_socket> )
        {
        $input .= $_;
        /^\r?\n?\z/ and shutdown($live_socket, 1), last;
        }
      if( $input eq "GO AWAY\n\n" )
        {
        $more = 0;
        }
      else
        {
        print "process 'do stuff' here with:\n$input";
        }
      }
    else
      {
      print "child got $!\n";
      }
    }
  print "child exiting\n";
  exit;
  }
else # bummer
  {
  die "fork failed $!";
  }
[download]

Here's another suggestion - no fork, no signals.
Works on my Linux system - I don't have a Windows system to test on...

#!/usr/bin/perl

use strict; # https://www.perlmonks.org/?node_id=11154445
use warnings;

use IO::Socket;
use IO::Select;

my $port = shift // 3333; # FIXME
my $listen = IO::Socket::INET->new( LocalPort => $port,
  Listen => 100, ReusePort => 1,) or die $&;
my $sel = IO::Select->new( $listen, *STDIN );
print "Hit <ENTER> to quit\n";
for( my $more = 1; $more; )
  {
  for my $handle ( $sel->can_read )
    {
    if( $handle eq *STDIN )
      {
      $more = 0;
      print "operator wants me to go away\n";
      }
    else
      {
      my $live_socket = $listen->accept;
      while( <$live_socket> )
        {
        # process stuff here
        print "GOT: $_";
        /^\r?\n\z/ and shutdown $live_socket, 1; # NOTE because testin
+g with GET
        }
      close $live_socket;
      }
    }
  }
[download]

my $sel = IO::Select->new( $listen, *STDIN );
[download]

IO::Select is just an OO wrapper around select, no extra magic added. So all limitiations of select still apply. If you would have read perlport (it is linked from select), you would have found this:

select

(Win32, VMS) Only implemented on sockets.

(RISC OS) Only reliable on sockets.

Note that the select FILEHANDLE form is generally portable.

So no, it won't work on Windows, because STDIN is not a socket in your code.

Alexander

--
Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)

YAATIUOWBWOL - Yet another attempt that is untested on windows but works on linux.

#!/usr/bin/perl

use strict; # https://www.perlmonks.org/?node_id=11154445
use warnings;

use IO::Socket;
use IO::Select;

my $port = 3333; # FIXME
my $childstayup = '/tmp/childstayup'; # FIXME
open my $fh, '>', $childstayup or die $!;
close $fh;
my $listen = IO::Socket::INET->new( LocalPort => $port,
  Listen => 100, ReusePort => 1,) or die $&;

if( my $pid = fork ) # parent
  {
  print "Hit <ENTER> to quit\n";
  <STDIN>;
  unlink $childstayup;
  1 while wait > 0;
  print "parent exiting\n";
  }
elsif( defined $pid ) # child
  {
  my $sel = IO::Select->new( $listen );
  while( -e $childstayup )
    {
    for ( $sel->can_read( 1 ) )
      {
      if( my $live_socket = $listen->accept )
        {
        my $input = '';
        while( <$live_socket> )
          {
          $input .= $_;
          /^\r?\n?\z/ and shutdown($live_socket, 1), last;
          }
        print "process 'do stuff' here with:\n$input";
        }
      }
    }
  print "child exiting\n";
  exit;
  }
else # bummer
  {
  die "fork failed $!";
  }
[download]

Sort of a combination of mine and yours...

UPDATE: fixed 'for' variable name

Well, lot's of things to try, but so far no luck. "$live_socket = $socket->accept();" is just blocking any other interaction.

I have found a solution, but it slightly offends me...

In the child:

    open(my $swFH, '>', 'sock_waiting') or die "Cannot open sock_waiti
+ng for write:$!\n";
    close $swFH;
    my $live_socket = $socket->accept();
    unlink('sock_waiting') or die "Cannot unlink sock_waiting:$!\n";
[download]

And in the parent:

  print "Hit <ENTER> to quit\n";
  my $quit = <STDIN>;
  while(1){
    if(-f 'sock_waiting'){
      kill 9, $fork_pid;
      print "User quit\n";
      exit;
    }
  }
[download]

So, essentially, I will kill the child and exit if the child is just waiting for a socket client to connect, but won't while it's busy.

map{$a=1-$_/10;map{$d=$a;$e=$b=$_/20-2;map{($d,$e)=(2*$d*$e+$a,$e**2
-$d**2+$b);$c=$d**2+$e**2>4?$d=8:_}1..50;print$c}0..59;print$/}0..20
[download]

Well, that's interesting - I'll have play (although I note that this might not work on Windows - (Win32) Emulated using timers that must be explicitly polled whenever Perl wants to dispatch "safe signals" and therefore cannot interrupt blocking system calls.)

map{$a=1-$_/10;map{$d=$a;$e=$b=$_/20-2;map{($d,$e)=(2*$d*$e+$a,$e**2
-$d**2+$b);$c=$d**2+$e**2>4?$d=8:_}1..50;print$c}0..59;print$/}0..20
[download]

Tom Melly, pm (at) cursingmaggot (stop) co (stop) uk

this might not work on Windows

For some light relief, an historical anecdote "explaining" why Windows does not support signals:

• Re^4: Nobody Expects the Agile Imposition (Part VI): Architecture (Signals are a crock :)

Which platform/s does your program need to run on?

this might not work on Windows

Exactly. Windows has no concept of signals. And the only way to terminate a process from the outside is a nasty trick that makes the victim process commit suicide (see Re: Handling killing the perl process).

So, are you on Windows or Unix? Knowing that inforrmation will get you more useful answers. Most answers you got so far are for Unix and won't work on Windows.

Alexander

--
Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)