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
