view release on metacpan or  search on metacpan

lib/App/Syslogd.pm  view on Meta::CPAN

}

# ---------------------------------------------------------------------------
# Private and protected helpers
# ---------------------------------------------------------------------------

# _receive
# Purpose:	wait for one datagram.
# Entry:	$self->{socket} set; $buffer_ref a scalar ref to fill.
#		Premise 1: _receive is only called from run()'s loop.
#		Premise 2: run() calls open_socket() before the loop, and
#		open_socket() dies if it cannot give a socket.  Conclusion:
#		the socket always exists here, so it is not checked again.
# Exit:		the sender's sockaddr, or undef if interrupted or on error.
# Side Effects:	carps on errors other than EINTR.
sub _receive
{
	my ($self, $buffer_ref) = @_;

	my $peer = $self->{socket}->recv(${$buffer_ref}, $RECV_BUFFER);

	# EINTR is how a signal wakes us; it is expected, not an error
	if(!defined($peer) && !$!{EINTR}) {
		carp($self->i18n('recv_failed', { error => "$!" }));
	}

	return $peer;
}

# _open_log
# Purpose:	open $self->{file} for appending, safely.
# Entry:	$self->{file} set.
# Exit:		an open filehandle (written with syswrite, unbuffered);
#		croaks on failure.
# Side Effects:	may create the file (mode 0600) and write the header row;
#		chmods an existing file to 0600.
sub _open_log
{
	my $self = shift;
	my $file = $self->{file};

	# The eval below must not touch the caller's $@
	local $@;

	# O_NOFOLLOW: if the log is in a shared directory (/tmp), anyone could plant a
	# symlink to /etc/shadow before root starts us.  O_APPEND: rows from
	# one write() are never interleaved with another writer's, and always
	# go to the end.  O_RDWR (not O_WRONLY) so the first line can be read
	# to check the file is one of our logs.
	my $fh;
	{
		no autodie qw(sysopen);
		sysopen($fh, $file, O_RDWR | O_APPEND | O_CREAT | $O_NOFOLLOW | $O_NONBLOCK, $LOG_MODE)
			or croak($self->i18n('open_failed', { file => $file, error => "$!" }));
	}

	# O_NOFOLLOW cannot catch a hard link or a file someone else pre-created
	# for us to fill with their reading material, so check after opening
	# Safe means all three: a regular file, owned by us, one link.  By De
	# Morgan, "not all three" is "any one of them fails".
	my @st = stat($fh);
	unless(-f _ && ($st[4] == $>) && ($st[3] == 1)) {
		_discard($fh);
		croak($self->i18n('unsafe_file', { file => $file }));
	}

	# A file that already has content must be one of our logs: it must
	# start with the header line.  Without this a mistaken setting (as
	# root, every root-owned file is "ours") would append to, and chmod,
	# any file at all, /etc/passwd included.  Checked before the chmod, so
	# a file that is not ours to change is never changed.
	unless(-z _ || $self->_starts_with_header($fh)) {
		_discard($fh);
		croak($self->i18n('not_a_log', { file => $file }));
	}

	# Tighten an existing file too: previous versions created it 0644
	chmod($LOG_MODE, $fh) if($HAVE_FCHMOD);
	binmode($fh);

	# Header only on an empty file, so a reopened file is not given a
	# second header row half way down.  If that fails the handle is
	# closed here, not left for the garbage collector.
	if(-z $fh) {
		eval { $self->_write_header($fh); 1 } or do {
			my $error = $@;
			_discard($fh);
			die $error;
		};
	}

	return $fh;
}

# _starts_with_header
# Purpose:	is this file one of our logs?
# Entry:	$fh open for reading on a non-empty file.
# Exit:		1 if the first line is the header row (ending in "\n", or
#		"\r\n" for a file once written on Windows), else 0.
# Side Effects:	moves the read position; writes are unaffected, because
#		O_APPEND always writes at the end.
sub _starts_with_header
{
	my ($self, $fh) = @_;

	no autodie qw(sysseek sysread);

	# The header exactly as _write_header writes it, without its newline
	my ($line) = $self->_csv_line([@CSV_HEADER]);
	(my $header = $line // '') =~ s/\n\z//;

	# Read the header and up to two line-end bytes; a failed seek or read
	# leaves $start empty, which does not match
	my $start = '';
	sysread($fh, $start, length($header) + 2) if(defined(sysseek($fh, 0, SEEK_SET)));

	return (length($header) && $start =~ /\A\Q$header\E\r?\n/) ? 1 : 0;
}

# _discard
# Purpose:	close a handle that is being abandoned because of an error.