summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to 'dev-perl/HTTP-Server-Simple/files/0.35-debian.patch')
-rw-r--r--dev-perl/HTTP-Server-Simple/files/0.35-debian.patch87
1 files changed, 87 insertions, 0 deletions
diff --git a/dev-perl/HTTP-Server-Simple/files/0.35-debian.patch b/dev-perl/HTTP-Server-Simple/files/0.35-debian.patch
new file mode 100644
index 000000000000..800a2667c6c2
--- /dev/null
+++ b/dev-perl/HTTP-Server-Simple/files/0.35-debian.patch
@@ -0,0 +1,87 @@
+--- a/t/01live.t
++++ b/t/01live.t
+@@ -34,11 +34,7 @@ for my $class (@classes) {
+ }
+
+
+-TODO: {
+- local $TODO = "We don't currently wait for 'server is running' responses from the client";
+- run_server_tests('SlowServer');
+-
+-}
++run_server_tests('SlowServer');
+
+
+
+--- libhttp-server-simple-perl.orig/lib/HTTP/Server/Simple.pm
++++ libhttp-server-simple-perl/lib/HTTP/Server/Simple.pm
+@@ -6,6 +6,7 @@
+ use Socket;
+ use Carp;
+ use URI::Escape;
++use IO::Select;
+
+ use vars qw($VERSION $bad_request_doc);
+ $VERSION = '0.35';
+@@ -215,15 +216,36 @@
+
+ sub background {
+ my $self = shift;
++
++ # set up a pipe so the child can tell the parent when it's ready
++ # to accept requests
++ my ($readfh, $writefh) = FileHandle::pipe;
++
+ my $child = fork;
+ die "Can't fork: $!" unless defined($child);
+- return $child if $child;
++ if ($child) { # parent
++ my $s = IO::Select->new;
++ $s->add($readfh);
++ my $now = time; my $left = 0;
++ my @ready;
++ while(not @ready and $left < 5) {
++ @ready = $s->can_read($left);
++ $left = time - $now;
++ }
++ die("child unresponsive for 5 seconds") if(not @ready);
++ my $response = <$readfh>;
++ chomp $response;
++ die("child is confused: answer '$response' != 'OK'")
++ if $response ne "OK";
++ return $child;
++ }
+
+ if ( $^O !~ /MSWin32/ ) {
+ require POSIX;
+ POSIX::setsid()
+ or die "Can't start a new session: $!";
+ }
++ $self->{_parent_handle} = $writefh;
+ $self->run(@_);
+ }
+
+@@ -270,6 +292,7 @@
+ $self->after_setup_listener();
+ *{"$pkg\::run"} = $self->_default_run;
+ }
++ $self->_maybe_tell_parent();
+
+ local $SIG{HUP} = sub { $SERVER_SHOULD_RUN = 0; };
+
+@@ -407,6 +430,15 @@
+ }
+ }
+
++sub _maybe_tell_parent {
++ # inform the parent process that we're ready, if applicable
++ my $self = shift;
++ my $handle = $self->{_parent_handle};
++ return if !$handle;
++ print $handle "OK\n";
++ close $handle;
++ delete $self->{_parent_handle};
++}
+
+
+