1# -*- perl -*-
2#
3
4require 5.004;
5use strict;
6use IO::Socket ();
7use Config ();
8use Net::Daemon::Test ();
9use Fcntl ();
10use Config ();
11
12
13my $debug = 0;
14my $dh;
15if ($debug) {
16    $dh = Symbol::gensym();
17    open($dh, ">", "forkm.log") or die "Failed to open forkm.log: $!";
18}
19
20sub log($) {
21    my $msg = shift;
22    print $dh "$$: $msg\n" if $dh;
23}
24
25&log("Start");
26my $ok;
27eval {
28  if ($^O ne "MSWin32") {
29    my $pid = fork();
30    if (defined($pid)) {
31      if (!$pid) { exit 0; } # Child
32    }
33    wait;
34    $ok = 1;
35  }
36};
37if (!$ok) {
38  &log("!ok");
39  print "1..0\n";
40  exit;
41}
42
43
44$| = 1;
45$^W = 1;
46
47
48my($handle, $port);
49if (@ARGV) {
50    $port = shift @ARGV;
51} else {
52    ($handle, $port) = Net::Daemon::Test->Child
53	(10, $^X, '-Iblib/lib', '-Iblib/arch', 't/server',
54	 '--mode=fork', 'logfile=stderr', 'debug');
55}
56
57
58sub IsNum {
59    my $str = shift;
60    (defined($str)  &&  $str =~ /(\d+)/) ? $1 : undef;
61}
62
63
64sub ReadWrite {
65    my $fh = shift; my $i = shift; my $j = shift;
66    &log("ReadWrite: -> fh=$fh, i=$i, j=$j");
67    if (!$fh->print("$j\n")  ||  !$fh->flush()) {
68	die "Child $i: Error while writing $j: " . $fh->error() . " ($!)";
69    }
70    my $line = $fh->getline();
71    &log("ReadWrite: line=$line");
72    die "Child $i: Error while reading: " . $fh->error() . " ($!)"
73	unless defined($line);
74    my $num;
75    die "Child $i: Cannot parse result: $line"
76	unless defined($num = IsNum($line));
77    die "Child $i: Expected " . ($j*2) . ", got $num"
78	unless $j*2 == $num;
79    &log("ReadWrite: <-");
80}
81
82
83sub MyChild {
84    my $i = shift;
85
86    &log("MyChild: -> $i");
87
88    eval {
89	my $fh = IO::Socket::INET->new('PeerAddr' => '127.0.0.1',
90				       'PeerPort' => $port);
91	if (!$fh) {
92	    &log("MyChild: Cannot connect: $!");
93	    die "Cannot connect: $!";
94	}
95	for (my $j = 0;  $j < 1000;  $j++) {
96	    ReadWrite($fh, $i, $j);
97	}
98    };
99    if ($@) {
100	print STDERR "Client: Error $@\n";
101	&log("MyChild: Client: Error $@");
102	return 0;
103    }
104    &log("MyChild: <-");
105    return 1;
106}
107
108
109sub ShowResults {
110    &log("ShowResults: ->");
111    my @results;
112    for (my $i = 1;  $i <= 10;  $i++) {
113	$results[$i-1] = "not ok $i\n";
114    }
115    if (open(LOG, "<log")) {
116	while (defined(my $line = <LOG>)) {
117	    if ($line =~ /(\d+)/) {
118		$results[$1-1] = $line;
119	    }
120	}
121    }
122    for (my $i = 1;  $i <= 10;  $i++) {
123	print $results[$i-1];
124    }
125    &log("ShowResults: <-");
126    exit 0;
127}
128
129my %childs;
130sub CatchChild {
131    &log("CatchChild: ->");
132    for(;;) {
133	my $pid = wait;
134	if ($pid > 0) {
135	    &log("CatchChild: $pid");
136	    if (exists $childs{$pid}) {
137		delete $childs{$pid};
138                if (keys(%childs) == 0) {
139                    # We ae done when the last of our ten childs are gone.
140                    ShowResults();
141                    last;
142		}
143	    }
144	}
145    }
146    $SIG{'CHLD'} = \&CatchChild;
147    &log("CatchChild: <-");
148}
149$SIG{'CHLD'} = \&CatchChild;
150
151# Spawn 10 childs, each of them running a series of test
152unlink "log";
153&log("Spawning childs");
154for (my $i = 0;  $i < 10;  $i++) {
155    if (defined(my $pid = fork())) {
156	if ($pid) {
157	    # This is the parent
158	    $childs{$pid} = $i;
159	} else {
160	    &log("Child starting");
161	    # This is the child
162	    undef $handle;
163	    %childs = ();
164	    my $result = MyChild($i);
165	    my $fh = Symbol::gensym();
166	    if (!open($fh, ">>log")  ||  !flock($fh, 2)  ||
167		!seek($fh, 0, 2)  ||
168		!(print $fh (($result ? "ok " : "not ok "), ($i+1), "\n"))  ||
169		!close($fh)) {
170		print STDERR "Error while writing log file: $!\n";
171		exit 1;
172	    }
173	    exit 0;
174	}
175    } else {
176	print STDERR "Failed to create new child: $!\n";
177	exit 1;
178    }
179}
180
181my $secs = 120;
182while ($secs > 0) {
183    $secs -= sleep $secs;
184}
185
186END {
187    &log("END: -> handle=" . (defined($handle) ? $handle : "undef"));
188    if ($handle) {
189	$handle->Terminate();
190	undef $handle;
191    }
192    while (my($var, $val) = each %childs) {
193	kill 'TERM', $var;
194    }
195    %childs = ();
196    unlink "ndtest.prt";
197    &log("END: <-");
198    exit 0;
199}
200