#!/usr/bin/perl

=head1 NAME

pfconfig - Serves configuration through a socket

=cut

=head1 SYNOPSIS

pfconfig [options]

 Options:
   -d                 Daemonize
   -h                 Help
   -s SOCK_PATH       The path to the unix socket path - default $PFDIR/var/pfconfig.sock
   -n NAME            The name of process as reported in ps - default pfconfig
   -p PID_PATH        The path to the PID file (optional)
   -c CONFIG_PATH     The path to the configuration file (optional)

=cut

use strict;
use warnings;

BEGIN {
    #Ensure that the file permissions of the log file is correct 0660
    umask (0);
    use constant INSTALL_DIR => '/usr/local/pf';
    use lib INSTALL_DIR . "/lib";
    use pf::log (service => 'pfconfig');
}

use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN );
use pf::config::tenant;
use JSON::MaybeXS;
use pfconfig::manager;
use Data::Dumper;
use Time::HiRes;
use List::MoreUtils qw(first_index);
use File::Basename qw(basename);
use Getopt::Std;
use POSIX qw(:signal_h);
use File::FcntlLock;
use pf::services::util;
use pf::file_paths qw($var_dir);
use pfconfig::constants;
use Sereal::Encoder qw(sereal_encode_with_object);
use pf::Sereal qw($ENCODER);
use Errno qw(EINTR EAGAIN);
use bytes;
use pf::util::networking qw(send_data_with_length);
use Systemd::Daemon qw{ -soft };
our $RUNNING = 1;

## All pfconfig objects implementing TO_JSON must be imported here
use pfconfig::objects::NetAddr::IP;
use pfconfig::objects::Net::Netmask;

my %args = (
    s => $pfconfig::constants::SOCKET_PATH,
    #Name of the process
    n => "pfconfig",
);

getopts( 'dhs:n:p:c:', \%args );

my $logger = get_logger;

our $PROGRAM_NAME = $0 = $args{n};
our $PID_FILE = $args{p} // "${var_dir}/run/$PROGRAM_NAME.pid";

# init signal handlers
POSIX::sigaction(
    &POSIX::SIGHUP,
    POSIX::SigAction->new(
        'normal_sighandler', POSIX::SigSet->new(), &POSIX::SA_NODEFER
    )
) or $logger->logdie("pfconfig: could not set SIGHUP handler: $!");

POSIX::sigaction(
    &POSIX::SIGTERM,
    POSIX::SigAction->new(
        'normal_sighandler', POSIX::SigSet->new(), &POSIX::SA_NODEFER
    )
) or $logger->logdie("pfconfig: could not set SIGTERM handler: $!");

POSIX::sigaction(
    &POSIX::SIGINT,
    POSIX::SigAction->new(
        'normal_sighandler', POSIX::SigSet->new(), &POSIX::SA_NODEFER
    )
) or $logger->logdie("pfconfig: could not set SIGINT handler: $!");

my $daemonize = $args{d};

# standard signals and daemonize
daemonize($PROGRAM_NAME, $PID_FILE) if ($daemonize);

my $FILE_LOCK = getLockOnPid($PID_FILE);

unless ($FILE_LOCK) {
    die "cannot lock $PID_FILE another $PROGRAM_NAME is running\n";
}

# empty control file directory so subcaches in other processes
# are expired when pfconfig is starting
unlink glob "$pfconfig::constants::CONTROL_FILE_DIR/*";

$pfconfig::constants::CONFIG_FILE_PATH = $args{c} if($args{c});

my $socket_path = $args{s};
unlink($socket_path);

#Ensure that the file permissions of the socket is correct 0770
umask(0007);

my $listner = IO::Socket::UNIX->new(
   Type   => SOCK_STREAM,
   Local  => $socket_path,
   Listen => SOMAXCONN,
) or die("Can't create server socket: $!\n");

umask(0);

my $cache = pfconfig::manager->new;
$cache->preload_all();

