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
|
Author: Niko Tyni <ntyni@debian.org>
Description: fix the detach test on systems with a large socket buffer size (#584344)
--- speedy-cgi-perl.orig/speedy/t/detach.t
+++ speedy-cgi-perl/speedy/t/detach.t
@@ -6,9 +6,22 @@
use strict;
use IO::File;
+use Socket;
my $smbuf = 8 * 1024;
-my $lgbuf = 512 * 1024;
+my $lgbuf;
+
+# find out the size of the socket write buffer
+# see http://bugs.debian.org/584344
+my $s;
+if (socket($s, AF_UNIX, SOCK_STREAM, 0) &&
+ (my $packed_size = getsockopt($s, SOL_SOCKET, SO_SNDBUF))) {
+ $lgbuf = $smbuf + 2 * unpack("I", $packed_size);
+} else {
+ warn("socket() or getsockopt() failed: $!");
+}
+
+$lgbuf = 512 * 1024 if $lgbuf < 512 * 1024;
my $scr = 't/scripts/detach';
use vars qw(@open_files @pids %children);
@@ -23,7 +36,7 @@
$| = 1; print ""; $| = 0;
my $child;
if (($child = open($fh, "-|")) == 0) {
- open(F, "$ENV{SPEEDY} -- -B$sz $scr |");
+ open(F, "$ENV{SPEEDY} -- -B$sz $scr $lgbuf |");
print scalar <F>;
close(STDOUT);
sleep 60; # Simulate slow drain of output
--- speedy-cgi-perl.orig/speedy/t/scripts/detach
+++ speedy-cgi-perl/speedy/t/scripts/detach
@@ -1,3 +1,6 @@
$| = 1;
+# the data should not fit in the socket write buffer
+# see http://bugs.debian.org/584344
+my $size = shift || (512 * 1024);
print "$$\n";
-print 'x' x (500*1024);
+print 'x' x int(500 / 512 * $size);
|
GitWeb
