#!perl
# CRLF injection protection (CWE-113 response splitting)
use warnings;
use strict;
use Test::More tests => 12;
use lib 't'; use Utils;
use AnyEvent;
use AnyEvent::Handle;

require Feersum;

# Silence DIED messages: they're expected here
{ no warnings 'redefine', 'once'; *Feersum::DIED = sub { } }

my ($socket, $port) = get_listen_socket();
ok $socket, 'got listen socket';

my $feer = Feersum->new();
$feer->use_socket($socket);

my $current_handler;
$feer->request_handler(sub { $current_handler->(@_) });

sub raw_get {
    my $path = shift;
    my $cv = AE::cv;
    my $resp = '';
    my $h = AnyEvent::Handle->new(
        connect => ['localhost', $port],
        on_error => sub { $cv->send },
        on_eof   => sub { $cv->send },
    );
    $h->push_write("GET $path HTTP/1.1\r\nHost: localhost\r\nConnection: close\r\n\r\n");
    $h->on_read(sub { $resp .= $_[0]->rbuf; $_[0]->rbuf = '' });
    my $t = AE::timer 2, 0, sub { $cv->send };
    $cv->recv;
    return $resp;
}

# Each case: handler tries to inject CRLF, should croak → 500
my $n = 0;
for my $case (
    ['CR in header value', '200 OK', ['X-Foo' => "bar\rX-Evil: 1"]],
    ['LF in header value', '200 OK', ['X-Foo' => "bar\nX-Evil: 1"]],
    ['CRLF in header value', '200 OK', ['X-Foo' => "bar\r\nX-Evil: 1"]],
    ['CR in header name',  '200 OK', ["X-Foo\rX-Evil" => 'bar']],
    ['LF in header name',  '200 OK', ["X-Foo\nX-Evil" => 'bar']],
    ['colon in header name', '200 OK', ["X-Foo:bad" => 'bar']],
    ['CR in status message', "200 OK\r\nX-Evil: 1", []],
    ['LF in status message', "200 OK\nX-Evil: 1", []],
) {
    my ($desc, $msg, $hdrs) = @$case;
    $current_handler = sub {
        my $r = shift;
        $r->send_response($msg, $hdrs, \"hello");
    };
    my $resp = raw_get("/case" . ++$n);
    like $resp, qr{^HTTP/1\.1 500}, "$desc: rejected with 500";
}

# Verify legitimate request still works after error path
$current_handler = sub {
    my $r = shift;
    $r->send_response(200, ['X-Foo' => 'normal value'], \"ok");
};
my $good = raw_get('/good');
like $good, qr{^HTTP/1\.1 200}, 'normal request still works after rejections';

# Sanity: no injected header on the wire from any failure case
$current_handler = sub {
    my $r = shift;
    $r->send_response('200 OK', ['X-Foo' => "bar\r\nX-Evil: pwn"], \"hello");
};
my $resp = raw_get('/splitcheck');
unlike $resp, qr{X-Evil}i, 'no smuggled header appeared on wire';

# Connection still healthy
$current_handler = sub {
    my $r = shift;
    $r->send_response(200, ['Content-Type' => 'text/plain'], \"recovered");
};
my $after = raw_get('/after');
like $after, qr{^HTTP/1\.1 200.*recovered}s, 'server functional after CRLF rejection';
