This patch provides basic support for the apr_poll function. It's my first ever work on the guts of mod_perl, so please let me know if there are obvious things that need to be changed or reorganized to fit the mould.
It's good, Ken. I've done some tweaks (mostly style) and pasted a cleaned up version below.
- please post those to the dev list in the future - please use cvs diff to generate patches if possible - please use the style guide http://perl.apache.org/docs/2.0/devel/core/coding_style.html
The APR::Poll::poll method takes four parameters:
pool: an Apache::Pool socket: the Apache::Socket that you want to poll timeout: the number of microseconds to wait for data reqevents: a bitmap specifying the kinds of events for which you'd like to poll. APR::POLLIN - ready to read (i.e. inbound data has arrived) APR::POLLOUT - ready to write APR::POLLPRI - priority data available APR::POLLERR - an error is pending APR::POLLHUP - hangup occurred APR::POLLNVAL - invalid descriptor (what?)
I was thinking, would it be better to make it an APR::Socket method?
$socket->poll($c->pool, 1_000_000, APR::POLLIN);
looks more intuitive to me. Especially since you've hardcoded the fd type to be socket:
fd.desc_type = APR_POLL_SOCKET;
diff mod_perl-1.99_16/t/protocol/TestProtocol/echo_nonblock.pm mod_perl-1.99_16.withpoll/t/protocol/TestProtocol/echo_nonblock.pm
+ # starting from Apache 2.0.49 several platforms require you to set
+ # the socket to a blocking IO mode
+ my $nonblocking = $socket->opt_get(APR::SO_NONBLOCK);
+ unless($nonblocking) {
+ $socket->opt_set(APR::SO_NONBLOCK => 1);
+
+ # test that we really *are* in the blocking mode
+ $socket->opt_get(APR::SO_NONBLOCK)
+ or die "failed to set nonblocking mode";
+ }
I've replaced that with an explicit setting to a non-blocking mode.
Here is the patch:
Index: xs/maps/apr_functions.map =================================================================== RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v retrieving revision 1.85 diff -u -u -r1.85 apr_functions.map --- xs/maps/apr_functions.map 25 Aug 2004 22:32:01 -0000 1.85 +++ xs/maps/apr_functions.map 28 Aug 2004 14:03:03 -0000 @@ -3,16 +3,18 @@ # for mapping see %ModPerl::MapUtil::disabled_map in # lib/ModPerl/MapUtil.pm
-!MODULE=APR::Poll - apr_poll_socket_add - apr_poll_socket_clear - apr_poll_data_get - apr_poll_revents_get - apr_poll_socket_mask - apr_poll - apr_poll_socket_remove - apr_poll_data_set - apr_poll_setup +MODULE=APR::Poll + mpxs_APR__Poll_poll | | SV *:CLASS, apr_pool_t *:pool, \ + apr_socket_t *:socket, apr_interval_time_t:timeout, \ + apr_int16_t:reqevents +? apr_poll_socket_add +? apr_poll_socket_clear +? apr_poll_data_get +? apr_poll_revents_get +? apr_poll_socket_mask +? apr_poll_socket_remove +? apr_poll_data_set +? apr_poll_setup
!MODULE=APR::Time
-apr_ctime
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.176
diff -u -u -r1.176 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 25 Aug 2004 22:32:01 -0000 1.176
+++ xs/tables/current/ModPerl/FunctionTable.pm 28 Aug 2004 14:03:03 -0000
@@ -2,7 +2,7 @@
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! # ! WARNING: generated by ModPerl::ParseSource/0.01 -# ! Wed Aug 25 14:56:13 2004 +# ! Sat Aug 28 09:47:20 2004 # ! do NOT edit, any changes will be lost ! # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5516,6 +5516,32 @@
{
'type' => 'apr_pool_t *',
'name' => 'p'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'apr_status_t',
+ 'name' => 'mpxs_APR__Poll_poll',
+ 'args' => [
+ {
+ 'type' => 'SV *',
+ 'name' => 'CLASS'
+ },
+ {
+ 'type' => 'apr_pool_t *',
+ 'name' => 'pool'
+ },
+ {
+ 'type' => 'apr_socket_t *',
+ 'name' => 'socket'
+ },
+ {
+ 'type' => 'apr_interval_time_t',
+ 'name' => 'timeout'
+ },
+ {
+ 'type' => 'apr_int16_t',
+ 'name' => 'reqevents'
}
]
},--- /dev/null 1969-12-31 19:00:00.000000000 -0500
+++ t/protocol/echo_nonblock.t 2004-08-28 09:31:49.481052060 -0400
@@ -0,0 +1,26 @@
+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 $reply;
+
+print $socket "nonblocking\n";
+chomp($reply = <$socket> || '');
+ok t_cmp $reply, 'nonblocking', "no timeout";
+
+# Wait two seconds so that the server will time out.
+sleep 2;
+
+print $socket "should timeout\n";
+chomp($reply = <$socket> || '');
+ok t_cmp $reply, 'TIMEUP', "timed out";
+
--- /dev/null 1969-12-31 19:00:00.000000000 -0500
+++ t/protocol/TestProtocol/echo_nonblock.pm 2004-08-28 09:58:18.955647897 -0400
@@ -0,0 +1,51 @@
+package TestProtocol::echo_nonblock;
+
+# this test reads from/writes to the socket doing nonblocking IO
+# using the APR::Poll interface.
+#
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Connection ();
+use APR::Socket ();
+use APR::Poll ();
+
+use Apache::TestTrace;
+
+use Apache::Const -compile => 'OK';
+use APR::Const -compile => qw(SO_NONBLOCK TIMEUP SUCCESS POLLIN);
+
+use constant BUFF_LEN => 1024;
+
+sub handler {
+ my $c = shift;
+ my $socket = $c->client_socket;
+
+ $socket->opt_set(APR::SO_NONBLOCK => 1);
+ while (1) {
+ # Wait up to one second for data to arrive.
+ my $rc = APR::Poll->poll($c->pool, $socket,
+ 1_000_000, APR::POLLIN);
+ if ($rc == APR::SUCCESS) {
+ if ($socket->recv(my $buf, BUFF_LEN)) {
+ debug "no timeout";
+ $socket->send($buf);
+ }
+ else {
+ last;
+ }
+ }
+ elsif ($rc == APR::TIMEUP) {
+ debug "timeout";
+ $socket->send("TIMEUP\n");
+ }
+ else {
+ die "poll error: $rc: " . APR::Error::strerror($rc);
+ }
+ }
+
+ Apache::OK;
+}
+
+1;
--- /dev/null 1969-12-31 19:00:00.000000000 -0500 +++ xs/APR/Poll/APR__Poll.h 2004-08-28 09:52:53.208612601 -0400 @@ -0,0 +1,46 @@ +/* Copyright 2004 MailChannels Corporation + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + */ + +/* This is a very simplistic implementation of the APR::Poll interface. + * We only expose a bastardized version of the apr_poll() function, which + * in this case just allows you to poll one particular socket with + * a combination of polling options and a specified timeout. + * + * The pollset_* methods have not been included (they allow you to poll + * multiple sockets at one time. Nor has the ability to poll a file been + * provided because it's assumed that within, say, a protocol handler, + * you'd probably never need to. + * + * -- Ken Simpson, August 27, 2004. <[EMAIL PROTECTED]> + */ + +static MP_INLINE +apr_status_t mpxs_APR__Poll_poll(SV *CLASS, apr_pool_t *pool, + apr_socket_t *socket, apr_interval_time_t timeout, + apr_int16_t reqevents) +{ + apr_pollfd_t fd; + apr_int32_t nsds; + + /* Set up the aprset parameter, which tells apr_poll what to poll */ + fd.desc_type = APR_POLL_SOCKET; + fd.reqevents = reqevents; + fd.rtnevents = 0; /* XXX: not really necessary to set this */ + fd.p = pool; + fd.desc.s = socket; + + /* Poll the socket */ + return apr_poll(&fd, 1, &nsds, timeout); +}
-- __________________________________________________________________ Stas Bekman JAm_pH ------> Just Another mod_perl Hacker http://stason.org/ mod_perl Guide ---> http://perl.apache.org mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com http://modperlbook.org http://apache.org http://ticketmaster.com
-- Report problems: http://perl.apache.org/bugs/ Mail list info: http://perl.apache.org/maillist/modperl.html List etiquette: http://perl.apache.org/maillist/email-etiquette.html
