view release on metacpan or  search on metacpan

t/integration/app-file.t  view on Meta::CPAN

    # Skip if we can't create symlinks (Windows without admin, etc.)
    my $test_dir = File::Temp::tempdir(CLEANUP => 1);
    my $root_dir = "$test_dir/root";
    my $outside_dir = "$test_dir/outside";

    mkdir $root_dir or die "Cannot create root dir: $!";
    mkdir $outside_dir or die "Cannot create outside dir: $!";

    # Create a file outside the root
    open my $fh, '>', "$outside_dir/secret.txt" or die;
    print $fh "SECRET DATA";
    close $fh;

    # Create a symlink from inside root to outside
    my $symlink_created = eval { symlink("$outside_dir/secret.txt", "$root_dir/escape") };

    skip_all("Cannot create symlinks on this system") unless $symlink_created;

    my $server = create_server(root => $root_dir);
    my $port = $server->port;

    my $http = Net::Async::HTTP->new(fail_on_error => 0);
    $loop->add($http);

    my $response = $http->GET("http://127.0.0.1:$port/escape")->get;

    # Should either 403 (blocked) or 404 (symlink not followed)
    ok($response->code >= 400, "Symlink escape blocked (status: " . $response->code . ")");
    unlike($response->content // '', qr/SECRET DATA/, "Did not expose file outside root");

    $loop->remove($http);
    $server->shutdown->get;
    $loop->remove($server);
};

subtest 'Security: URL-encoded traversal blocked' => sub {
    my $server = create_server();
    my $port = $server->port;

    my $http = Net::Async::HTTP->new(fail_on_error => 0);
    $loop->add($http);

    # URL-encoded traversal attempts
    my @paths = (
        '/%2e%2e/%2e%2e/%2e%2e/etc/passwd',        # ..
        '/%252e%252e/%252e%252e/etc/passwd',      # double-encoded
        '/..%252f..%252f..%252fetc/passwd',       # mixed
    );

    for my $path (@paths) {
        my $response = $http->GET("http://127.0.0.1:$port$path")->get;
        ok($response->code >= 400, "URL-encoded traversal blocked for $path (status: " . $response->code . ")");
    }

    $loop->remove($http);
    $server->shutdown->get;
    $loop->remove($server);
};

# =============================================================================
# Test: Large file streaming (verifies file response integration)
# =============================================================================
subtest 'Large file streaming' => sub {
    # Create a temp directory with a large file
    # Size is 65KB - just over the 64KB sync_file_threshold to trigger async path
    # Kept small to minimize buffer pressure on constrained CI environments (e.g., FreeBSD)
    my $test_dir = File::Temp::tempdir(CLEANUP => 1);
    my $large_content = "X" x (65 * 1024);  # 65KB file (exceeds 64KB threshold)
    open my $fh, '>', "$test_dir/large.bin" or die;
    print $fh $large_content;
    close $fh;

    my $server = create_server(root => $test_dir);
    my $port = $server->port;

    my $http = Net::Async::HTTP->new;
    $loop->add($http);

    my $response = $http->GET("http://127.0.0.1:$port/large.bin")->get;

    is($response->code, 200, 'GET /large.bin returns 200');
    is(length($response->content), length($large_content), 'Large file length matches');
    is($response->content, $large_content, 'Large file content matches');

    $loop->remove($http);
    $server->shutdown->get;
    $loop->remove($server);
};

# =============================================================================
# Test: Large file Range request streaming
# =============================================================================
subtest 'Large file Range request' => sub {
    # Size is 65KB - just over the 64KB sync_file_threshold to trigger async path
    my $test_dir = File::Temp::tempdir(CLEANUP => 1);
    my $large_content = "X" x (65 * 1024);  # 65KB file (exceeds 64KB threshold)
    open my $fh, '>', "$test_dir/large.bin" or die;
    print $fh $large_content;
    close $fh;

    my $server = create_server(root => $test_dir);
    my $port = $server->port;

    my $http = Net::Async::HTTP->new;
    $loop->add($http);

    # Request bytes 1000-2000
    my $response = $http->GET(
        "http://127.0.0.1:$port/large.bin",
        headers => ['Range' => 'bytes=1000-2000'],
    )->get;

    is($response->code, 206, 'Range request returns 206');
    is(length($response->content), 1001, 'Partial content length correct');
    is($response->content, substr($large_content, 1000, 1001), 'Partial content matches');
    like($response->header('Content-Range'), qr/bytes 1000-2000\/\d+/, 'Has Content-Range header');

    $loop->remove($http);
    $server->shutdown->get;
    $loop->remove($server);
};

# =============================================================================
# Test: handle_ranges => 0 ignores Range header
# =============================================================================
subtest 'handle_ranges => 0 ignores Range header' => sub {
    my $server = create_server(app_opts => { handle_ranges => 0 });
    my $port = $server->port;

    my $http = Net::Async::HTTP->new;
    $loop->add($http);

    # Send Range header, but should get full file (200) not partial (206)
    my $response = $http->GET(
        "http://127.0.0.1:$port/test.txt",
        headers => ['Range' => 'bytes=0-4'],
    )->get;

    is($response->code, 200, 'With handle_ranges => 0, Range request returns 200 (not 206)');
    ok(!$response->header('Content-Range'), 'No Content-Range header');
    like($response->decoded_content, qr/Hello from PAGI/, 'Full file content returned');

    $loop->remove($http);
    $server->shutdown->get;
    $loop->remove($server);
};

# =============================================================================
# Test: handle_ranges => 1 (default) honors Range header
# =============================================================================
subtest 'handle_ranges => 1 (default) honors Range header' => sub {