From modperl-cvs-return-4326-apmail-perl-modperl-cvs-archive=perl.apache.org@perl.apache.org Tue May 04 06:14:45 2004 Return-Path: Delivered-To: apmail-perl-modperl-cvs-archive@www.apache.org Received: (qmail 72168 invoked from network); 4 May 2004 06:14:45 -0000 Received: from daedalus.apache.org (HELO mail.apache.org) (208.185.179.12) by minotaur-2.apache.org with SMTP; 4 May 2004 06:14:45 -0000 Received: (qmail 72411 invoked by uid 500); 4 May 2004 06:14:22 -0000 Delivered-To: apmail-perl-modperl-cvs-archive@perl.apache.org Received: (qmail 72342 invoked by uid 500); 4 May 2004 06:14:22 -0000 Mailing-List: contact modperl-cvs-help@perl.apache.org; run by ezmlm Precedence: bulk list-help: list-unsubscribe: list-post: Reply-To: dev@perl.apache.org Delivered-To: mailing list modperl-cvs@perl.apache.org Received: (qmail 72328 invoked by uid 500); 4 May 2004 06:14:22 -0000 Delivered-To: apmail-modperl-2.0-cvs@apache.org Date: 4 May 2004 06:14:44 -0000 Message-ID: <20040504061444.72161.qmail@minotaur.apache.org> From: stas@apache.org To: modperl-2.0-cvs@apache.org Subject: cvs commit: modperl-2.0/xs/maps apr_functions.map X-Spam-Rating: daedalus.apache.org 1.6.2 0/1000/N X-Spam-Rating: minotaur-2.apache.org 1.6.2 0/1000/N stas 2004/05/03 23:14:44 Modified: t/protocol/TestProtocol echo_block.pm echo_filter.pm echo_timeout.pm eliza.pm xs/APR/Socket APR__Socket.h xs/maps apr_functions.map Log: new API for APR::Socket recv() and send() + updated tests Revision Changes Path 1.2 +6 -10 modperl-2.0/t/protocol/TestProtocol/echo_block.pm Index: echo_block.pm =================================================================== RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_block.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -u -u -r1.1 -r1.2 --- echo_block.pm 23 Apr 2004 01:37:54 -0000 1.1 +++ echo_block.pm 4 May 2004 06:14:44 -0000 1.2 @@ -12,7 +12,7 @@ use APR::Socket (); use Apache::Const -compile => 'OK'; -use APR::Const -compile => qw(SO_NONBLOCK); +use APR::Const -compile => qw(SO_NONBLOCK TIMEUP EOF); use constant BUFF_LEN => 1024; @@ -32,16 +32,12 @@ or die "failed to set non-blocking mode"; } - my ($buff, $rlen, $wlen); - for (;;) { - $rlen = BUFF_LEN; - $socket->recv($buff, $rlen); - last if $rlen <= 0; + while (1) { + my $buff = $socket->recv(BUFF_LEN); + last unless length $buff; # EOF - $wlen = $rlen; - $socket->send($buff, $wlen); - - last if $wlen != $rlen; + my $wlen = $socket->send($buff); + last if $wlen != length $buff; # write failure? } Apache::OK; 1.9 +2 -1 modperl-2.0/t/protocol/TestProtocol/echo_filter.pm Index: echo_filter.pm =================================================================== RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_filter.pm,v retrieving revision 1.8 retrieving revision 1.9 diff -u -u -r1.8 -r1.9 --- echo_filter.pm 7 Apr 2004 23:42:27 -0000 1.8 +++ echo_filter.pm 4 May 2004 06:14:44 -0000 1.9 @@ -7,6 +7,7 @@ use APR::Bucket (); use APR::Brigade (); use APR::Util (); +use APR::Error (); use Apache::Filter (); use APR::Const -compile => qw(SUCCESS EOF); @@ -20,7 +21,7 @@ for (;;) { my $rv = $c->input_filters->get_brigade($bb, Apache::MODE_GETLINE); if ($rv != APR::SUCCESS && $rv != APR::EOF) { - my $error = APR::strerror($rv); + my $error = APR::Error::strerror($rv); warn __PACKAGE__ . ": get_brigade: $error\n"; last; } 1.2 +13 -10 modperl-2.0/t/protocol/TestProtocol/echo_timeout.pm Index: echo_timeout.pm =================================================================== RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_timeout.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -u -u -r1.1 -r1.2 --- echo_timeout.pm 23 Apr 2004 01:37:54 -0000 1.1 +++ echo_timeout.pm 4 May 2004 06:14:44 -0000 1.2 @@ -24,18 +24,21 @@ # read/write timeouts $socket->timeout_set(20_000_000); - my ($buff, $rlen, $wlen, $rc); - for (;;) { - $rlen = BUFF_LEN; - $rc = $socket->recv($buff, $rlen); - die "timeout on socket read" if $rc == APR::TIMEUP; - last if $rlen <= 0; + while (1) { + my $buff = eval { $socket->recv(BUFF_LEN) }; + if ($@) { + die "timed out, giving up: $@" if $@ == APR::TIMEUP; + die $@; + } - $wlen = $rlen; - $rc = $socket->send($buff, $wlen); - die "timeout on socket write" if $rc == APR::TIMEUP; + last unless length $buff; # EOF - last if $wlen != $rlen; + my $wlen = eval { $socket->send($buff) }; + if ($@) { + die "timed out, giving up: $@" if $@ == APR::TIMEUP; + die $@; + } + last if $wlen != length $buff; # write failure? } Apache::OK; 1.6 +5 -8 modperl-2.0/t/protocol/TestProtocol/eliza.pm Index: eliza.pm =================================================================== RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/eliza.pm,v retrieving revision 1.5 retrieving revision 1.6 diff -u -u -r1.5 -r1.6 --- eliza.pm 14 Jun 2002 10:06:16 -0000 1.5 +++ eliza.pm 4 May 2004 06:14:44 -0000 1.6 @@ -18,19 +18,16 @@ my Apache::Connection $c = shift; my APR::Socket $socket = $c->client_socket; - my $buff; my $last = 0; - for (;;) { - my($rlen, $wlen); - $rlen = BUFF_LEN; - $socket->recv($buff, $rlen); - last if $rlen <= 0; - + while (1) { + my $buff = $socket->recv(BUFF_LEN); + last unless length $buff; # EOF + # \r is sent instead of \n if the client is talking over telnet $buff =~ s/[\r\n]*$//; $last++ if $buff eq "Good bye, Eliza"; $buff = $mybot->transform( $buff ) . "\n"; - $socket->send($buff, length $buff); + $socket->send($buff); last if $last; } 1.8 +25 -21 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.7 retrieving revision 1.8 diff -u -u -r1.7 -r1.8 --- APR__Socket.h 23 Apr 2004 18:00:32 -0000 1.7 +++ APR__Socket.h 4 May 2004 06:14:44 -0000 1.8 @@ -14,42 +14,46 @@ */ static MP_INLINE -apr_status_t mpxs_apr_socket_recv(pTHX_ apr_socket_t *socket, - SV *sv_buf, SV *sv_len) +SV *mpxs_APR__Socket_recv(pTHX_ apr_socket_t *socket, int len) { - apr_status_t status; - apr_size_t len = mp_xs_sv2_apr_size_t(sv_len); + SV *buf = NEWSV(0, len); + apr_status_t rc = apr_socket_recv(socket, SvPVX(buf), &len); - mpxs_sv_grow(sv_buf, len); - status = apr_socket_recv(socket, SvPVX(sv_buf), &len); - mpxs_sv_cur_set(sv_buf, len); - - if (!SvREADONLY(sv_len)) { - sv_setiv(sv_len, len); + if (len > 0) { + mpxs_sv_cur_set(buf, len); + SvTAINTED_on(buf); + } + else if (rc == APR_EOF) { + sv_setpvn(buf, "", 0); } - - return status; + else if (rc != APR_SUCCESS) { + SvREFCNT_dec(buf); + modperl_croak(aTHX_ rc, "APR::Socket::recv"); + } + + return buf; } static MP_INLINE -apr_status_t mpxs_apr_socket_send(pTHX_ apr_socket_t *socket, - SV *sv_buf, SV *sv_len) +apr_size_t mpxs_apr_socket_send(pTHX_ apr_socket_t *socket, + SV *sv_buf, SV *sv_len) { - apr_status_t status; apr_size_t buf_len; char *buffer = SvPV(sv_buf, buf_len); if (sv_len) { + if (buf_len < SvIV(sv_len)) { + Perl_croak(aTHX_ "the 3rd arg (%d) is bigger than the " + "length (%d) of the 2nd argument", + SvIV(sv_len), buf_len); + } buf_len = SvIV(sv_len); } - status = apr_socket_send(socket, buffer, &buf_len); - - if (sv_len && !SvREADONLY(sv_len)) { - sv_setiv(sv_len, buf_len); - } + MP_RUN_CROAK(apr_socket_send(socket, buffer, &buf_len), + "APR::Socket::send"); - return status; + return buf_len; } static MP_INLINE 1.73 +6 -2 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.72 retrieving revision 1.73 diff -u -u -r1.72 -r1.73 --- apr_functions.map 23 Apr 2004 18:00:32 -0000 1.72 +++ apr_functions.map 4 May 2004 06:14:44 -0000 1.73 @@ -44,7 +44,8 @@ !apr_socket_accept apr_socket_listen apr_socket_connect - apr_socket_recv | mpxs_ | sock, SV *:buf, SV *:len +-apr_socket_recv | mpxs_ + mpxs_APR__Socket_recv apr_socket_recvfrom apr_socket_send | mpxs_ | sock, SV *:buf, SV *:len=Nullsv apr_socket_sendto @@ -455,7 +456,10 @@ -apr_vsnprintf # only available if APR_HAS_RANDOM -apr_generate_random_bytes - apr_strerror | MPXS_ | statcode + +MODULE=APR::Error +-apr_strerror + char *:DEFINE_strerror | | apr_status_t:rc !MODULE=APR::General -apr_app_initialize