# ex:ts=8 sw=4:
# $OpenBSD$
#
# Copyright (c) 2026 Dick Olsson <hi@senzilla.io>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use v5.36;

package Fugu::Log;
our $VERSION = '0.4.0';

use IO::Handle;
use Sys::Syslog qw(:standard :extended :macros);

# Fugu::Log - Unified logging for syslog and stderr
#
# The module gives one logging interface for both syslog (for
# daemons) and stderr (for CLI tools). It filters messages by level
# and formats them printf-style.
#
# The levels are debug, info, notice, warning and error. Each one is
# a method of the same name.
#
# The module also holds one process default. Library code that gets no
# logger asks for it, so no library has to die for the lack of one.

# The mode decides where a message goes. MODE_SYSLOG is for a daemon,
# MODE_STDERR for a program with a terminal, and MODE_QUIET drops
# every message.
use constant {
	MODE_SYSLOG => 'syslog',
	MODE_STDERR => 'stderr',
	MODE_QUIET  => 'quiet',
};

# The process default. Fugu::Log->default creates a stderr logger
# on the first call, so the accessor always answers with a logger.
my $default;

# Level parsing and mapping. One spelling per level: the five method
# names above are the whole vocabulary, and the daemon validates its
# configuration against them at startup.
my %level_map = (
	debug   => 0,
	info    => 1,
	notice  => 2,
	warning => 3,
	error   => 4,
);

my %priority_map = (
	debug   => LOG_DEBUG,
	info    => LOG_INFO,
	notice  => LOG_NOTICE,
	warning => LOG_WARNING,
	error   => LOG_ERR,
);

my %facility_map = (
	daemon => LOG_DAEMON,
	user   => LOG_USER,
	local0 => LOG_LOCAL0,
	local1 => LOG_LOCAL1,
	local2 => LOG_LOCAL2,
	local3 => LOG_LOCAL3,
	local4 => LOG_LOCAL4,
	local5 => LOG_LOCAL5,
	local6 => LOG_LOCAL6,
	local7 => LOG_LOCAL7,
);

# _parse_level($level):
#	The canonical level name. An unknown one falls back to info:
#	the boundary validates, and the library stays usable.
sub _parse_level ($level)
{
	$level = lc($level);
	return exists $level_map{$level} ? $level : 'info';
}

sub _level_to_priority ($level)
{
	$level = lc($level);
	return $priority_map{$level} // LOG_INFO;
}

sub _parse_facility ($facility)
{
	$facility = lc($facility);
	return $facility_map{$facility} // LOG_DAEMON;
}

# The mechanism names of Sys::Syslog that syslog_method accepts.
# eventlog is not in the set: it needs the Win32 API, and Fugu
# supports OpenBSD, Linux and Darwin.
my %method_set =
    map { $_ => 1 } qw(console inet native pipe stream tcp udp unix);

