stas 2004/09/07 17:42:02
Modified: xs/APR/Socket APR__Socket.h
xs/maps apr_functions.map
xs/tables/current/ModPerl FunctionTable.pm
. Changes
Added: t/protocol echo_nonblock.t
t/protocol/TestProtocol echo_nonblock.pm
Log:
Introduce APR::Socket::poll to poll a non-blocking socket + test
Submitted by: Ken Simpson <[EMAIL PROTECTED]>
Revision Changes Path
1.1 modperl-2.0/t/protocol/echo_nonblock.t
Index: echo_nonblock.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Test;
use Apache::TestUtil;
use Apache::TestRequest ();
plan tests => 3;
my $socket = Apache::TestRequest::vhost_socket('TestProtocol::echo_nonblock');
ok $socket;
my $received;
my $expected;
$expected = "nonblocking";
print $socket "$expected\n";
chomp($received = <$socket> || '');
ok t_cmp $received, $expected, "no timeout";
# now get a timed out request
$expected = "TIMEUP";
print $socket "should timeout\n";
chomp($received = <$socket> || '');
ok t_cmp $received, $expected, "timed out";
1.1 modperl-2.0/t/protocol/TestProtocol/echo_nonblock.pm
Index: echo_nonblock.pm
===================================================================
package TestProtocol::echo_nonblock;
# this test reads from/writes to the socket doing nonblocking IO
use strict;
use warnings FATAL => 'all';
use Apache::Connection ();
use APR::Socket ();
use APR::Error ();
use Apache::TestTrace;
use Apache::Const -compile => 'OK';
use APR::Const -compile => qw(SO_NONBLOCK TIMEUP SUCCESS POLLIN
ECONNABORTED);
use constant BUFF_LEN => 1024;
sub handler {
my $c = shift;
my $socket = $c->client_socket;
$socket->opt_set(APR::SO_NONBLOCK => 1);
my $counter = 0;
my $timeout = 0;
while (1) {
debug "counter: $counter";
if ($counter == 1) {
# this will certainly cause timeout
$timeout = 0;
} else {
# Wait up to ten seconds for data to arrive.
$timeout = 10_000_000;
}
$counter++;
my $rc = $socket->poll($c->pool, $timeout, APR::POLLIN);
if ($rc == APR::SUCCESS) {
my $buf;
my $len = eval { $socket->recv($buf, BUFF_LEN) };
if ($@) {
die $@ unless ref $@ eq 'APR::Error'
&& $@ == APR::ECONNABORTED; # rethrow
# ECONNABORTED is not an application error
# XXX: we don't really test that we always get this
# condition, since it depends on the timing of the
# client closing the socket. may be it'd be possible
# to make sure that APR::ECONNABORTED was received
# when $counter == 2 if we have slept enough, but how
# much is enough is unknown
debug "caught '104: Connection reset by peer' error";
last;
}
last unless $len;
debug "sending: $buf";
$socket->send($buf);
}
elsif ($rc == APR::TIMEUP) {
debug "timeout";
$socket->send("TIMEUP\n");
}
else {
die "poll error: $rc: " . APR::Error::strerror($rc);
}
}
Apache::OK;
}
1;
1.12 +19 -0 modperl-2.0/xs/APR/Socket/APR__Socket.h
Index: APR__Socket.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Socket/APR__Socket.h,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -u -r1.11 -r1.12
--- APR__Socket.h 9 Jun 2004 14:46:22 -0000 1.11
+++ APR__Socket.h 8 Sep 2004 00:42:02 -0000 1.12
@@ -96,3 +96,22 @@
MP_RUN_CROAK(apr_socket_opt_set(socket, opt, val),
"APR::Socket::opt_set");
}
+
+static MP_INLINE
+apr_status_t mpxs_APR__Socket_poll(apr_socket_t *socket,
+ apr_pool_t *pool,
+ apr_interval_time_t timeout,
+ apr_int16_t reqevents)
+{
+ apr_pollfd_t fd;
+ apr_int32_t nsds;
+
+ /* what to poll */
+ fd.p = pool;
+ fd.desc_type = APR_POLL_SOCKET;
+ fd.desc.s = socket;
+ fd.reqevents = reqevents;
+ fd.rtnevents = 0; /* XXX: not really necessary to set this */
+
+ return apr_poll(&fd, 1, &nsds, timeout);
+}
1.86 +1 -0 modperl-2.0/xs/maps/apr_functions.map
Index: apr_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.85
retrieving revision 1.86
diff -u -u -r1.85 -r1.86
--- apr_functions.map 25 Aug 2004 22:32:01 -0000 1.85
+++ apr_functions.map 8 Sep 2004 00:42:02 -0000 1.86
@@ -72,6 +72,7 @@
-apr_socket_sendfile
-apr_socket_sendv
!apr_socket_from_file
+ mpxs_APR__Socket_poll
MODULE=APR::SockAddr
!apr_sockaddr_info_get
1.177 +23 -1 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.176
retrieving revision 1.177
diff -u -u -r1.176 -r1.177
--- FunctionTable.pm 25 Aug 2004 22:32:01 -0000 1.176
+++ FunctionTable.pm 8 Sep 2004 00:42:02 -0000 1.177
@@ -2,7 +2,7 @@
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# ! WARNING: generated by ModPerl::ParseSource/0.01
-# ! Wed Aug 25 14:56:13 2004
+# ! Mon Aug 30 22:40:23 2004
# ! do NOT edit, any changes will be lost !
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5574,6 +5574,28 @@
{
'type' => 'apr_int32_t',
'name' => 'val'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'apr_status_t',
+ 'name' => 'mpxs_APR__Socket_poll',
+ 'args' => [
+ {
+ 'type' => 'apr_socket_t *',
+ 'name' => 'socket'
+ },
+ {
+ 'type' => 'apr_pool_t *',
+ 'name' => 'pool'
+ },
+ {
+ 'type' => 'apr_interval_time_t',
+ 'name' => 'timeout'
+ },
+ {
+ 'type' => 'apr_int16_t',
+ 'name' => 'reqevents'
}
]
},
1.473 +3 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.472
retrieving revision 1.473
diff -u -u -r1.472 -r1.473
--- Changes 6 Sep 2004 15:52:28 -0000 1.472
+++ Changes 8 Sep 2004 00:42:02 -0000 1.473
@@ -12,6 +12,9 @@
=item 1.99_17-dev
+Introduce APR::Socket::poll to poll a non-blocking socket [Ken Simpson
+<[EMAIL PROTECTED]>]
+
Fix the error message when the minimal required httpd version is not
satisfied [Pratik <[EMAIL PROTECTED]>]
