package NGCP::Daemon;

=encoding utf8

=head1 NAME

NGCP::Daemon - class to implement NGCP daemons

=head1 DESCRIPTION

The NGCP::Daemon class can be used to easily implement an NGCP daemon.

=cut

use strict;
use warnings;

use POSIX qw(:errno_h :sys_wait_h setsid _exit);
use IO::Socket::UNIX;
use NGCP::Log;

our $VERSION = '0.01';

=head1 METHODS

=item $daemon = NGCP::Daemon->new(%opts)

Create a new NGCP::Daemon object.
The following options can be set to control the daemon behavior:

=over 4

=item progname => $name

The program name, used by default as part of the B<pidfile> and the log
output.
The default will be set from the basename of the current program name.

=item nicename => $name

The nice presentation name, used for notices.
The default will be set from the B<progname> prefixing B<NGCP > and
stripping B<ngcp-> from it.

=item pidfile => $pathname

The pathname to the pidfile.
Defaults to F</run/>I<progname>F<.pid>.

=item logfile => $name

The logfile to use.
It can be B<syslog>, B<console> or a pathname.
There is no default.

=item keep_stdout => $bool

Whether to keep the stdout open when logging into B<syslog>.
Defaults to false.

=item keep_stderr => $bool

Whether to keep the stderr open when logging into B<syslog>.
Defaults to false.

=item debug => $bool

Whether to enable debugging output.
Defaults to false.

=item daemonize => $bool

Whether to daemonize.
Defaults to true.

=item log => $object

An L<NGCP::Log> object to use for logging.
Defaults to creating an object from the options specified.

=back

=cut

sub new
{
    my ($this, %opts) = @_;
    my $class = ref($this) || $this;

    my $progname = $opts{progname} // $0 =~ m{(?:.*/)?([^/]*)};
    my $nicename = $progname =~ s/^ngcp-//;

    my $self = {
        progname => $progname,
        descname => $opts{descname} // "NGCP $nicename",
        pidfile => $opts{pidfile} // "/run/$progname.pid",
        logfile => $opts{logfile},
        keep_stdout => $opts{keep_stdout} // 0,
        keep_stderr => $opts{keep_stderr} // 0,
        debug => $opts{debug},
        daemonize => $opts{daemonize} // 1,
        log => $opts{log},
        _gone => 0,

    };
    bless $self, $class;

    $self->{log} //= $self->new_logger();

    return $self;
}

=item $daemon->new_logger()

=cut

sub new_logger
{
    my ($self, %opts) = @_;

    my %log_opts;
    if (not $self->{debug}) {
        $log_opts{upto} = 'info';
    }
    $log_opts{output} = $self->{logfile};
    if (defined $self->{logfile} && $self->{logfile} ne 'syslog') {
        $log_opts{use_timestamps} = 1;
    }

    my $log = NGCP::Log->new(
        progname => $self->{progname},
        facility => 'daemon',
        hook_handlers => 1,
        %log_opts,
    );

    open my $devnullfh, '+<', '/dev/null'
        or $log->fatal("cannot open /dev/null");
    open STDIN, '<&', $devnullfh
        or $log->fatal("cannot quiesce stdin");

    if ($self->{logfile} eq 'syslog') {
        if (not $self->{keep_stdout}) {
            open STDOUT, '>&', $devnullfh
                or $log->fatal("cannot quiesce stdout");
        }
        if (not $self->{keep_stderr}) {
            open STDOUT, '>&', $devnullfh
                or $log->fatal("cannot quiesce stdout");
        }
    }

    return $log;
}

=item $daemon->init()

Initialize the daemon, by checking whether it is already running, then
daemonizing if needed, writing the pidfile, creating a logger and emitting
a notice.

=cut

sub init
{
    my $self = shift;

    if ($self->is_running) {
        $self->fatal("daemon already running");
    }

    if ($self->{daemonize}) {
        $self->daemonize();
    } else {
        $self->write_pidfile();
    }

    $self->notice("Initializing $self->{descname}");

    return;
}

=item $daemon->log()

Returns the current daemon L<NGCP::Log> object.

=cut

## no critic (Subroutines::ProhibitBuiltinHomonyms)
sub log
{
    my $self = shift;

    return $self->{log};
}

=item $daemon->sysfatal($msg)

Calls the L<NGCP::Log> B<sysfatal> method.

=cut

sub sysfatal
{
    my $self = shift;

    $self->{log}->sysfatal(@_);

    return;
}

=item $daemon->fatal($msg)

Calls the L<NGCP::Log> B<fatal> method.

=cut

sub fatal
{
    my $self = shift;

    $self->{log}->fatal(@_);

    return;
}

=item $daemon->error($msg)

Calls the L<NGCP::Log> B<error> method.

=cut

sub error
{
    my $self = shift;

    $self->{log}->error(@_);

    return;
}

=item $daemon->warning($msg)

Calls the L<NGCP::Log> B<warning> method.

=cut

sub warning
{
    my $self = shift;

    $self->{log}->warning(@_);

    return;
}

=item $daemon->notice($msg)

Calls the L<NGCP::Log> B<notice> method.

=cut

sub notice
{
    my $self = shift;

    $self->{log}->notice(@_);

    return;
}

=item $daemon->info($msg)