# _parse_methods($value):
#	The syslog_method value as an array reference of mechanism
#	names, in the order to give to setlogsock. The module validates
#	the value here, at the boundary, and never again. An unknown
#	name dies: a logger must not open a transport that the caller
#	never named.
sub _parse_methods ($value)
{
	my @names = ref $value eq 'ARRAY' ? @$value : ($value);

	for my $name (@names) {
		next if defined $name && $method_set{$name};
		die 'Invalid syslog method: ' . ( $name // 'undef' );
	}

	return \@names;
}

# _pin_method($methods):
#	Pin the syslog transport to the named mechanism list. The
#	default list holds native alone: OpenBSD syslog(3) delivers
#	with sendsyslog(2), so a daemon that pledges "stdio" keeps its
#	log after the pin. A failed pin restores the default transport
#	list of Sys::Syslog, and that list holds mechanisms that open a
#	socket. The module must not continue with that list, so a
#	failure dies here, at the open, and not at the first log line
#	inside a pledged process. An empty list pins nothing, and
#	Sys::Syslog keeps its own order.
sub _pin_method ($methods)
{
	return unless @$methods;

	unless ( setlogsock( [@$methods] ) ) {
		die 'Cannot pin the syslog method to ' . join ' ', @$methods;
	}
}

sub new ( $class, %args )
{
	my $mode  = $args{mode}  // MODE_STDERR;
	my $level = $args{level} // 'info';
	my $ident = $args{ident} // 'fugu';

	# Validate the mode
	unless ( $mode =~ /^(syslog|stderr|quiet)$/ ) {
		die "Invalid log mode: $mode";
	}

	# Validate the transport in every mode; syslog mode alone uses
	# it. ident and facility behave the same way.
	my $methods = _parse_methods( $args{syslog_method} // 'native' );

	# Convert the facility string to a constant if necessary
	my $facility = $args{facility} // LOG_DAEMON;
	if ( ref($facility) eq '' && $facility =~ /^\w+$/ ) {
		$facility = _parse_facility($facility);
	}

	my $name = _parse_level($level);

	my $self = bless {
		mode          => $mode,
		level         => $level_map{$name},
		level_name    => $name,
		ident         => $ident,
		facility      => $facility,
		syslog_method => $methods,
		opened        => 0,
	}, $class;

	if ( $mode eq MODE_SYSLOG ) {
		_pin_method($methods);
		openlog( $ident, 'ndelay,pid', $self->{facility} );
		$self->{opened} = 1;
	}
	elsif ( $mode eq MODE_STDERR ) {

		# A daemonized process has a buffered stderr, because
		# the descriptor is a dup of the redirected stdout. An
		# unflushed diagnostic that arrives after the crash it
		# describes is worse than no diagnostic.
		STDERR->autoflush(1);
	}

	return $self;
}

# Fugu::Log->default:
#	Return the process default logger. The first call creates a
#	stderr logger, so the method never returns undef.
sub default ($class)
{
	$default //= $class->new( mode => MODE_STDERR );
	return $default;
}

# Fugu::Log->set_default($log):
#	Replace the process default logger. A program sets this once at
#	startup, and again after a privilege drop. The method returns
#	the new default.
sub set_default ( $class, $log )
{
	$default = $log;
	return $default;
}

sub DESTROY ($self)
{
	if ( $self->{opened} && $self->{mode} eq MODE_SYSLOG ) {
		closelog();
	}
}

# Logging methods
sub debug   ( $self, $fmt, @args ) { $self->_log( 'debug',   $fmt, @args ); }
sub info    ( $self, $fmt, @args ) { $self->_log( 'info',    $fmt, @args ); }
sub notice  ( $self, $fmt, @args ) { $self->_log( 'notice',  $fmt, @args ); }
sub warning ( $self, $fmt, @args ) { $self->_log( 'warning', $fmt, @args ); }
sub error   ( $self, $fmt, @args ) { $self->_log( 'error',   $fmt, @args ); }

# $self->_log($level, $fmt, @args):
#	Internal logging method
sub _log ( $self, $level, $fmt, @args )
{
	return if $self->{mode} eq MODE_QUIET;

	return if $level_map{$level} < $self->{level};

	my $message = @args ? sprintf( $fmt, @args ) : $fmt;

	if ( $self->{mode} eq MODE_SYSLOG ) {
		my $priority = _level_to_priority($level);
		syslog( $priority, '%s', $message );
	}
	elsif ( $self->{mode} eq MODE_STDERR ) {
		my $timestamp = _timestamp();
		my $level_str = uc($level);
		printf STDERR "[%s] %s: %s\n", $timestamp, $level_str, $message;
	}
}

# $self->set_level($level):
#	Change the minimum log level
sub set_level ( $self, $level )
{
	my $name = _parse_level($level);

	$self->{level}      = $level_map{$name};
	$self->{level_name} = $name;
}

# $self->level:
#	Return the minimum log level by name, one of the five levels.
sub level ($self)
{
	return $self->{level_name};
}

# $self->mode:
#	Return the mode, one of the MODE_* constants.
sub mode ($self)
{
	return $self->{mode};
}

# $self->syslog_method:
#	Return the syslog transport as an array reference, in the
#	order the module gives to setlogsock. An empty reference
#	reports that the module pins nothing. The accessor takes no
#	argument: new and reopen are the two calls that talk to
#	Sys::Syslog, and both read the stored value.
sub syslog_method ($self)
{
	return [ @{ $self->{syslog_method} } ];
}

# $self->reopen:
#	Close and open the log again with the same settings. A daemon
#	calls this after it drops privileges: the syslog connection
#	belongs to the user that opened it. In the other modes the
#	method does nothing and returns the object.
sub reopen ($self)
{
	if ( $self->{mode} eq MODE_SYSLOG ) {
		closelog() if $self->{opened};

		# The transport list is process-wide state, so a pin
		# from the first open does not last. Pin it again.
		_pin_method( $self->{syslog_method} );
		openlog( $self->{ident}, 'ndelay,pid', $self->{facility} );
		$self->{opened} = 1;
	}

	return $self;
}

sub _timestamp()
{
	my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime;
	return sprintf(
		'%04d-%02d-%02d %02d:%02d:%02d',
		$year + 1900,
		$mon + 1, $mday, $hour, $min, $sec
	);
}

1;
