Mailing-List: contact modperl-cvs-help@perl.apache.org; run by ezmlm
Precedence: bulk
Reply-To: dev@perl.apache.org
Date: 8 Sep 2004 00:42:02 -0000
Message-ID: <20040908004202.91823.qmail@minotaur.apache.org>
From: stas@apache.org
To: modperl-2.0-cvs@apache.org
Subject: cvs commit: modperl-2.0 Changes

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 <ksimpson@larch.mailchannels.com>
  
  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
  +<ksimpson@larch.mailchannels.com>]
  +
   Fix the error message when the minimal required httpd version is not
   satisfied [Pratik <pratiknaik@gmail.com>]