our %DISPATCH = (
    'expire'             => \&expire,
    'element'            => \&get_element,
    'hash_element'       => \&get_hash_element,
    'keys'               => \&get_keys,
    'next_key'           => \&get_next_key,
    'key_exists'         => \&get_key_exists,
    'array_element'      => \&get_array_element,
    'array_size'         => \&get_array_size,
    'array_index_exists' => \&get_array_index_exists,
    'sleep'              => \&server_sleep,
);

Systemd::Daemon::notify( READY => 1, STATUS => "Ready", unset => 1 );
# Used to set the current prefered encoding
my $encoding;

while($RUNNING) {
    # reset the encoding
    $encoding = undef;

    my $socket;
    my $line;
    eval {
        my $paddr = accept($socket,$listner);
        #Check if a signal was caught
        unless (defined $paddr || $! == EINTR) {
            die("Can't accept connection: $!\n");
        }
        if($paddr) {
            chomp( $line = <$socket> );

            if($line eq "exit") {exit}

            my $query = decode_json($line);
            #use Data::Dumper;
            #print Dumper($query);
            $encoding = $query->{encoding};
            my $tenant_id =  $query->{tenant_id};
            if (defined $tenant_id) {
                pf::config::tenant::set_tenant($tenant_id);
            } else {
                pf::config::tenant::reset_tenant();
            }

            # we support hash namespaced queries
            # where
            #  - line = 'config' return the whole config hash
            #  - line = 'config;value' return the value in the config hash
            my $method = $query->{method};
            if (exists $DISPATCH{$method}) {
                $DISPATCH{$method}->($query, $socket);
            } else {
                print STDERR "Unknown method $query->{method}";
                print "undef";
            }
        }
        $socket = undef;
    };
    if($@){
        print STDERR "$line : $@";
        send_output(undef, $socket) if $socket;
    }
}

$logger->info("Stop running\n");

END {
    if (!$args{h} && $FILE_LOCK ) {
        Systemd::Daemon::notify( STOPPING => 1 );
        deletepid($PROGRAM_NAME, $PID_FILE);
    }
}

sub expire {
    my ($query, $socket) = @_;
    my $namespace = $query->{namespace};
    my $light = $query->{light};
    if($namespace eq "__all__"){
        $cache->expire_all($light);
    }
    else{
        $logger->info("expiring $namespace");
        $cache->expire($namespace, $light);
    }
    send_output({status => "OK."}, $socket);
}

sub get_from_cache {
    my ($what) = @_;
    my $elem;
    # let's get the top namespace element
    $elem = $cache->get_cache($what);

    return $elem;
}

sub get_element {
    my ($query, $socket) = @_;
    my $elem = get_from_cache_or_croak($query->{key}, $socket);
    return unless(defined($elem));
    send_output({element => $elem}, $socket);
}

sub get_hash_element {
    my ($query, $socket) = @_;

    my @keys = split ';', $query->{key};

    my $elem = get_from_cache_or_croak($keys[0], $socket);
    return unless(defined($elem));

    # if we want a subnamespace we handle it here
    if($keys[1]){
        my $sub_elem = $elem->{$keys[1]};
        if(defined($sub_elem)){
            $elem = {element => $sub_elem};
        }
        else{
            $logger->debug("Unknown key $query->{key}");
            $elem = undef;
        }
    }
    else{
        $elem = {element => $elem};
    }
    send_output($elem, $socket);
}

sub get_from_cache_or_croak {
    my ($key, $socket) = @_;
    my $elem = get_from_cache($key);

    if(defined($elem)){
        return $elem;
    }
    else{
        $logger->debug("Unknown key $key");
        send_output(undef, $socket);
        return undef;
    }

}

sub get_keys {
    my ($query, $socket) = @_;

    my $elem = get_from_cache_or_croak($query->{key}, $socket);
    return unless(defined($elem));

    my @keys = keys(%{$elem});
    send_output(\@keys, $socket);
}

sub get_key_exists {
    my ($query, $socket) = @_;

    my $elem = get_from_cache_or_croak($query->{key}, $socket);
    return unless(defined($elem));

    my @keys = keys(%{$elem});

    my $key = $query->{search};
    if($key ~~ @keys){
        send_output({result => 1}, $socket);
    }
    else {
        send_output({result => 0}, $socket);
    }

}

