#!/usr/bin/perl -w

use OpenXPKI;

# Core modules
use Getopt::Long;
use Pod::Usage;
use File::Spec;
use List::Util qw( any );
use FindBin qw( $Script );
use Module::Load ();
use Module::Metadata;
use Cwd qw( abs_path );

# CPAN modules
use Log::Log4perl qw( :easy :no_extra_logdie_message );
use PPI::Document;

# Project modules
use OpenXPKI::Control::Role;
use OpenXPKI::Control::Server;
use OpenXPKI::Log4perl;

$OUTPUT_AUTOFLUSH = 1;

sub command_list {
    my @commands = sort
        map { my $cmd = $_; $cmd =~ s/^cmd_//; $cmd }
        grep { $_ =~ /^cmd_/ }
        OpenXPKI::Control::Role->meta->get_required_method_list;
    push @commands, 'help';
    return @commands;
}

sub scope_classes {
    return {
        client => 'OpenXPKI::Control::Client',
        server => 'OpenXPKI::Control::Server',
        terminal => 'OpenXPKI::Control::Terminal',
    };
}

sub show_pod (@args) {
    my %args = @args;
    my $pod = delete $args{-oxi_pod} // get_file_pod(__FILE__);

    # inject variables
    $pod =~ s/%%CONTROL_SCRIPT%%/$Script/g;
    if ($pod =~ /%%CONTROL_SCOPES%%/) {
        my $scopes = join "\n", map { '    ' . $_ } sort keys scope_classes->%*;
        $pod =~ s/%%CONTROL_SCOPES%%/$scopes/g;
    }
    if ($pod =~ /%%CONTROL_COMMANDS%%/) {
        my $commands = join "\n", map { '    ' . $_ } command_list;
        $pod =~ s/%%CONTROL_COMMANDS%%/$commands/g;
    }

    # print formatted POD
    open my $pod_fh, '<', \$pod;
    pod2usage(%args, -input => $pod_fh);
}

sub get_class_pod ($class) {
    my $meta = Module::Metadata->new_from_module($class);
    return get_file_pod($meta->filename);
}

sub get_file_pod ($filename) {
    my $doc = PPI::Document->new($filename);
    my $sub_nodes = $doc->find( sub { $_[1]->isa('PPI::Token::Pod') } );
    my $pod = join "\n", map { $_->content } $sub_nodes->@*;
    return $pod || "=head1 USAGE\n\nNo specific help available\n";
}

sub dir_key ($path) {
    my @st = stat($path) or return;
    return "$st[0]:$st[1]"; # dev:ino
}

sub find_recursions ($path) {
    state %seen_inodes; # "dev:ino" -> "path" (only for dirs on current directory path)
    my @recursions;

    $path =~ s{/$}{};
    my $key = dir_key($path) or return;

    # Paranoia - this should have been caught earlier (below)
    return if exists $seen_inodes{$key};

    # Mark directory as being on the current path
    $seen_inodes{$key} = $path;

    # Check directory contents
    opendir my $dh, $path or do { delete $seen_inodes{$key}; return };
    my @entries = grep { $_ ne '.' && $_ ne '..' } readdir $dh;
    closedir $dh;

    for my $entry (@entries) {
        my $subdir = "$path/$entry";
        next unless -d $subdir; # only check directories (including symlinks)
        # check symlink
        if ( -l $subdir ) {
            my $subdir_abs = abs_path($subdir);
            next unless defined $subdir_abs; # ignore dangling symlinks

            my $subdir_key = dir_key($subdir_abs);
            next unless defined $subdir_key;

            # loop = target dir was already seen on the current path hierarchy
            if ( exists $seen_inodes{$subdir_key} ) {
                push @recursions, [ $subdir, $seen_inodes{$subdir_key} ];
                next;
            }
        }
        # Recurse into subdir (normal or symlink)
        push @recursions, find_recursions($subdir);
    }
    delete $seen_inodes{$key};
    return @recursions;
}

# Help
show_pod(-verbose => 1) unless @ARGV;

#
# Argument parsing (global arguments)
#
my $verbosity = 0;
my %global_opts = ('verbose' => \$verbosity);
Getopt::Long::Configure('pass_through','bundling');
GetOptions( \%global_opts, qw(
    help|?
    man
    verbose|v+
    config|c=s
    instance|i=s
));
Getopt::Long::Configure('no_pass_through');

show_pod(-exitstatus => 0, -verbose => 2) if $global_opts{man};

# --help without arguments: show our own POD
show_pod(-verbose => 1) if ($global_opts{help} and not @ARGV);

#
# Log4perl
#
$global_opts{l4p_level} = 'WARN';
if ($verbosity == 1) {
    $global_opts{l4p_level} = 'INFO';
} elsif ($verbosity == 2) {
    $global_opts{l4p_level} = 'DEBUG';
} elsif ($verbosity > 2) {
    $global_opts{l4p_level} = 'TRACE';
}
OpenXPKI::Log4perl->init_screen_logger($global_opts{l4p_level});

#
# Attributes defined by OpenXPKI::Control::Role
#
my $config_path;
if ($global_opts{config}) {
    $config_path = File::Spec->rel2abs($global_opts{config});
} elsif ($global_opts{instance}) {
    $config_path = sprintf '/etc/openxpki/%s/config.d/', $global_opts{instance};
}

#
# Check config path for recursive symlinks (can cause huge delays or crash Config::Merge)
#
my $check_dir = $config_path // $OpenXPKI::Defaults::SERVER_CONFIG_DIR;
if (my @rec = find_recursions($check_dir)) {
    my $findings = join "----\n", map { sprintf "      symlink: %s\njumps back to: %s\n", $_->[0], $_->[1] } @rec;
    LOGDIE("Recursive directory symlinks found in $check_dir:\n$findings");
}

#
# Command processing
#
my $command = shift;

my %role_attrs;
$role_attrs{config_path} = $config_path if $config_path;

if ($command eq 'version') {
    my $ver = OpenXPKI::Control::Server->new(%role_attrs)->get_version;
    say $ver;
    exit 0;

} elsif (any { $command eq $_} (command_list) ) {
    my $scope = shift;

    if (not $scope) {
        # --help COMMAND: show brief help with available scopes
        if ($global_opts{help}) {
            show_pod(
                -verbose => 1,
                -oxi_pod => "=head1 USAGE\n\n$Script $command SCOPE [OPTIONS]\n\nSCOPEs:\n\n%%CONTROL_SCOPES%%\n",
            );
        } else {
            LOGDIE("Missing scope after command.\nAvailable scopes: " . join(', ', sort keys scope_classes->%*));
        }
    }

    my $class = scope_classes->{$scope}
      or LOGDIE("Unknown scope '$scope'.\nAvailable scopes: " . join(', ', sort keys scope_classes->%*));

    Module::Load::load($class);

    if ($global_opts{help} or $command eq 'help') {
        # oxi help SCOPE: show scope POD
        show_pod(
            -oxi_pod => sprintf(
                "=head1 USAGE\n\n%s %s %s [OPTIONS]\n\n%s",
                $Script, $command eq 'help' ? 'COMMAND' : $command, $scope,
                get_class_pod($class),
            )
                ,
            -verbose => 99, # special value to enable '-sections'
            -sections => [
                'USAGE',
                'DESCRIPTION',
                $command eq 'help' ? 'COMMAND DETAILS' : "COMMAND DETAILS/$command",
                'OPTIONS',
            ],
        );
    }

    # Extract command+scope specific positional args BEFORE any --options.
    my @args;
    while (@ARGV and $ARGV[0] !~ /^-/) {
        push @args, shift;
    }

    # Evaluate (extract) command+scope specific options
    my %opts;
    if (my @getopts = $class->getopt_params($command)) {
        TRACE('GetOptions parameters: ' . Dumper \@getopts);
        GetOptions( \%opts, @getopts ) or exit 1;
    }

    # Extract command+scope specific positional args AFTER any --options.
    push @args, @ARGV;

    # Instantiate scope class
    my $control = $class->new(
        %role_attrs,
        global_opts => \%global_opts,
        opts => \%opts,
        args => \@args,
    );

    # Execute command
    TRACE(sprintf 'Calling %s->%s with options (%s) and arguments (%s)',
        $class,
        $command,
        join(', ', map { "$_=$opts{$_}" } sort keys %opts),
        join(', ', @args)
    );
    try {
        my $method = $control->can("cmd_$command");
        my $code = $control->$method;
        exit ($code // 0);
    }
    catch ($err) {
        my $magic = 0xDEADBEEF;
        if (not blessed $err and $err =~ /$magic/) {
            say "Command '$command' is not implemented for '$scope'";
        } else {
            die $err;
        }
    }

    exit 0;

} else {
    LOGDIE("Unknown command '$command'.\nAvailable commands: " . join(', ', command_list));
}

=head1 NAME

openxpkictl - Start and stop OpenXPKI processes

=head1 USAGE

openxpkictl COMMAND SCOPE [OPTIONS]

COMMANDs:

%%CONTROL_COMMANDS%%

    version     Print OpenXPKI version and license info

SCOPEs:

%%CONTROL_SCOPES%%

=head1 OPTIONS

=over

=item B<--help>

Show brief help.

=item B<--man>

Show manual page.

=item B<--config|c PATH>

Use the configuration repository (base of yaml tree) below PATH.

Default: /etc/openxpki/config.d

=item B<--instance|i NAME>

Shortcut to set the config path when running multiple instances using
the proposed config path layout (/etc/openxpki/I<NAME>/config.d).

=item B<--verbose|v>

Enable verbose logging. May be specified multiple times to increase verbosity.

This will be mapped to L<Log4perl> log levels, i.e.:

    -v     INFO
    -vv    DEBUG
    -vvv   TRACE

Default log level is ERROR.

=back

=head1 DESCRIPTION

B<openxpkictl> is the start script for the OpenXPKI server process.

=over

The openxpkictl script returns a 0 exit value on success, and >0 if  an
error occurs.

=back
