You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by Ken Simpson <ks...@larch.mailchannels.com> on 2004/09/03 20:19:39 UTC

Re: Patch to add APR::Socket->poll()

Hi Stas,
Here's the patch for APR::Poll, complete with some documentation.  I
haven't included your non-blocking protocol handler tests -- could you
paste them in when you make the commit to the tree?

Index: docs/api/APR/Socket.pod
===================================================================
RCS file: /home/cvspublic/modperl-docs/src/docs/2.0/api/APR/Socket.pod,v
retrieving revision 1.12
diff -d -u -r1.12 Socket.pod
--- docs/api/APR/Socket.pod	18 Aug 2004 01:39:32 -0000	1.12
+++ docs/api/APR/Socket.pod	3 Sep 2004 18:09:21 -0000
@@ -599,6 +599,63 @@
 
 
 
+=head2 C<poll>
+
+    $ret = $sock->poll($pool, $timeout, $events);
+
+=over 4
+
+=item obj: C<$sock>
+( C<L<APR::Socket object|docs::2.0::api::APR::Socket>> )
+
+The socket to poll
+
+=item arg1: C<$pool>
+( C<L<APR::Pool object|docs::2.0::api::APR::Pool>> )
+
+An apr_pool_t object -- in most applications, just use the pool
+provided by the
+C<L<Apache::Connection object|docs::2.0::api::Apache::Connection>>.
+
+=item arg2: C<$timeout> ( integer )
+
+The amount of time to wait (in milliseconds) for the specified events
+to occur.
+
+=item arg3: C<$events> ( integer )
+
+The events for which to wait. To wait for incoming data to be available,
+use APR::POLLIN. To wait until it's possible to write data to the socket,
+use APR::POLLOUT. And finally, to wait for priority data to become available,
+use APR::POLLPRI.
+
+=item ret: C<$ret> ( integer )
+
+=item since: 1.99_17-dev
+
+=back
+
+Examples:
+
+  use APR::Socket ();
+  use APR::Const -compile => qw(POLLIN SUCCESS TIMEUP);
+  use APR::Connection ();
+
+  my $rc = $sock->poll($connection->pool(), 1_000_000, APR::POLLIN);
+  if ($rc == APR::SUCCESS) {
+      # Data is waiting on the socket to be read.
+  }
+  elsif ($rc == APR::TIMEUP) {
+      # One second elapsed and still there is no data waiting to be
+      # read.
+  }
+  else {
+      die "something weird happened: " . APR::Error::strerror($rc);
+  } 
+
+=back
+
+
 
 
 
Index: xs/APR/Socket/APR__Socket.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/APR/Socket/APR__Socket.h,v
retrieving revision 1.11
diff -d -u -r1.11 APR__Socket.h
--- xs/APR/Socket/APR__Socket.h	9 Jun 2004 14:46:22 -0000	1.11
+++ xs/APR/Socket/APR__Socket.h	3 Sep 2004 18:09:22 -0000
@@ -96,3 +96,23 @@
     MP_RUN_CROAK(apr_socket_opt_set(socket, opt, val),
                  "APR::Socket::opt_set");
 }
