Michael Curtis <[EMAIL PROTECTED]> writes:
> Hello, I have a LWP application that POSTs thousands of small files to
> a mod_perl server. All POSTs *under* a certain size (around 3k) seem
> to take about 200x as long as those over. In this case about 0.09
> seconds as opposed to 0.004 seconds.
>
> After much debugging I narrowed the issue down to TCP latency and
> discovered I can get around the problem by setting TCP_NODELAY on the
> socket.
The real problem here is that LWP is really bad with small POST or PUT
requests because it sends out the request-line+headers with one
package and the request content in a separate package. Because off
the Nagle algorithm (what you disabled with TCP_NODELAY) the second
package gets delayed until it is ACKed by the server, unless it's
large enough to fill a packet by itself. To make things worse if the
server doesn't send any data until the whole request is received (will
be common for servers that don't send "100 continue" responses) then
we get further delayed because of the "TCP delayed ACK algorithm" used
on the server side.
I've now applied the following patch to LWP::Protocol::http to improve
on this situation. It makes LWP try harder to pass the complete
request in a single call to syswrite.
As a quick test I tried to time:
$ua->post("http://www.activestate.com";, [foo => 1]);
from my machine in Norway. Before the patch this took 0.43s from the
request was written until the reply came back, but after it only took
0.23s. A nice improvement indeed.
BTW, this patch does not affect GET or HEAD requests since these don't
carry any content payload, so these has always been transmitted in a
single IP packet.
The patch will appear in LWP-5.805.
Regards,
Gisle
Index: lib/LWP/Protocol/http.pm
===================================================================
RCS file: /cvsroot/libwww-perl/lwp5/lib/LWP/Protocol/http.pm,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -p -r1.69 -r1.70
--- lib/LWP/Protocol/http.pm 14 Dec 2004 12:38:45 -0000 1.69
+++ lib/LWP/Protocol/http.pm 8 Dec 2005 10:28:01 -0000 1.70
@@ -1,4 +1,4 @@
-# $Id: http.pm,v 1.69 2004/12/14 12:38:45 gisle Exp $
+# $Id: http.pm,v 1.70 2005/12/08 10:28:01 gisle Exp $
#
package LWP::Protocol::http;
@@ -183,13 +183,13 @@ sub request
# Set (or override) Content-Length header
my $clen = $request_headers->header('Content-Length');
if (defined($$content_ref) && length($$content_ref)) {
- $has_content++;
- if (!defined($clen) || $clen ne length($$content_ref)) {
+ $has_content = length($$content_ref);
+ if (!defined($clen) || $clen ne $has_content) {
if (defined $clen) {
warn "Content-Length header value was wrong, fixed";
hlist_remove([EMAIL PROTECTED], 'Content-Length');
}
- push(@h, 'Content-Length' => length($$content_ref));
+ push(@h, 'Content-Length' => $has_content);
}
}
elsif ($clen) {
@@ -198,25 +198,26 @@ sub request
}
}
+ my $write_wait = 0;
+ $write_wait = 2
+ if ($request_headers->header("Expect") || "") =~ /100-continue/;
+
my $req_buf = $socket->format_request($method, $fullpath, @h);
#print "------\n$req_buf\n------\n";
- # XXX need to watch out for write timeouts
- {
+ if (!$has_content || $write_wait || $has_content > 8*1024) {
+ # XXX need to watch out for write timeouts
my $n = $socket->syswrite($req_buf, length($req_buf));
die $! unless defined($n);
die "short write" unless $n == length($req_buf);
#LWP::Debug::conns($req_buf);
+ $req_buf = "";
}
my($code, $mess, @junk);
my $drop_connection;
if ($has_content) {
- my $write_wait = 0;
- $write_wait = 2
- if ($request_headers->header("Expect") || "") =~ /100-continue/;
-
my $eof;
my $wbuf;
my $woffset = 0;
@@ -225,10 +226,17 @@ sub request
$buf = "" unless defined($buf);
$buf = sprintf "%x%s%s%s", length($buf), $CRLF, $buf, $CRLF
if $chunked;
+ substr($buf, 0, 0) = $req_buf if $req_buf;
$wbuf = \$buf;
}
else {
- $wbuf = $content_ref;
+ if ($req_buf) {
+ my $buf = $req_buf . $$content_ref;
+ $wbuf = \$buf;
+ }
+ else {
+ $wbuf = $content_ref;
+ }
$eof = 1;
}
