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.
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?)
For the most part, you'll probably just be using APR::POLLIN.
For an example of usage, check out
t/protocol/TestProtocol/echo_nonblocking.pm. Or, in a pinch:
use Apache::Connection ();
use APR::Socket ();
use APR::Poll ();
use APR::Const -compile qw(POLLIN SUCCESS TIMEUP);
# Assume $c is an Apache::Connection
my $s = $c->client_socket();
# Wait up to one second to see if inbound data is waiting on the
# socket:
my $rc = APR::Poll->poll($c->pool, $s, 1_000_000, APR::POLLIN);
if($rc == APR::TIMEUP) {
# No data was available before our 1 second ran out
elsif($rc == APR::SUCCESS) {
# Ahaa -- data is available. Now we can receive on the socket.
$s->recv(...);
}
Now, onwards with Apache::SMTP!
diff mod_perl-1.99_16/t/protocol/TestProtocol/echo_nonblock.pm
mod_perl-1.99_16.withpoll/t/protocol/TestProtocol/echo_nonblock.pm
--- mod_perl-1.99_16/t/protocol/TestProtocol/echo_nonblock.pm Wed Dec 31 16:00:00
1969
+++ mod_perl-1.99_16.withpoll/t/protocol/TestProtocol/echo_nonblock.pm Fri Aug 27
21:31:49 2004
@@ -0,0 +1,64 @@
+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::Const -compile => 'OK';
+use APR::Const -compile => qw(SO_NONBLOCK TIMEUP SUCCESS POLLIN);
+
+use constant BUFF_LEN => 1024;
+
+sub handler {
+ my Apache::Connection $c = shift;
+ my APR::Socket $socket = $c->client_socket;
+
+ # 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";
+ }
+
+ 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) {
+ my $buf;
+ if($socket->recv($buf, BUFF_LEN)) {
+ warn "no timeout";
+ $socket->send($buf);
+ }
+ else {
+ last;
+ }
+ }
+ elsif($rc == APR::TIMEUP) {
+ warn "timeout";
+ $socket->send("TIMEUP\n");
+ }
+ else {
+ die "poll error: $rc: " . APR::Error::strerror($rc);
+ }
+ }
+
+ Apache::OK;
+}
+
+1;
diff mod_perl-1.99_16/t/protocol/echo_nonblock.t
mod_perl-1.99_16.withpoll/t/protocol/echo_nonblock.t
--- mod_perl-1.99_16/t/protocol/echo_nonblock.t Wed Dec 31 16:00:00 1969
+++ mod_perl-1.99_16.withpoll/t/protocol/echo_nonblock.t Fri Aug 27 21:32:44
2004
@@ -0,0 +1,27 @@
+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";
+$reply = <$socket>;
+chomp($reply);
+ok t_cmp($reply, 'nonblocking');
+
+# 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');
+
diff mod_perl-1.99_16/xs/APR/Poll/APR__Poll.h
mod_perl-1.99_16.withpoll/xs/APR/Poll/APR__Poll.h
--- mod_perl-1.99_16/xs/APR/Poll/APR__Poll.h Wed Dec 31 16:00:00 1969
+++ mod_perl-1.99_16.withpoll/xs/APR/Poll/APR__Poll.h Fri Aug 27 21:17:12 2004
@@ -0,0 +1,49 @@
+/* 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
+int mpxs_apr_poll(pTHX_ 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;
+ apr_status_t rv;
+
+ /* 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 */
+ rv = apr_poll(&fd, 1, &nsds, timeout);
+
+ return rv;
+}
diff mod_perl-1.99_16/xs/maps/apr_functions.map
mod_perl-1.99_16.withpoll/xs/maps/apr_functions.map
--- mod_perl-1.99_16/xs/maps/apr_functions.map Fri Aug 20 14:11:00 2004
+++ mod_perl-1.99_16.withpoll/xs/maps/apr_functions.map Fri Aug 27 21:46:41 2004
@@ -635,3 +635,8 @@
-apr_os_proc_mutex_put
-apr_os_shm_get
-apr_os_shm_put
+
+MODULE=APR::Poll
+ apr_poll | mpxs_ | \
+ SV *:CLASS, apr_pool_t *:pool, apr_socket_t *:socket, \
+ apr_interval_time_t:timeout, apr_int16_t:reqevents | poll
--
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
