Developer-Dashboard
view release on metacpan or search on metacpan
t/08-web-update-coverage.t view on Meta::CPAN
my $fake_bin = File::Spec->catdir( $home, 'fake-win-bin' );
make_path($fake_bin);
my $ipconfig = File::Spec->catfile( $fake_bin, 'ipconfig' );
open my $ipconfig_fh, '>', $ipconfig or die $!;
print {$ipconfig_fh} <<'BAT';
#!/bin/sh
cat <<'EOF'
Ethernet adapter Ethernet:
IPv4 Address. . . . . . . . . . . : 10.20.30.40
Wireless LAN adapter Loopback:
IPv4 Address. . . . . . . . . . . : 127.0.0.1
EOF
BAT
close $ipconfig_fh;
chmod 0755, $ipconfig or die $!;
no warnings 'redefine';
local $ENV{PATH} = $fake_bin . ':' . $ENV{PATH};
local *Developer::Dashboard::Web::App::_ip_pairs_from_ip = sub { return (); };
local *Developer::Dashboard::Web::App::_ip_pairs_from_ifconfig = sub { return (); };
is_deeply(
[ $app->_ip_interface_pairs ],
[ { iface => 'Ethernet', ip => '10.20.30.40' } ],
'_ip_interface_pairs falls back to ipconfig parsing when Windows ipconfig output is available',
);
}
{
no warnings 'redefine';
local *Developer::Dashboard::Web::App::_ip_pairs_from_ip = sub { return (); };
local *Developer::Dashboard::Web::App::_ip_pairs_from_ifconfig = sub { return (); };
ok( !defined $app->_machine_ip, '_machine_ip returns undef when neither ip nor ifconfig yields a usable address' );
}
my ( $ajax_missing_code, $ajax_missing_type, $ajax_missing_body ) = @{ $app->handle( path => '/ajax', query => '', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
is( $ajax_missing_code, 400, 'legacy ajax route rejects requests without token or saved file parameters' );
like( $ajax_missing_type, qr/text\/plain/, 'legacy ajax missing-parameter route returns plain text' );
like( $ajax_missing_body, qr/missing token/, 'legacy ajax missing-parameter route explains the missing token' );
{
local $ENV{DEVELOPER_DASHBOARD_ALLOW_TRANSIENT_URLS} = 1;
no warnings 'redefine';
local *Developer::Dashboard::Web::App::decode_payload = sub { die "forced decode failure\n" };
my ( $ajax_bad_token_code, $ajax_bad_token_type, $ajax_bad_token_body ) = @{ $app->handle( path => '/ajax', query => 'token=known-good-token&type=json', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
is( $ajax_bad_token_code, 400, 'legacy ajax route rejects decode failures cleanly' );
like( $ajax_bad_token_type, qr/text\/plain/, 'legacy ajax decode-failure route returns plain text' );
like( $ajax_bad_token_body, qr/forced decode failure/, 'legacy ajax decode-failure route returns the decode error text' );
}
{
my ( $ajax_bad_file_code, $ajax_bad_file_type, $ajax_bad_file_body ) = @{ $app->handle( path => '/ajax', query => 'file=..%2Fbad&type=json', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
is( $ajax_bad_file_code, 400, 'legacy ajax route rejects invalid saved bookmark ajax file names cleanly' );
like( $ajax_bad_file_type, qr/text\/plain/, 'legacy ajax invalid saved-file route returns plain text' );
like( $ajax_bad_file_body, qr/invalid parent traversal/, 'legacy ajax invalid saved-file route returns the validation error text' );
}
{
my $streaming_page = Developer::Dashboard::PageDocument->from_instruction(<<'PAGE');
BOOKMARK: ajax-stream
:--------------------------------------------------------------------------------:
HTML: <script>var configs = {};</script>
:--------------------------------------------------------------------------------:
CODE1: Ajax jvar => 'configs.demo.endpoint', type => 'text', file => 'stream.txt', code => q{
print "first\n";
print "second\n";
};
PAGE
$store->save_page($streaming_page);
my ( undef, undef, undef ) = @{ $app->handle( path => '/app/ajax-stream', query => '', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
my ( $ajax_stream_code, $ajax_stream_type, $ajax_stream_body ) = @{ $app->handle( path => '/ajax/stream.txt', query => 'type=text', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
is( $ajax_stream_code, 200, 'legacy ajax saved-file route responds successfully for streaming output' );
like( $ajax_stream_type, qr/text\/plain/, 'legacy ajax saved-file route keeps the requested content type for streaming output' );
is( drain_stream_body($ajax_stream_body), "first\nsecond\n", 'legacy ajax saved-file route streams raw printed output without page buffering' );
}
{
my $process_page = Developer::Dashboard::PageDocument->from_instruction(<<'PAGE');
BOOKMARK: ajax-process
:--------------------------------------------------------------------------------:
HTML: <script>var configs = {};</script>
:--------------------------------------------------------------------------------:
CODE1: Ajax jvar => 'configs.demo.endpoint', type => 'text', file => 'process-endpoint.json', code => q{
print "perl-start\n";
warn "perl-warn\n";
system 'sh', '-c', 'printf "child-out\n"; printf "child-err\n" >&2';
die "perl-die\n";
};
PAGE
$store->save_page($process_page);
my ( undef, undef, undef ) = @{ $app->handle( path => '/app/ajax-process', query => '', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
my ( $ajax_process_code, $ajax_process_type, $ajax_process_body ) = @{ $app->handle( path => '/ajax/process-endpoint.json', query => 'type=text', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
my $ajax_process_output = drain_stream_body($ajax_process_body);
is( $ajax_process_code, 200, 'legacy ajax saved-file process route responds successfully for mixed stdout and stderr output' );
like( $ajax_process_type, qr/text\/plain/, 'legacy ajax saved-file process route keeps the requested content type' );
like( $ajax_process_output, qr/perl-start/, 'legacy ajax saved-file process route streams direct perl stdout' );
like( $ajax_process_output, qr/perl-warn/, 'legacy ajax saved-file process route streams perl stderr warnings' );
like( $ajax_process_output, qr/child-out/, 'legacy ajax saved-file process route streams child process stdout' );
like( $ajax_process_output, qr/child-err/, 'legacy ajax saved-file process route streams child process stderr' );
like( $ajax_process_output, qr/perl-die/, 'legacy ajax saved-file process route streams uncaught perl die output' );
}
{
my $singleton_page = Developer::Dashboard::PageDocument->from_instruction(<<'PAGE');
BOOKMARK: ajax-singleton
:--------------------------------------------------------------------------------:
HTML: <script>var configs = {};</script>
:--------------------------------------------------------------------------------:
CODE1: Ajax jvar => 'configs.demo.endpoint', type => 'text', singleton => 'FOOBAR', file => 'singleton-endpoint.txt', code => q{
print "$0\n";
};
PAGE
$store->save_page($singleton_page);
my ( undef, undef, $singleton_page_body ) = @{ $app->handle( path => '/app/ajax-singleton', query => '', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
like( $singleton_page_body, qr{/ajax/singleton-endpoint\.txt\?type=text&singleton=FOOBAR}, 'saved bookmark Ajax page emits the singleton query parameter in the generated ajax url' );
like( $singleton_page_body, qr/dashboard_ajax_singleton_cleanup\('FOOBAR'\)/, 'saved bookmark Ajax page registers browser lifecycle cleanup for singleton-managed workers' );
my ( $ajax_singleton_code, undef, $ajax_singleton_body ) = @{ $app->handle( path => '/ajax/singleton-endpoint.txt', query => 'type=text&singleton=FOOBAR', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
my $ajax_singleton_output = drain_stream_body($ajax_singleton_body);
is( $ajax_singleton_code, 200, 'legacy ajax saved-file route responds successfully for singleton-managed requests' );
like( $ajax_singleton_output, qr/^dashboard ajax: FOOBAR$/m, 'legacy ajax saved-file route renames singleton-managed Perl workers before streaming output' );
}
{
my @patterns;
{
no warnings 'redefine';
local *Developer::Dashboard::RuntimeManager::_pkill_perl = sub {
my ( $self, $pattern ) = @_;
push @patterns, $pattern;
return 1;
};
my ( $stop_code, undef, $stop_body ) = @{ $app->handle( path => '/ajax/singleton/stop', query => 'singleton=BROWSER-STOP', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
is( $stop_code, 204, 'singleton stop route returns no content after lifecycle cleanup' );
is( $stop_body, '', 'singleton stop route keeps the response body empty' );
my ( $direct_stop_code, undef, $direct_stop_body ) = @{ $app->ajax_singleton_stop_response( query => 'singleton=BROWSER-STOP' ) };
is( $direct_stop_code, 204, 'direct singleton stop response returns no content after lifecycle cleanup' );
is( $direct_stop_body, '', 'direct singleton stop response keeps the response body empty' );
}
is_deeply(
\@patterns,
[ '^dashboard ajax: BROWSER-STOP$', '^dashboard ajax: BROWSER-STOP$' ],
'singleton stop route and direct response target the matching saved ajax worker process title',
);
}
{
my $shebang_page = Developer::Dashboard::PageDocument->from_instruction(<<'PAGE');
BOOKMARK: ajax-shebang
:--------------------------------------------------------------------------------:
HTML: <script>var configs = {};</script>
:--------------------------------------------------------------------------------:
CODE1: Ajax jvar => 'configs.demo.endpoint', type => 'text', file => 'script-runner', code => qq{#!/bin/sh\nprintf 'shell-out\\n'\nprintf 'shell-err\\n' >&2\n};
PAGE
$store->save_page($shebang_page);
my ( undef, undef, undef ) = @{ $app->handle( path => '/app/ajax-shebang', query => '', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
my ( $ajax_shebang_code, undef, $ajax_shebang_body ) = @{ $app->handle( path => '/ajax/script-runner', query => 'type=text', remote_addr => '127.0.0.1', headers => { host => '127.0.0.1' } ) };
my $ajax_shebang_output = drain_stream_body($ajax_shebang_body);
is( $ajax_shebang_code, 200, 'legacy ajax saved-file route executes shebang scripts directly' );
like( $ajax_shebang_output, qr/shell-out/, 'legacy ajax saved-file route streams direct executable stdout' );
like( $ajax_shebang_output, qr/shell-err/, 'legacy ajax saved-file route streams direct executable stderr' );
}
{
my $runtime_api_file = File::Spec->catfile( $paths->config_root, 'api.json' );
open my $runtime_api, '>:raw', $runtime_api_file
or die "Unable to write runtime api.json: $!";
print {$runtime_api} qq|{"runtime-client":{"secret":"@{[ sha256_hex('stream-secret') ]}","ajax":["/ajax/stream.txt"]}}|;
close $runtime_api or die "Unable to close runtime api.json: $!";
my $skill_api_dir = File::Spec->catdir( $dancer_skill_install->{path}, 'config' );
make_path($skill_api_dir);
open my $skill_api, '>:raw', File::Spec->catfile( $skill_api_dir, 'api.json' )
or die "Unable to write skill api.json: $!";
print {$skill_api} qq|{"skill-client":{"secret":"@{[ sha256_hex('skill-secret') ]}","ajax":["/ajax/dancer-route-skill/bar"]}}|;
close $skill_api or die "Unable to close skill api.json: $!";
my $api_host = 'dashboard-helper.example:7890';
my ( $registered_no_api_code, $registered_no_api_type, $registered_no_api_body ) = @{ $app->handle(
path => '/ajax/stream.txt',
query => 'type=text',
t/08-web-update-coverage.t view on Meta::CPAN
) };
is( $logout_code, 302, 'logout redirects' );
is( $logout_headers->{Location}, '/login', 'logout redirects to login page' );
like( $logout_headers->{'Set-Cookie'}, qr/Max-Age=0/, 'logout expires the session cookie' );
ok( !$sessions->from_cookie( $login_headers->{'Set-Cookie'} ), 'logout deletes the stored session' );
dies_like( sub { Developer::Dashboard::Web::Server->new }, qr/Missing web app/, 'web server requires an app' );
my $default_server = Developer::Dashboard::Web::Server->new( app => $app );
is( $default_server->{host}, '0.0.0.0', 'web server defaults to all interfaces' );
is( $default_server->{port}, 7890, 'web server keeps default port 7890' );
my $server = Developer::Dashboard::Web::Server->new(
app => $app,
host => '127.0.0.1',
port => 0,
);
my $daemon = $server->start_daemon;
is( $daemon->sockhost, '127.0.0.1', 'start_daemon preserves the requested host' );
ok( $daemon->sockport > 0, 'start_daemon resolves a listen port' );
is( $server->listening_url($daemon), 'http://127.0.0.1:' . $daemon->sockport . '/', 'listening_url builds the daemon URL from the descriptor' );
{
my $res;
Local::PSGITest::test_psgi $server->psgi_app, sub {
my ($cb) = @_;
$res = $cb->( GET 'http://127.0.0.1/app/sample/source' );
};
is( $res->code, 200, 'server PSGI app returns successful status code from app handle' );
like( $res->header('Content-Type'), qr/text\/plain/, 'server PSGI app keeps the instruction source content type' );
is( $res->header('X-Frame-Options'), 'DENY', 'server PSGI app sets frame-deny header' );
like( $res->header('Content-Security-Policy'), qr/frame-ancestors 'none'/, 'server PSGI app sets CSP header' );
is( $res->header('Cache-Control'), 'no-store', 'server PSGI app disables response caching' );
}
my $header_app = bless {}, 'Local::HeaderApp';
{
no warnings 'once';
*Local::HeaderApp::handle = sub {
return [
302,
'text/plain; charset=utf-8',
"Redirecting\n",
{
Location => '/login',
'Set-Cookie' => 'dashboard_session=abc',
},
];
};
}
my $header_server = Developer::Dashboard::Web::Server->new( app => $header_app );
{
my $res;
Local::PSGITest::test_psgi $header_server->psgi_app, sub {
my ($cb) = @_;
$res = $cb->( POST 'http://127.0.0.1/login', [ username => 'helper', password => 'helper-pass-123' ] );
};
is( $res->header('Location'), '/login', 'server forwards custom Location headers from the app' );
is( $res->header('Set-Cookie'), 'dashboard_session=abc', 'server forwards custom Set-Cookie headers from the app' );
}
my $streaming_app = bless {}, 'Local::StreamingApp';
{
no warnings 'once';
*Local::StreamingApp::handle = sub {
return [
200,
'text/plain; charset=utf-8',
{
stream => sub {
my ($writer) = @_;
$writer->("alpha\n");
$writer->("beta\n");
},
},
{ 'X-Test' => 'streaming' },
];
};
}
my $streaming_server = Developer::Dashboard::Web::Server->new( app => $streaming_app );
{
my $res;
Local::PSGITest::test_psgi $streaming_server->psgi_app, sub {
my ($cb) = @_;
$res = $cb->( GET 'http://127.0.0.1/ajax' );
};
is( $res->code, 200, 'streaming response path returns success' );
like( $res->header('Content-Type'), qr/text\/plain/, 'streaming response keeps the content type header' );
is( $res->header('X-Test'), 'streaming', 'streaming response keeps custom headers' );
is( $res->content, "alpha\nbeta\n", 'streaming response writes streamed body chunks into the final response body' );
}
my $failing_stream_app = bless {}, 'Local::FailingStreamApp';
{
no warnings 'once';
*Local::FailingStreamApp::handle = sub {
return [
200,
'text/plain; charset=utf-8',
{
stream => sub {
my ($writer) = @_;
$writer->("alpha\n");
die "stream exploded\n";
},
},
];
};
}
my $failing_stream_server = Developer::Dashboard::Web::Server->new( app => $failing_stream_app );
{
my $res;
Local::PSGITest::test_psgi $failing_stream_server->psgi_app, sub {
my ($cb) = @_;
$res = $cb->( GET 'http://127.0.0.1/ajax' );
};
is( $res->code, 200, 'streaming error responses keep the original success status' );
like( $res->content, qr/alpha/, 'streaming error responses keep chunks written before the failure' );
like( $res->content, qr/stream exploded/, 'streaming error responses append the streaming exception text' );
}
{
no warnings 'redefine';
my @chunks;
local *Developer::Dashboard::Web::DancerApp::delayed = sub (&) { $_[0]->(); return 'delayed-ok' };
local $Dancer2::Core::Route::RESPONDER = sub {
my ($response) = @_;
is( $response->[0], 200, 'disconnect coverage responder receives the original status code' );
like( join( "\n", @{ $response->[1] || [] } ), qr/Content-Type\ntext\/plain/, 'disconnect coverage responder receives the content type header' );
return bless {}, 'Local::DisconnectWriter';
};
{
no warnings 'once';
*Local::DisconnectWriter::write = sub {
my ( $self, $chunk ) = @_;
push @chunks, $chunk;
die "Broken pipe\n" if @chunks > 1;
return 1;
};
*Local::DisconnectWriter::close = sub { return 1 };
}
local $Developer::Dashboard::Web::DancerApp::BACKEND_APP = { app => bless( {}, 'Local::DisconnectBackend' ), default_headers => {} };
my $result = Developer::Dashboard::Web::DancerApp::_response_from_result(
[
200,
'text/plain; charset=utf-8',
{
stream => sub {
my ($writer) = @_;
is( $writer->("alpha\n"), 1, 'stream writer reports success before the client disconnects' );
is( $writer->("beta\n"), 0, 'stream writer reports a disconnect when Dancer content writes fail with broken pipe' );
},
},
{},
]
);
is( $result, 'delayed-ok', '_response_from_result still completes the delayed wrapper when the client disconnects mid-stream' );
is_deeply( \@chunks, [ "alpha\n", "beta\n" ], '_response_from_result stops treating broken-pipe writes as fatal backend exceptions' );
}
my $failing_app = bless {}, 'Local::FailingApp';
{
no warnings 'once';
*Local::FailingApp::handle = sub { die "exploded\n" };
}
my $failing_server = Developer::Dashboard::Web::Server->new( app => $failing_app );
{
my $res;
Local::PSGITest::test_psgi $failing_server->psgi_app, sub {
my ($cb) = @_;
$res = $cb->( GET 'http://127.0.0.1/' );
};
is( $res->code, 500, 'server converts app exceptions into 500 responses' );
like( $res->content, qr/exploded/, 'server includes error body for exceptions' );
}
{
no warnings 'redefine';
local *Developer::Dashboard::Web::DancerApp::splat = sub { return ['alpha', 'beta']; };
( run in 1.270 second using v1.01-cache-2.11-cpan-6aa56a78535 )