view release on metacpan or  search on metacpan

t/17-redirect-auth.t  view on Meta::CPAN

    return ('302 Found', "Location: $baseB/land\r\n", '') if $p eq '/xorigin';
    return ('302 Found', "Location: /land\r\n",      '') if $p eq '/sameorigin';
    my $out = "auth=" . (defined $h->{authorization} ? $h->{authorization} : '-')
            . ";cookie=" . (defined $h->{cookie} ? $h->{cookie} : '-');
    return ('200 OK', '', $out);
}) or plan skip_all => "cannot set up server A";
my $baseA = "http://127.0.0.1:$portA";

my $ua = Fetch->new;

# same-origin redirect: credentials are preserved
my $same = $ua->get("$baseA/sameorigin",
    headers => { Authorization => 'Bearer TOK', Cookie => 'sid=1' })->get;
like($same->content, qr/auth=Bearer TOK/, 'same-origin redirect keeps Authorization');
like($same->content, qr/cookie=sid=1/,    'same-origin redirect keeps Cookie');

# cross-origin redirect: credentials are stripped
my $cross = $ua->get("$baseA/xorigin",
    headers => { Authorization => 'Bearer TOK', Cookie => 'sid=1' })->get;
like($cross->content, qr/auth=-/,   'cross-origin redirect strips Authorization');
like($cross->content, qr/cookie=-/, 'cross-origin redirect strips Cookie');

done_testing;

# In an END block, and SIGKILL: a die anywhere above must not leave a server
# child holding the harness's TAP pipe open.
END {