Skip to content

Commit bf98185

Browse files
MonsMons
committed
Return 400/413 on bad requests. Several corner-case fixes
1 parent cce4cac commit bf98185

File tree

6 files changed

+170
-44
lines changed

6 files changed

+170
-44
lines changed

‎META.json‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44
"Mons Anderson <[email protected]>"
55
],
66
"dynamic_config" : 0,
7-
"generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150001",
7+
"generated_by" : "ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010",
88
"license" : [
99
"perl_5"
1010
],
@@ -40,5 +40,6 @@
4040
}
4141
},
4242
"release_status" : "stable",
43-
"version" : "1.9999"
43+
"version" : "1.99993",
44+
"x_serialization_backend" : "JSON::PP version 2.27400"
4445
}

‎META.yml‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ build_requires:
77
configure_requires:
88
ExtUtils::MakeMaker: '0'
99
dynamic_config: 0
10-
generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150001'
10+
generated_by: 'ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010'
1111
license: perl
1212
meta-spec:
1313
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -22,4 +22,5 @@ requires:
2222
Digest::SHA1: '2'
2323
HTTP::Easy: '0.03'
2424
JSON::XS: '3'
25-
version: '1.99992'
25+
version: '1.99993'
26+
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

‎bin/simple-server‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
use strict;
44
use FindBin;
5-
use lib "$FindBin::Bin/../blib/lib";
5+
use lib "$FindBin::Bin/../lib", "$FindBin::Bin/../blib/lib";
66
use Sys::Hostname;
77
use Getopt::Long;
88
use Cwd 'cwd','abs_path';

‎lib/AnyEvent/HTTP/Server.pm‎

Lines changed: 79 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -6,8 +6,9 @@ AnyEvent::HTTP::Server - AnyEvent HTTP/1.1 Server
66
77
=cut
88

9+
our $VERSION;
910
BEGIN{
10-
our $VERSION = '1.99992';
11+
$VERSION = '1.99993';
1112
}
1213

1314
#use common::sense;
@@ -30,6 +31,7 @@ use Errno qw(EAGAIN EINTR);
3031
use AnyEvent::Util qw(WSAEWOULDBLOCK guard AF_INET6 fh_nonblocking);
3132
use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR IPPROTO_TCP TCP_NODELAY);
3233

34+
use Carp ();
3335
use Encode ();
3436
use Compress::Zlib ();
3537
use MIME::Base64 ();
@@ -54,21 +56,35 @@ my $ico_pk = pack "H*",
5456
"1d8c7e040000";
5557
our $ico = Compress::Zlib::memGunzip $ico_pk;
5658

59+
our $ERROR_TEMPLATE = <<"EOD";
60+
<html>
61+
<head><title>%1\$s %2\$s</title></head>
62+
<body bgcolor="white">
63+
<center><h1>%1\$s %2\$s</h1></center>
64+
<hr><center>${\__PACKAGE__}/$VERSION</center>
65+
</body>
66+
</html>
67+
EOD
68+
5769
sub start { croak "It's a new version of ".__PACKAGE__.". For old version use `legacy' branch, or better make some minor patches to support new version" };
5870
sub stop { croak "It's a new version of ".__PACKAGE__.". For old version use `legacy' branch, or better make some minor patches to support new version" };
5971