sub get_next_key {
    my ($query, $socket) = @_;

    my $elem = get_from_cache_or_croak($query->{key}, $socket) || return;

    my @keys = keys(%{$elem});

    my $last_key = $query->{last_key};

    my $next_key;
    unless($last_key){
        $next_key = $keys[0];
    }
    else{
        my $last_index;
        $last_index = first_index { $_ eq $last_key} @keys ;

        if($last_index >= scalar @keys){
            $next_key = undef;
        }

        $next_key = $keys[$last_index+1];
    }
    send_output({next_key => $next_key}, $socket);
}

sub get_array_element {
    my ($query, $socket) = @_;

    my @keys = split ';', $query->{key};

    my $elem = get_from_cache_or_croak($keys[0], $socket) || return;

    # if we want an index we handle it here
    if(defined($keys[1])){
        my $sub_elem = $$elem[$keys[1]];
        if(defined($sub_elem)){
            $elem = {element => $sub_elem};
        }
        else{
            print STDERR "Unknown index in $query->{key}";
            $logger->error("Unknown index in $query->{key}");
            $elem = undef;
        }
    }
    else {
        $elem = {element => $elem};
    }

    send_output($elem, $socket);

}

sub get_array_index_exists {
    my ($query, $socket) = @_;
    my $elem = get_from_cache_or_croak($query->{key}, $socket) || return;

    if(exists($$elem[$query->{index}])) {
        send_output({result => 1}, $socket);
    }
    else{
        send_output({result => 0}, $socket);
    }

}

sub get_array_size {
    my ($query, $socket) = @_;
    my $elem = get_from_cache_or_croak($query->{key}, $socket) || return;
    my $size = @$elem;
    send_output({size => $size}, $socket);
}

sub encode_output {
    my ($data) = @_;
    $encoding //= "sereal";
    if($encoding eq "sereal") {
        return sereal_encode_with_object($ENCODER, $data);
    }
    elsif($encoding eq "json") {
        my $json = JSON->new;
        $json->convert_blessed(1);
        my $result;
        if(!defined($data)) {
            return $json->encode({error => "No valid element was found for query"});
        }
        eval {
            $result = $json->encode($data);
        };
        if($@) {
            return $json->encode({error => "Cannot transform object into JSON data: $@"});
        }
        return $result;
    }
    my $msg = "Unknown encoding '$encoding'";
    $logger->error($msg);
    return $msg;
}

sub send_output {
    my ($data, $socket) = @_;
    my $encoded_data = encode_output($data);
    my $bytes_to_send = length($encoded_data);
    my $bytes_sent  = send_data_with_length($socket,$encoded_data);
    if($bytes_to_send != $bytes_sent) {
        $logger->error("Could not send all bytes the client. $bytes_sent of $bytes_to_send sent");
    }
}

=head2 server_sleep

=cut

sub server_sleep {
    my ($query, $socket) = @_;
    sleep 10;
}


=head2 normal_sighandler

the signal handler to shutdown the service

=cut

sub normal_sighandler {
    $RUNNING = 0;
}

=head2 getLockOnPid

get lock on pid file

=cut

sub getLockOnPid {
    my ($filename) = @_;
    my $fs = File::FcntlLock->new(
        l_type   => F_WRLCK,
        l_whence => SEEK_SET,
        l_start => 0,
        l_len => 0,
    );
    my $fh;
    unless (open($fh, "+>>", $filename)) {
        $logger->error("Cannot open $filename: $!");
        return undef;
    }
    my $result = $fs->lock($fh, F_SETLK); 
    unless (defined $result) {
        $logger->error("Error getting lock on $filename: $!");
        return undef;
    }
    return $fh;
}

=back

=head1 AUTHOR

Inverse inc. <info@inverse.ca>

=head1 COPYRIGHT

Copyright (C) 2005-2021 Inverse inc.

=head1 LICENSE

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 2
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, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
USA.

=cut

