view release on metacpan or  search on metacpan

t/manager.t  view on Meta::CPAN

$result = $client->call_ok( 'checkpoint', { 'kur' => 'sshd' } );
is( $result->{kurs}{sshd}{checkpointed}, 1, 'targeted checkpoint hit sshd' );
ok( !defined( $result->{kurs}{smtp} ), 'targeted checkpoint did not touch smtp' );

$response = $client->call( 'checkpoint', { 'kur' => 'nope' } );
is( $response->{status}, 'error', 'checkpoint of an unknown kur errors' );

#
# fan out with a down kur... a kur who's backend can never init lives in
# restart backoff, and fan out commands must answer an error for it with out
# the live kurs being disturbed
#

$result = $client->call_ok( 'add_kur', { 'name' => 'down', 'opts' => { 'backend' => 'nosuchbackendzzz' } } );
is( $result->{added}, 'down', 'added a kur that can never start' );

$result = $client->call_ok( 'ban', { 'ips' => ['3.3.3.3'] } );
ok( defined( $result->{kurs}{down}{error} ), 'fan out ban answers an error for the down kur' );
is( $result->{kurs}{sshd}{ips}{'3.3.3.3'}{status}, 'ok', 'fan out ban still applied on sshd' );
is( $result->{kurs}{smtp}{ips}{'3.3.3.3'}{status}, 'ok', 'fan out ban still applied on smtp' );

$result = $client->call_ok('banned');
ok( defined( $result->{kurs}{down}{error} ),                         'banned answers an error for the down kur' );
ok( ( grep { $_ eq '3.3.3.3' } @{ $result->{kurs}{sshd}{banned} } ), 'banned still reports the live kurs' );

$result = $client->call_ok( 'unban', { 'ip' => '3.3.3.3' } );
ok( defined( $result->{kurs}{down}{error} ), 'unban answers an error for the down kur' );
is( $result->{kurs}{sshd}{was_banned}, 1, 'unban still removed it from sshd' );

$result = $client->call_ok( 'remove_kur', { 'name' => 'down' } );
is( $result->{removed}, 'down', 'the down kur removed again' );

#
# supervision... kill a kur and it should come back
#

open( my $pid_fh, '<', $dir . '/run/kur/sshd.pid' ) || die($!);
my $old_sshd_pid = <$pid_fh>;
close($pid_fh);
kill( 'KILL', $old_sshd_pid );

my $respawned = 0;
my $waited    = 0;
while ( $waited < 20 ) {
	$status = $client->call_ok('status');
	if (   $status->{kurs}{sshd}{restarts}
		&& $status->{kurs}{sshd}{running}
		&& $status->{kurs}{sshd}{pid} != $old_sshd_pid )
	{
		$respawned = 1;
		last;
	}
	select( undef, undef, undef, 0.5 );
	$waited += 0.5;
} ## end while ( $waited < 20 )
ok( $respawned, 'sshd respawned after being killed' );
is( $status->{kurs}{sshd}{restarts}, 1, 'restart counted' );

# can't just wait on the socket path as the SIGKILLed kur left a stale
# socket file behind, so poll till the respawned one actually answers
my $alive = 0;
$waited = 0;
while ( $waited < 20 ) {
	my $pong = eval { $sshd_client->call_ok('ping'); };
	if ( defined($pong) && $pong->{pong} ) {
		$alive = 1;
		last;
	}
	select( undef, undef, undef, 0.5 );
	$waited += 0.5;
}
ok( $alive, 'respawned sshd answers on it\'s socket' );

$result = $client->call_ok( 'ban', { 'ips' => ['6.6.6.6'], 'kur' => 'sshd' } );
is( $result->{kurs}{sshd}{ips}{'6.6.6.6'}{status}, 'ok', 'bans work on the respawned kur' );

#
# stop... this is also the regression test for wheel destruction from the
# wrong session, as the add/remove above has to not keep the manager alive
#

$result = $client->call_ok('stop');
is( $result->{stopping}, 1, 'stop response' );
ok( wait_for_gone($manager_socket),               'manager socket gone' );
ok( wait_for_gone( $dir . '/run/kur/sshd.sock' ), 'sshd socket gone' );
ok( wait_for_gone( $dir . '/run/kur/smtp.sock' ), 'smtp socket gone' );
ok( wait_for_gone( $dir . '/run/pid' ),           'manager pid file gone' );
is( wait_for_exit( $manager_pid, 20 ), 0, 'manager exited 0' );

done_testing;