Gecko [ www.thearyasamaj.org ]

Name	Size	Permission
LoadTester.pl	3.79 KB	-rw-r--r--
connection_test.pl	3.31 KB	-rw-r--r--
httpd	3.36 KB	-rw-r--r--
samplechat.pl	4.63 KB	-rw-r--r--
sigtest.pl	3.29 KB	-rw-r--r--
udp_server.pl	2.84 KB	-rw-r--r--

Code Editor : sigtest.pl

#!/usr/bin/perl -w

=head1 NAME

sigtest.pl - test for safe/unsafe signal handling

=head1 SYNOPSIS

sigtest.pl SIGNAME SAFE|UNSAFE

# (SIGNAME is a standard signal - default is USR1)
    # (SAFE will use Net::Server::SIG, UNSAFE uses \$SIG{} - default is SAFE)
    # If the child isn't saying anything, the test is invalid.
    # If the child dies, look for a core file.

# The process will run until it dies or you kill it

=head1 DESCRIPTION

Recent versions of Perl (5.8 ish) have much better signal handling
so the safe signal handling may not be necessary.  But on older versions
of Perl the safe signal handling was necessary.  It still doesn't hurt to
use some of the safer practices on newer Perls.

=cut

use IO::Select ();
use IO::Socket ();
use Net::Server::SIG qw(register_sig check_sigs);
use POSIX ();

print "Usage: $0 SIGNAME SAFE|UNSAFE
  (SIGNAME is a standard signal - default is USR1)
  (SAFE will use Net::Server::SIG, UNSAFE uses \$SIG{} - default is SAFE)
  If the child isn't saying anything, the test is invalid.
  If the child dies, look for a core file.
";

my $SIG = shift() || 'USR1';
my $safe = shift() || 'SAFE';
$safe = uc($safe) eq 'UNSAFE' ? undef : 1;
my $x = 0;
my %hash = ();

### set up a pipe
pipe(READ,WRITE);
READ->autoflush(1);
WRITE->autoflush(1);
STDOUT->autoflush(1);

my $pid = fork();
die "Couldn't fork [$!]" unless defined $pid;

### see if child left
$SIG{CHLD} = sub {
  print "P ($$): Child died (\$?=$?)\n"
    while (waitpid(-1, POSIX::WNOHANG()) > 0);
};

### let the parent try to kill the child
if( $pid ){

sleep(2);

### for off children to help bombard the child
  for(1..4){
    my $pid2 = fork();
    unless( defined $pid2 ){
      kill 9, $pid;
      die "Couldn't fork [$!]";
    }
    unless( $pid2 ){
      $SIG{CHLD} = 'DEFAULT';
      last;
    }
  }

print "P ($$): Starting up!\n";

### kill the child with that signal
  my $n = 50000;
  while (1){
    last unless kill $SIG, $pid;
    unless( ++$x % $n ){
      print "P ($$): $x SIG_$SIG\'s sent.\n";
      print WRITE "$n\n";
    }
  }

### let the child try to stay alive
}else{

print "C ($$): Starting up!\n";

my $select = IO::Select->new();
  $select->add(\*READ);

### do some variable manipulation in the signal handler
  my $subroutine = sub {
    $hash{foo} = "abcde"x10000;
    $hash{bar} ++;
    delete $hash{baz};
    delete $hash{bar};
  };

### register a signal and see if it will bounce off of the can_read
  if( $safe ){
    print "C ($$): Using SAFE signal handler.\n";
    register_sig($SIG => $subroutine);

### This is an unsafe signal handler. See how long
  ### it can take signals.
  }else{
    print "C ($$): Using UNSAFE signal handler.\n";
    $SIG{$SIG} = $subroutine;

}

my $total = 0;

### loop forever trying to stay alive
  while ( 1 ){

my @fh = $select->can_read(10);

my $key;
    my $val;

### this is the handler for safe (fine under unsafe also)
    next if check_sigs() && ! @fh;

### do some hash manipulation
    delete $hash{foo};
    $hash{bar} = 0;
    $hash{baz} = "abcde"x100000;

next unless @fh;
    my $line = <READ>;
    chomp($line);
    $total += $line;
    print "C ($$): P said \"$line\"\n";
    
    unless( ++$x % 5 ){
      print "C ($$): $x lines read. $total SIG's received\n";
    }
  }

print "Child is done\n";
}

${this.title}

Code Editor : sigtest.pl