view release on metacpan or  search on metacpan

t/69-server-edges.t  view on Meta::CPAN

# --- a body dribbled a byte a second is cut by the rate floor ---
{
    my $s = connect_to($pa);
    $s->syswrite("POST /drip HTTP/1.1\r\nHost: a\r\nContent-Length: 1000\r\n\r\n");
    my $t0 = Time::HiRes::time;
    my $cut;
    for (1 .. 80) {
        $s->syswrite('x');
        my $n = $s->sysread(my $c, 10);
        if (defined $n && $n == 0) { $cut = Time::HiRes::time - $t0; last }
        Time::HiRes::sleep(0.1);
    }
    ok($cut, 'the connection was closed') and cmp_ok($cut, '>=', 1.5, 'after the two seconds the rate is judged over');
}

# --- a request that never finishes is cut by request_timeout ---
{
    my $s = connect_to($pb);
    $s->syswrite("POST /hang HTTP/1.1\r\nHost: a\r\nContent-Length: 10\r\n\r\nabc");
    my $cut = closed_within($s, 5);
    ok($cut, 'a request past its ceiling is closed');
}

# --- a pipeline deeper than max_pipeline is still fully served ---
{
    my $req = join '', map { "GET /p$_ HTTP/1.1\r\nHost: a\r\n" . ($_ == 5 ? "Connection: close\r\n" : '') . "\r\n" } 1 .. 5;
    my $all = raw($pa, $req);
    is(scalar(() = $all =~ m{HTTP/1\.1 200}g), 5, 'five pipelined requests, five responses');
    like($all, qr{/p5:0}, 'in order to the last');
}

# --- more header lines than the stack index, and a chunk size in letters ---
{
    my $many = "GET /many HTTP/1.1\r\nHost: a\r\n" . join('', map { "X-H$_: $_\r\n" } 1 .. 70) . "X-Last: seventy\r\nConnection: close\r\n\r\n";
    like(raw($pa, $many), qr{/many:0:seventy}, 'seventy-odd header lines are indexed in the heap copy');
    my $hex = "POST /hex HTTP/1.1\r\nHost: a\r\nTransfer-Encoding: chunked\r\nConnection: close\r\n\r\nA\r\n0123456789\r\nb\r\nabcdefghijk\r\n0\r\n\r\n";
    like(raw($pa, $hex), qr{/hex:21}, 'chunk sizes in upper and lower hex letters');
}

# --- bodies past max_body, announced and chunked ---
{
    my $big = raw($pb, "POST /big HTTP/1.1\r\nHost: a\r\nContent-Length: 10000\r\nExpect: 100-continue\r\nConnection: close\r\n\r\n");
    like($big, qr{^HTTP/1\.1 413}, 'an announced body past max_body is refused before it is sent');
    my $chunks = raw($pb, "POST /chunky HTTP/1.1\r\nHost: a\r\nTransfer-Encoding: chunked\r\nConnection: close\r\n\r\n" . ("1000\r\n" . ('c' x 4096) . "\r\n") x 2);
    like($chunks, qr{^HTTP/1\.1 413}, 'a chunked body that outgrows max_body is refused');
}

# --- a body past the spill mark, with a temp directory and without one ---
{
    my $body = 'b' x (1024 * 1024 + 100);
    like(raw($pa, "POST /spill HTTP/1.1\r\nHost: a\r\nContent-Length: " . length($body) . "\r\nConnection: close\r\n\r\n$body", 10), qr{/spill:1048676}, 'a body past a megabyte is spilled to a file and read back whole');
}

# --- the logs ---
{
    like(raw($pb, "GET /stream HTTP/1.1\r\nHost: a\r\nConnection: close\r\n\r\n"), qr/s\z/, 'a streamed response on the combined log');
    like(raw($pa, "GET /stream HTTP/1.1\r\nHost: a\r\nConnection: close\r\n\r\n"), qr/s\z/, 'a streamed response');
    like(raw($pb, "GET /ctl HTTP/1.1\r\nHost: a\r\nUser-Agent: del\x7fete \"q\"\r\nConnection: close\r\n\r\n"), qr{/ctl:0}, 'a control byte in the agent');
    Time::HiRes::sleep(0.3);
    my $a = do { local (@ARGV, $/) = ("$dir/a.log"); <> } // '';
    like($a, qr/"bytes":null/, 'the JSON log writes null for the bytes of a stream');
    my $b = do { local (@ARGV, $/) = ("$dir/b.log"); <> } // '';
    like($b, qr/"del\\x7fete \\"q\\"" - 200 7 7 127\.0\.0\.1 127\.0\.0\.1 \d+ \d+ \d+/, 'the combined log escapes a control byte and quotes, dashes a missing header, and fills %B %b %v %e %D %T %P');
    like($b, qr/ 200 0 - 127/, 'a streamed response logs zero and a dash for its bytes');
}

# --- a hard stop: TERM during a slow request, the grace runs out ---
{
    my $s = connect_to($pb);
    $s->syswrite("GET /slow HTTP/1.1\r\nHost: a\r\n\r\n");
    Time::HiRes::sleep(0.3);
    kill 'TERM', $pidb;
    my $t0 = Time::HiRes::time;
    server_reap($pidb);
    my $took = Time::HiRes::time - $t0;
    cmp_ok($took, '<', 4, 'the server did not wait for the slow handler');
}

kill 'TERM', $pida;
server_reap($pida);
done_testing;