Calls the L<NGCP::Log> B<info> method.

=cut

sub info
{
    my $self = shift;

    $self->{log}->info(@_);

    return;
}

=item $daemon->debug($msg)

Calls the L<NGCP::Log> B<debug> method.

=cut

sub debug
{
    my $self = shift;

    $self->{log}->debug(@_);

    return;
}

=item $daemon->notify_send()

Sends a systemd readiness notification.

=cut

sub notify_send
{
    my ($self, $message) = @_;

    if ($ENV{NOTIFY_SOCKET}) {
        my $addr = $ENV{NOTIFY_SOCKET} =~ s/^@/\0/r;
        my $sock = IO::Socket::UNIX->new(
            Type => SOCK_DGRAM(),
            Peer => $addr,
        ) or $self->warning("cannot connect to socket $ENV{NOTIFY_SOCKET}: $!");
        if ($sock) {
            $sock->autoflush(1);
            print { $sock } $message
                or $self->warning("cannot send to socket $ENV{NOTIFY_SOCKET}: $!");
            close $sock;
        }
    } else {
        $self->warning("NOTIFY_SOCKET environment variable not set");
    }

    return;
}

=item $daemon->notify_ready()

Sends and logs a ready notification.

=cut

sub notify_ready
{
    my $self = shift;

    $self->notice("$self->{descname} ready");
    $self->notify_send("READY=1\n");

    return;
}

=item $daemon->notify_stopping()

Sends and logs a stopping notification.

=cut

sub notify_stopping
{
    my $self = shift;

    $self->notify_send("STOPPING=1\n");
    $self->notice("$self->{descname} stopping");

    return;
}

=item $daemon->write_pidfile([$pid])

Write the specified C<$pid> or the current one if not specified, into
the pidfile.

=cut

sub write_pidfile
{
    my ($self, $pid) = @_;

    $pid //= $$;

    open my $pidfh, '>', $self->{pidfile}
        or $self->fatal("cannot create pidfile $self->{pidfile}");
    print { $pidfh } "$pid\n";
    close $pidfh or $self->fatal("cannot close pidfile $self->{pidfile}");

    return;
}

=item $daemon->remove_pidfile()

Removes the pidfile.

=cut

sub remove_pidfile {
    my $self = shift;

    unlink $self->{pidfile};

    return;
}

=item $bool = $daemon->is_running()

Checks whether the daemon is currently running.

=cut

sub is_running {
    my $self = shift;

    return 0 unless -e $self->{pidfile};

    open my $pidfh, '<', $self->{pidfile}
        or $self->fatal("cannot open pidfile $self->{pidfile}");
    my ($pid) = <$pidfh>;
    close $pidfh;

    return 1 if kill 0, $pid;
    unlink $self->remove_pidfile();
    return 0;
}

sub _wait_for_child
{
    my ($self, $pid) = @_;
    my $child;

    do {
        $child = waitpid $pid, 0;
    } while ($child < 0 && $! == EINTR);

    $self->fatal("error waiting for child (PID $child)") if $child != $pid;

    if (WIFEXITED($?)) {
        my $rc = WEXITSTATUS($?);

        $self->fatal("child returned error exit status $rc") if $rc;
    } elsif (WIFSIGNALED($?)) {
        my $signo = WTERMSIG($?);

        $self->fatal("child was killed by signal $signo");
    } else {
        $self->fatal("unexpected status $? waiting for child");
    }

    return;
}

=item $daemon->daemonize()

Daemonizes the current process.
If there is any error, the function will terminate the process and its child.

=cut

sub daemonize
{
    my $self = shift;
    my $pid;

    $pid = fork;
    if ($pid < 0) {
        $self->fatal("cannot do first fork");
    } elsif ($pid > 0) {
        # First parent.
        $self->_wait_for_child($pid);

        _exit(0);
    }

    if (setsid() < 0) {
        $self->fatal("cannot set session ID");
    }

    $pid = fork;
    if ($pid < 0) {
        $self->fatal("cannot do second fork");
    } elsif ($pid > 0) {
        # Second parent.
        $self->write_pidfile($pid);
        _exit(0);
    }

    return;
}

=item $daemon->reload()

Reload the daemon.

This currently implies sending and logging reloading and ready readiness
notifications, and reloading the logger.

=cut

sub reload
{
    my $self = shift;

    $self->notice("Reloading $self->{descname}");

    $self->notify_send("RELOADING=1\n");
    $self->log->reload();
    $self->notify_send("READY=1\n");

    return;
}

=item $daemon->shutdown()

Shutdown the daemon.

This currently implies removing the pidfile, and logging a notice about
the daemon shutting down.

=cut

## no critic (Subroutines::ProhibitBuiltinHomonyms)
sub shutdown
{
    my $self = shift;

    return if $self->{_gone};

    $self->remove_pidfile();

    $self->notice("Shutting down $self->{descname}");

    $self->{_gone} = 1;

    return;
}

=head1 BUGS AND LIMITATIONS

Please report problems you notice to the Sipwise
Development Team <support@sipwise.com>.

=head1 AUTHOR

Guillem Jover <gjover@sipwise.com>

=head1 LICENSE

Copyright (C) 2016-2022 Sipwise GmbH, Austria

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.

=cut

1;
