view release on metacpan or  search on metacpan

t/logic.t  view on Meta::CPAN

subtest '_receive: !defined(peer) && !EINTR warns' => sub {
	# All four rows; only "no sender and not interrupted" warns
	my @rows = ([1, Errno::EINTR(), 0], [1, EBADF, 0], [0, Errno::EINTR(), 0], [0, EBADF, 1]);
	foreach my $row (@rows) {
		my ($has_peer, $errno, $warns) = @{$row};
		my $server = App::Syslogd->new(socket => StepSocket->new(sub { ${$_[0]} = 'x'; $! = $errno; return $has_peer ? $PEER : undef }));
		my @warnings;
		{
			local $SIG{__WARN__} = sub { push @warnings, $_[0] };
			$server->_receive(\my $buffer);
		}
		is(scalar(@warnings), $warns, "sender=$has_peer errno=" . ($errno == Errno::EINTR() ? 'EINTR' : 'EBADF') . ": $warns warning(s)");
	}
};

subtest 'M7: invariant running => bound /\ logging, before, during and after' => sub {
	# Checked at every observable point of a run, including after a stop
	# with both signals at once
	my $server;
	my @states;
	my $check = sub { push @states, state_of($server) };
	my $socket = StepSocket->new(
		sub { $check->(); ${$_[0]} = '<13>a'; return $PEER },
		sub { $check->(); $SIG{HUP}->('HUP'); $! = Errno::EINTR(); return undef },
		sub { $check->(); $server->stop(); $! = Errno::EINTR(); return undef },
	);
	$server = App::Syslogd->new(file => new_path(), resolve => 0, socket => $socket);
	my $before = state_of($server);
	$server->run();
	my $after = state_of($server);
	verbose_diag(explain({ before => $before, during => \@states, after => $after }));

	ok(invariant_holds($before), 'before run(): holds');
	ok(!$before->{running}, 'before run(): not running');
	is(scalar(grep { $_->{running} && $_->{bound} && $_->{logging} } @states), scalar(@states), 'during run(): running, bound and logging at every step');
	ok(invariant_holds($after), 'after run(): holds');
	is_deeply($after, { bound => 0, logging => 0, running => 0 }, 'after run(): nothing held');
};

subtest 'invariant: count never decreases' => sub {
	# Every operation either keeps count or adds one
	my $server = App::Syslogd->new(file => new_path(), resolve => 0)->reopen_log();
	my @counts = ($server->count());
	foreach my $step (sub { $server->process('<13>a', $PEER) }, sub { $server->process('x', $PEER) },
		sub { $server->reopen_log() }, sub { local $SYSWRITE = 'full'; local $SIG{__WARN__} = sub { }; $server->process('<13>b', $PEER) },
		sub { $server->stop() }) {
		$step->();
		push @counts, $server->count();
	}
	is_deeply([map { $counts[$_ + 1] - $counts[$_] >= 0 ? 1 : 0 } 0 .. $#counts - 1], [(1) x $#counts], 'never decreases');
	is_deeply(\@counts, [0, 1, 1, 1, 2, 2], 'and grows only for datagrams long enough');
};

# ===========================================================================
# App::Syslogd: the log file
# ===========================================================================

subtest 'M3: safe = regular && owned && one link - all eight rows, and De Morgan' => sub {
	# Every combination of the three conditions.  "Not regular" comes from
	# /dev/null; owner and link count are faked through stat().  For each
	# row the outcome must equal both "A and B and C" and its De Morgan
	# form "not (not A or not B or not C)".
	plan(skip_all => 'needs /dev/null') unless(-c '/dev/null');
	foreach my $regular (1, 0) {
		foreach my $owned (1, 0) {
			foreach my $one_link (1, 0) {
				my $file = $regular ? new_path() : '/dev/null';
				local %FAKE_STAT = (owner => $owned ? $> : $CONFIG{someone_else}, links => $one_link ? $CONFIG{one_link} : $CONFIG{two_links});
				my $accepted = eval { App::Syslogd->new(file => $file)->reopen_log(); 1 } ? 1 : 0;
				my $and = ($regular && $owned && $one_link) ? 1 : 0;
				my $de_morgan = (!(!$regular || !$owned || !$one_link)) ? 1 : 0;
				my $row = "regular=$regular owned=$owned one link=$one_link";
				is($accepted, $and, "$row: accepted=$and");
				is($and, $de_morgan, "$row: De Morgan agrees");
				like($@, qr/\ARefusing to log to /, "$row: refused with the documented message") unless($accepted);
			}
		}
	}
};

subtest '_open_log: empty || starts with the header' => sub {
	# The OR's three reachable rows (an empty file is never checked for a
	# header): empty -> header written; content starting with the header
	# -> accepted, nothing added; other content -> refused, untouched
	my $empty = new_path();
	App::Syslogd->new(file => $empty)->reopen_log();
	is(slurp($empty), "$CONFIG{header}\n", 'empty: header written');

	# :raw so that Windows writes "\n", not "\r\n": slurp() reads bytes
	my $ours = new_path();
	open(my $fh, '>:raw', $ours) or die;
	print {$fh} "$CONFIG{header}\nold row\n";
	close($fh);
	App::Syslogd->new(file => $ours)->reopen_log();
	is(slurp($ours), "$CONFIG{header}\nold row\n", 'starts with the header: accepted, no second header');

	my $foreign = new_path();
	open($fh, '>:raw', $foreign) or die;
	print {$fh} "existing\n";
	close($fh);
	throws_ok { App::Syslogd->new(file => $foreign)->reopen_log() }
		exact("Refusing to log to $foreign: it is not empty and does not start with the syslog header line"), 'other content: refused';
	is(slurp($foreign), "existing\n", '...and untouched');
};

subtest '_write_header: csv error // append error' => sub {
	# Three rows: the CSV writer refuses (the write is not attempted), the
	# write fails, or both succeed
	my $file = new_path();
	my $server = App::Syslogd->new(file => $file);
	open(my $fh, '>>', $file) or die;
	{
		local $SYSWRITE = '';
		my $g = mock_scoped('Text::CSV::combine' => sub { 0 }, 'Text::CSV::error_diag' => sub { 'refused' });
		my $spy = spy('App::Syslogd::_append_line');
		throws_ok { $server->_write_header($fh) } exact("Could not write to log file $file: refused"), 'CSV refuses: dies';
		is(scalar(my @c = $spy->()), 0, '...without trying to write');
		restore_all();
	}
	{