+
+static MP_INLINE
+apr_int32_t mpxs_APR__Socket_poll(pTHX_ 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;
+    
+    /* 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);
+}
Index: xs/APR/aprext/Makefile.PL
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/APR/aprext/Makefile.PL,v
retrieving revision 1.5
diff -d -u -r1.5 Makefile.PL
--- xs/APR/aprext/Makefile.PL	1 Aug 2004 19:44:01 -0000	1.5
+++ xs/APR/aprext/Makefile.PL	3 Sep 2004 18:09:22 -0000
@@ -19,7 +19,7 @@
     $src{$cfile} = "$srcdir/$cfile";
 }
 
-my @skip = qw(dynamic test);
+my @skip = qw(test);
 push @skip, q{static}
     unless (Apache::Build::BUILD_APREXT);
 
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.85
diff -d -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	3 Sep 2004 18:09:22 -0000
@@ -3,16 +3,16 @@
 # 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
+? apr_poll_poll
+? 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
@@ -72,6 +72,8 @@
 -apr_socket_sendfile
 -apr_socket_sendv
 !apr_socket_from_file
+ mpxs_APR__Socket_poll | | apr_socket_t *:socket, apr_pool_t *:pool, \
+   apr_interval_time_t:timeout, apr_int16_t:reqevents
 
 MODULE=APR::SockAddr
 !apr_sockaddr_info_get
Index: xs/tables/current/Apache/ConstantsTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/Apache/ConstantsTable.pm,v
retrieving revision 1.42
diff -d -u -r1.42 ConstantsTable.pm
--- xs/tables/current/Apache/ConstantsTable.pm	13 Aug 2004 00:13:18 -0000	1.42
+++ xs/tables/current/Apache/ConstantsTable.pm	3 Sep 2004 18:09:22 -0000
@@ -2,7 +2,7 @@
 
 # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 # ! WARNING: generated by Apache::ParseSource/0.02
-# !          Thu Aug 12 17:10:15 2004
+# !          Mon Aug 30 11:29:14 2004
 # !          do NOT edit, any changes will be lost !
 # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -388,6 +388,7 @@
       'APR_DELONCLOSE'
     ],
     'error' => [
+      'APR_END',
       'APR_ENOSTAT',
       'APR_ENOPOOL',
       'APR_EBADDATE',
@@ -443,8 +444,7 @@
       'APR_EFTYPE',
       'APR_EPIPE',
       'APR_EXDEV',
-      'APR_ENOTEMPTY',
-      'APR_END'
+      'APR_ENOTEMPTY'
     ],
     'common' => [
       'APR_SUCCESS'
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.176
diff -d -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	3 Sep 2004 18:09:23 -0000
@@ -7660,6 +7660,28 @@
         'name' => 'func'
       }
     ]
+  },
+  {
+    'return_type' => 'apr_int32_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'
+      }
+    ]
   }
 ];

TTUL
Ken 


Stas Bekman [31/08/04 00:01 -0400]:
> 
> Another thing is the test. First of all it's quite possible that on a slow 
> machine the first subtest will fail, so it should probably wait much 
> longer on the first call.
> 
> Second, I'd like to see is replacing sleep 2 with something faster. The 
> test suite is already huge and adding extra sleeps adds up to a long run 
> time. I think the test can be rewritten as so:
> 
> 
> --- /dev/null	1969-12-31 19:00:00.000000000 -0500
> +++ t/protocol/echo_nonblock.t	2004-08-30 23:57:44.606577082 -0400
> @@ -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 $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";
> +
> 
> --- /dev/null	1969-12-31 19:00:00.000000000 -0500
> +++ t/protocol/TestProtocol/echo_nonblock.pm	2004-08-30 
> 23:59:25.512107442 -0400
> @@ -0,0 +1,59 @@
> +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 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);
> +
> +    my $counter = 0;
> +    my $timeout = 0;
> +    while (1) {
> +        if ($counter != 1) {
> +            # Wait up to ten seconds for data to arrive.
> +            $timeout = 10_000_000;
> +            $counter++;
> +        } elsif ($counter == 1) {
> +            # this will certainly fail
> +            $timeout = 0;
> +            $counter++;
> +        }
> +
> +        my $rc = $socket->poll($c->pool, $timeout, 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;
> 
> -- 
> __________________________________________________________________
> Stas Bekman            JAm_pH ------> Just Another mod_perl Hacker
> http://stason.org/     mod_perl Guide ---> http://perl.apache.org
> mailto:stas@stason.org http://use.perl.org http://apacheweek.com
> http://modperlbook.org http://apache.org   http://ticketmaster.com
> 
> ---------------------------------------------------------------------
> To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
> For additional commands, e-mail: dev-help@perl.apache.org
> 

-- 
MailChannels: Imagine no more spam

--
http://www.mailchannels.com
MailChannels Corporation
Suite 1600, 1188 West Georgia St.
Vancouver, BC, Canada

Ken Simpson, CEO
+1-604-729-1741

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Re: Patch to add APR::Socket->poll()

Posted by Stas Bekman <st...@stason.org>.
Ken Simpson wrote:
>>Thanks Ken. I need to do some more work on the test before I commit the 
>>whole thing. I get:
>>
>>[Fri Sep 03 19:03:07 2004] [error] APR::Socket::recv: (104) Connection 
>>reset by peer at 
>>/home/stas/apache.org/mp2-poll/t/protocol/TestProtocol/echo_nonblock.pm 
>>line 41
>>
>>when the server side while loop is entered on the 4th time and the client 
>>has gone away already. This is actually excellent, since this is the kind 
>>of error I was trying to reproduce before, when it was reported on the 
>>modperl list.
> 
> 
> I hope that it helps you to track down the problem. I haven't seen
> that bug crop up yet. If I see it under other circumstances I'll be
> sure to let you know.

It happens when a user clicks stop or reload during the request submission 
(or response). It was reported with Registry over SSL, I haven't tried 
that combination. But it doesn't matter. We just need to find a clean way 
to trap those errors and let the user handle them.

-- 
__________________________________________________________________
Stas Bekman            JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/     mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org   http://ticketmaster.com

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Re: Patch to add APR::Socket->poll()

Posted by Ken Simpson <ks...@larch.mailchannels.com>.
> Thanks Ken. I need to do some more work on the test before I commit the 
> whole thing. I get:
> 
> [Fri Sep 03 19:03:07 2004] [error] APR::Socket::recv: (104) Connection 
> reset by peer at 
> /home/stas/apache.org/mp2-poll/t/protocol/TestProtocol/echo_nonblock.pm 
> line 41
> 
> when the server side while loop is entered on the 4th time and the client 
> has gone away already. This is actually excellent, since this is the kind 
> of error I was trying to reproduce before, when it was reported on the 
> modperl list.

I hope that it helps you to track down the problem. I haven't seen
that bug crop up yet. If I see it under other circumstances I'll be
sure to let you know.

TTUL
Ken

-- 
MailChannels: Imagine no more spam

--
http://www.mailchannels.com
MailChannels Corporation
Suite 1600, 1188 West Georgia St.
Vancouver, BC, Canada

Ken Simpson, CEO
+1-604-729-1741

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Re: Patch to add APR::Socket->poll()

Posted by Stas Bekman <st...@stason.org>.
Ken Simpson wrote:
> Hi Stas,
> Here's the patch for APR::Poll, complete with some documentation.  I
> haven't included your non-blocking protocol handler tests -- could you
> paste them in when you make the commit to the tree?

Thanks Ken. I need to do some more work on the test before I commit the 
whole thing. I get:

[Fri Sep 03 19:03:07 2004] [error] APR::Socket::recv: (104) Connection 
reset by peer at 
/home/stas/apache.org/mp2-poll/t/protocol/TestProtocol/echo_nonblock.pm 
line 41

when the server side while loop is entered on the 4th time and the client 
has gone away already. This is actually excellent, since this is the kind 
of error I was trying to reproduce before, when it was reported on the 
modperl list.

-- 
__________________________________________________________________
Stas Bekman            JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/     mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org   http://ticketmaster.com

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org