6072
sub new {
6173
my $pkg = shift;
6274
my $self = bless {
6375
backlog => 1024,
64-
read_size => 4096,
65-
max_header_size => MAX_READ_SIZE, #4096*8,
76+
read_size => MAX_READ_SIZE,
77+
max_header_size => MAX_READ_SIZE,
6678
request => 'AnyEvent::HTTP::Server::Req',
6779
sockets => {},
6880
@_,
6981
active_requests => 0,
7082
active_connections => 0,
7183
}, $pkg;
84+
85+
if ($self->{max_header_size} > $self->{read_size}) {
86+
Carp::croak "max_header_size can't be greater than read_size";
87+
}
7288

7389
eval qq{ use $self->{request}; 1}
7490
or die "Request $self->{request} not loaded: $@";
@@ -224,7 +240,7 @@ sub noaccept {
224240
sub drop {
225241
my ($self,$id,$err) = @_;
226242
$err =~ s/\015//sg;
227-
#warn "Dropping connection $id: $err (by request from @{[ (caller)[1,2] ]})";# if DEBUG or $self->{debug};
243+
warn "Dropping connection $id: $err (by request from @{[ (caller)[1,2] ]})" if DEBUG; # or $self->{debug};
228244
my $r = delete $self->{$id} or return;
229245
$self->{active_connections}--;
230246
%{ $r } = () if $r;
@@ -308,17 +324,27 @@ sub incoming {
308324
}
309325
};
310326

327+
my $reply_error = sub {
328+
# my ($code,$message) = @_;
329+
$_[1] //= $AnyEvent::HTTP::Server::Req::http{$_[0]};
330+
# warn "ERROR @_";
331+
my $body = sprintf $ERROR_TEMPLATE, $_[0], $_[1];
332+
my $reply = "HTTP/1.0 $_[0] $_[1]${LF}Connection:close${LF}Content-Type:text/html${LF}Content-Length:"
333+
.length($body)."${LF}${LF}".$body."\n";
334+
$write->(\$reply,\undef);
335+
};
336+
311337
my ($state,$seq) = (0,0);
312338
my ($method,$uri,$version,$lastkey,$contstate,$bpos,$len,$pos, $req);
313339

314340
my $ixx = 0;
315341
$r{rw} = AE::io $fh, 0, sub {
316342
#warn "rw.io.$id (".(fileno $fh).") seq:$seq (ok:".($self ? 1:0).':'.(( $self && exists $self->{$id}) ? 1 : 0).")" if DEBUG;
317343
$self and exists $self->{$id} or return;
318-
while ( $self and ( $len = sysread( $fh, $buf, MAX_READ_SIZE-length $buf, length $buf ) ) ) {
344+
while ( $self and ( $len = sysread( $fh, $buf, $self->{read_size}-length $buf, length $buf ) ) ) {
319345
if ($state == 0) {
320346
if (( my $i = index($buf,"\012", $ixx) ) > -1) {
321-
if (substr($buf, $ixx, $ixx + $i) =~ /(\S+) \040 (\S+) \040 HTTP\/(\d+\.\d+)/xso) {
347+
if (substr($buf, $ixx, $i - $ixx) =~ /^(\S++) \040 (\S++) \040 HTTP\/(\d++\.\d++)\015?$/xso) {
322348
$method = $1;
323349
$uri = $2;
324350
$version = $3;
@@ -328,12 +354,27 @@ sub incoming {
328354
warn "Received request N.$seq over ".fileno($fh).": $method $uri" if DEBUG;
329355
$self->{active_requests}++;
330356
#push @{ $r{req} }, [{}];
331-
} else {
332-
#warn "Broken request ($i): <".substr($buf, 0, $i).">";
333-
return $self->drop($id, "Broken request ($i): <".substr($buf, $ixx, $i).">");
357+
}
358+
elsif (substr($buf, $ixx, $i - $ixx) =~ /^\015?$/) {
359+
# warn "Skip empty line";
360+
$ixx = $i + 1;
361+
redo;
362+
}
363+
else {
364+
warn "Broken request ($i): <".substr($buf, $ixx, $i).">";
365+
return $reply_error->(400);
366+
# return $self->drop($id, "Broken request ($i): <".substr($buf, $ixx, $i).">");
334367
}
335368
$pos = $i+1;
336369
} else {
370+
if ($ixx > 0) {
371+
$buf = substr($buf,$ixx);
372+
$pos = $ixx = 0;
373+
}
374+
elsif ( length($buf) >= $self->{max_header_size} ) {
375+
return $reply_error->(413);
376+
}
377+
warn "Need more data" if DEBUG;
337378
return; # need more
338379
}
339380
}
@@ -344,6 +385,7 @@ sub incoming {
344385
warn "Parsing headers from pos $pos:".substr($buf,$pos) if DEBUG;
345386
while () {
346387
#warn "parse line >'".substr( $buf,pos($buf),index( $buf, "\012", pos($buf) )-pos($buf) )."'";
388+
$bpos = pos($buf);
347389
if( $buf =~ /\G ([^:\000-\037\040]++)[\011\040]*+:[\011\040]*+ ([^\012\015;]*+(;)?[^\012\015]*+) \015?\012/sxogc ){
348390
$lastkey = lc $1;
349391
$h{ $lastkey } = exists $h{ $lastkey } ? $h{ $lastkey }.','.$2: $2;
@@ -361,14 +403,27 @@ sub incoming {
361403
elsif ($buf =~ /\G[\011\040]+/sxogc) { # continuation
362404
#warn "Continuation";
363405
if (length $lastkey) {
364-
$buf =~ /\G ([^\015\012;]*+(;)?[^\015\012]*+) \015?\012/sxogc or return pos($buf) = $bpos; # need more data;
406+
unless ($buf =~ /\G ([^\015\012;]*+(;)?[^\015\012]*+) \015?\012/sxogc) {
407+
if ($ixx > 0) {
408+
$pos = $bpos - $ixx;
409+
$buf = substr($buf,$ixx);
410+
$ixx = 0;
411+
}
412+
elsif ( length($buf) >= $self->{max_header_size} ) {
413+
$self->{active_requests}--;
414+
return $reply_error->(413);
415+
}
416+
warn "Need more data" if DEBUG;
417+
return; # need more
418+
};
419+
# $buf =~ /\G ([^\015\012;]*+(;)?[^\015\012]*+) \015?\012/sxogc or return pos($buf) = $bpos; # need more data;
365420
$h{ $lastkey } .= ' '.$1;
366421
if ( ( defined $2 or $contstate ) ) {
367422
#warn "With ;";
368423
if ( ( my $ext = index( $h{ $lastkey }, ';', rindex( $h{ $lastkey }, ',' ) + 1) ) > -1 ) {
369424
# Composite field. Need to reparse last field value (from ; after last ,)
370-
# full key rescan, because of possible case: <key:value; field="value\n\tvalue continuation"\n>
371-
# regexp needed to set \G
425+
# full key rescan, because of possible case: <key:value; field="value\n\tvalue continuation"\n>
426+
# regexp needed to set \G
372427
pos($h{ $lastkey }) = $ext;
373428
#warn "Rescan from $ext";
374429
#warn("<$1><$2><$3>"),
@@ -384,18 +439,24 @@ sub incoming {
384439
last;
385440
}
386441
elsif($buf =~ /\G [^\012]* \Z/sxogc) {
387-
if (length($buf) - $ixx > $self->{max_header_size}) {
388-
return $self->drop($id, "Too big headers from $rhost for request <".substr($buf, $ixx, 32)."...>");
442+
if ($ixx > 0) {
443+
$pos = $bpos - $ixx;
444+
$buf = substr($buf,$ixx);
445+
$ixx = 0;
446+
}
447+
elsif ( length($buf) >= $self->{max_header_size} ) {
448+
$self->{active_requests}--;
449+
return $reply_error->(413);
389450
}
390-
#warn "Need more";
391-
return pos($buf) = $bpos; # need more data
451+
warn "Need more data" if DEBUG;
452+
return; # need more
392453
}
393454
else {
394455
my ($line) = $buf =~ /\G([^\015\012]++)(?:\015?\012|\Z)/sxogc;
395456
warn "Drop: bad header line: '$line'";
396457
$self->{active_requests}--;
397-
$self->drop($id, "Bad header line: '$line'"); # TBD
398-
return;
458+
# $self->drop($id, "Bad header line: '$line'"); # TBD
459+
return $reply_error->(400);
399460
}
400461
}
401462

‎t/01-basic.t‎

Lines changed: 20 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ use AnyEvent::Handle;
88
use AnyEvent::HTTP::Server;
99
use AnyEvent::HTTP::Server::Kit ':dumper';
1010
use EV;
11-
use Test::More tests => 168;
11+
use Test::More tests => 194;
1212
use Data::Dumper;
1313
$Data::Dumper::Useqq = 1;
1414

@@ -21,17 +21,31 @@ use constant {
2121

2222
our $PARTIAL;
2323

24+
my $bad = '\x'x1024;
25+
my $bad_unescaped = 'x'x1024;
26+
2427
# The tests
2528

26-
for $PARTIAL (0,1) {
29+
for $PARTIAL (0, 1) {
30+
31+
test_server_close { return 200,'ok' } 'skip empty lines',
32+
[["\n\nGET /test1 HTTP/1.1\nHost:localhost\nConnection:close\n\n"], 200, { connection => 'close' }, 'ok' ],
33+
if ALL;
34+
35+
test_server { return 200,'ok' } { max_header_size => 1024, read_size => 1024 }, 'reset too large',
36+
[["GET /test1 HTTP/1.1\nHost:" .("x"x2048). "\nConnection:keep-alive\n\n"], 413, { connection => 'close' }, qr/Request Entity Too Large/ ],
37+
if ALL;
2738

39+
test_server { return 200,'ok' } 'reset bad request',
40+
[["GET /test1 HTTP/1\nHost:localhost\nConnection:keep-alive\n\n"], 400, { connection => 'close' }, qr/Bad Request/ ],
41+
if ALL;
2842

2943
test_server {
3044
my $s = shift;
3145
my $r = shift;
3246
return (
3347
$r->method eq 'GET' ? 200 : 400,
34-
"$r->[0]:$r->[1]:$r->[2]{host}",
48+
"$r->[0]:$r->[1]:$r->[2]{host}".$r->headers->{'x-t+q'},
3549
headers => {
3650
'content-type' => 'text/plain',
3751
'x-test' => $s->{__seq},
@@ -41,10 +55,9 @@ test_server {
4155
[["GET /test1 HTTP/1.1\nHost:localhost\nConnection:keep-alive\n\n"], 200, { 'x-test' => 1 }, "GET:/test1:localhost" ],
4256
[["GET /test2 HTTP/1.1\nHost:localhost\nConnection:keep-alive\n\n"], 200, { 'x-test' => 2 }, "GET:/test2:localhost" ],
4357
[["METHOD /test3 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nContent-Length:4\n\ntest"], 400, { 'x-test' => 3 }, "METHOD:/test3:localhost" ],
44-
$PARTIAL ? () : ([["GET /test4 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nX-t: x; q=\"".("\\x"x33000)."\"\n\n"], 200, { 'x-test' => 4 }, "GET:/test4:localhost" ]),
58+
[["GET /test4 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nX-t: x; q=\"$bad\"\n\n"], 200, { 'x-test' => 4 }, "GET:/test4:localhost$bad_unescaped" ],
4559
if ALL;
4660

47-
my $bad = '\x'x33000;
4861
test_server {
4962
my $s = shift;
5063
my $r = shift;
@@ -60,11 +73,11 @@ test_server {
6073
[[qq{GET /test1 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nAccept:*/*\n\t;q="\\"1\\"!=2"\n\n}], 200, { 'x-test' => 1 }, q{GET:/test1:localhost:*/* ;q="\"1\"!=2":"1"!=2} ], # "
6174
[[qq{GET /test2 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nAccept:*/*; q="1\\!=2"\n\n}], 200, { 'x-test' => 2 }, q{GET:/test2:localhost:*/*; q="1\\!=2":1!=2} ], # "
6275
[[qq{GET /test3 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nAccept:*/*; q="1\n\t2"\n\n}], 200, { 'x-test' => 3 }, q{GET:/test3:localhost:*/*; q="1 2":1 2} ], # "
63-
[[qq{GET /test4 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nAccept:*/*;\n\t q="1 2"\n\n}], 200, { 'x-test' => 4 }, q{GET:/test4:localhost:*/*; q="1 2":1 2} ], # "
76+
[[qq{GET /test4 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nAccept:*/*;\n\t q="1 2"\n\n}], 200, { 'x-test' => 4 }, q{GET:/test4:localhost:*/*; q="1 2":1 2} ], # "
6477
[["GET /test5 HTTP/1.1\nHost:localhost\nConnection:keep-alive\n\n"], 200, { 'x-test' => 5 }, "GET:/test5:localhost::" ],
6578
[["METHOD /test6 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nContent-Length:4\n\ntest"], 400, { 'x-test' => 6 }, "METHOD:/test6:localhost::" ],
6679
[[qq{GET /test1 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nAccept:*/*\n\t;q=123\n\n}], 200, { 'x-test' => 7 }, q{GET:/test1:localhost:*/* ;q=123:123} ], # "
67-
$PARTIAL ? () : ([[qq{GET /test7 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nAccept:*/*;\n\t q="$bad"\n\n}], 200, { 'x-test' => 8 }, qq{GET:/test7:localhost:*/*; q="$bad":"$bad"} ]), # "
80+
[[qq{GET /test7 HTTP/1.1\nHost:localhost\nConnection:keep-alive\nAccept:*/*;\n\t q="$bad"\n\n}], 200, { 'x-test' => 8 }, qq{GET:/test7:localhost:*/*; q="$bad":$bad_unescaped} ], # "
6881
if ALL;
6982

7083
test_server {

0 commit comments

Comments
 (0)