1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
#!/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";
}
|
