gniza4cp/whm/gniza-whm/lib/GnizaWHM/Runner.pm

package GnizaWHM::Runner;
# Pattern-based command runner for gniza CLI.
# Each allowed command has a regex per argument position for safe execution.

use strict;
use warnings;
use IPC::Open3;
use Symbol 'gensym';
use POSIX qw(setsid);
use File::Temp qw(tempfile);

my $GNIZA_BIN = '/usr/local/bin/gniza';

# Allowed command patterns.
# Each entry: [ subcommand, arg_patterns... ]
# arg_patterns are regexes applied to each positional argument.
my @ALLOWED = (
    # restore subcommands
    { cmd => 'restore', subcmd => 'account',        args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'files',           args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'database',        args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'database',        args => [qr/^[a-z][a-z0-9_-]*$/, qr/^[a-zA-Z0-9_]+$/] },
    { cmd => 'restore', subcmd => 'mailbox',         args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'mailbox',         args => [qr/^[a-z][a-z0-9_-]*$/, qr/^[a-zA-Z0-9._+-]+\@[a-zA-Z0-9._-]+$/] },
    { cmd => 'restore', subcmd => 'cron',             args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'dbusers',          args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'dbusers',          args => [qr/^[a-z][a-z0-9_-]*$/, qr/^[a-zA-Z0-9_]+$/] },
    { cmd => 'restore', subcmd => 'cpconfig',         args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'domains',          args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'domains',          args => [qr/^[a-z][a-z0-9_-]*$/, qr/^[a-zA-Z0-9._-]+$/] },
    { cmd => 'restore', subcmd => 'ssl',              args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'ssl',              args => [qr/^[a-z][a-z0-9_-]*$/, qr/^[a-zA-Z0-9._-]+$/] },
    { cmd => 'restore', subcmd => 'list-databases',   args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'list-mailboxes',   args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'list-files',       args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'list-dbusers',    args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'list-cron',       args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'list-dns',        args => [qr/^[a-z][a-z0-9_-]*$/] },
    { cmd => 'restore', subcmd => 'list-ssl',        args => [qr/^[a-z][a-z0-9_-]*$/] },
    # list
    { cmd => 'list',    subcmd => undef,             args => [] },
);

# Named option patterns (--key=value).
my %OPT_PATTERNS = (
    remote    => qr/^[a-zA-Z0-9_,-]+$/,
    timestamp => qr/^\d{4}-\d{2}-\d{2}T\d{6}$/,
    path      => qr/^[a-zA-Z0-9_.\/@ -]+$/,
    account   => qr/^[a-z][a-z0-9_-]*$/,
    exclude   => qr/^[a-zA-Z0-9_.,\/@ *?\[\]-]+$/,
    terminate => qr/^1$/,
);

# _validate($cmd, $subcmd, \@args, \%opts)
# Returns (1, undef) on success or (0, $error_msg) on failure.
sub _validate {
    my ($cmd, $subcmd, $args, $opts) = @_;
    $args //= [];
    $opts //= {};

    # Find matching allowed pattern
    my $matched;
    for my $pattern (@ALLOWED) {
        next unless $pattern->{cmd} eq $cmd;
        if (defined $pattern->{subcmd}) {
            next unless defined $subcmd && $subcmd eq $pattern->{subcmd};
        } else {
            next if defined $subcmd;
        }
        # Check arg count
        next unless scalar(@$args) == scalar(@{$pattern->{args}});
        # Validate each arg
        my $ok = 1;
        for my $i (0 .. $#$args) {
            unless ($args->[$i] =~ $pattern->{args}[$i]) {
                $ok = 0;
                last;
            }
        }
        if ($ok) {
            $matched = $pattern;
            last;
        }
    }

    unless ($matched) {
        my $desc = "gniza $cmd" . (defined $subcmd ? " $subcmd" : "") . " " . join(" ", @$args);
        return (0, "Command not allowed: $desc");
    }

    # Validate options
    for my $key (keys %$opts) {
        my $pat = $OPT_PATTERNS{$key};
        unless ($pat) {
            return (0, "Unknown option: --$key");
        }
        unless ($opts->{$key} =~ $pat) {
            return (0, "Invalid value for --$key: $opts->{$key}");
        }
    }

    return (1, undef);
}

# _shell_quote($str)
# Single-quote a string for safe shell embedding.
sub _shell_quote {
    my ($str) = @_;
    $str =~ s/'/'\\''/g;
    return "'$str'";
}

# _build_cmd_line($cmd, $subcmd, \@args, \%opts)
# Returns a shell command string.
sub _build_cmd_line {
    my ($cmd, $subcmd, $args, $opts) = @_;
    $args //= [];
    $opts //= {};

    my @parts = (_shell_quote($GNIZA_BIN), _shell_quote($cmd));
    push @parts, _shell_quote($subcmd) if defined $subcmd;
    push @parts, _shell_quote($_) for @$args;
    for my $key (sort keys %$opts) {
        push @parts, _shell_quote("--$key=$opts->{$key}");
    }

    return join(' ', @parts);
}

# run($cmd, $subcmd, \@args, \%opts)
# Returns ($success, $stdout, $stderr).
sub run {
    my ($cmd, $subcmd, $args, $opts) = @_;
    $args //= [];
    $opts //= {};

    my ($valid, $err) = _validate($cmd, $subcmd, $args, $opts);
    unless ($valid) {
        return (0, '', $err);
    }

    # Build exec args
    my @exec_args = ($cmd);
    push @exec_args, $subcmd if defined $subcmd;
    push @exec_args, @$args;
    for my $key (sort keys %$opts) {
        push @exec_args, "--$key=$opts->{$key}";
    }

    return _exec(@exec_args);
}

# run_async(\@commands)
# Each command: [$cmd, $subcmd, \@args, \%opts]
# Validates all commands upfront, then forks a detached child to run them.
# Returns ($success, $error_msg).
sub run_async {
    my ($commands) = @_;

    return (0, 'No commands provided') unless $commands && @$commands;

    # Validate all commands upfront
    my @cmd_lines;
    for my $c (@$commands) {
        my ($cmd, $subcmd, $args, $opts) = @$c;
        my ($valid, $err) = _validate($cmd, $subcmd, $args, $opts);
        unless ($valid) {
            return (0, $err);
        }
        push @cmd_lines, _build_cmd_line($cmd, $subcmd, $args, $opts);
    }

    # Write bash wrapper script
    my ($fh, $tmpfile) = tempfile('gniza-whm-job-XXXXXXXX', DIR => '/tmp', SUFFIX => '.sh');
    print $fh "#!/bin/bash\n";
    print $fh "set -uo pipefail\n";
    for my $line (@cmd_lines) {
        print $fh "$line\n";
    }
    print $fh "rm -f \"\$0\"\n";
    close $fh;
    chmod 0700, $tmpfile;

    # Fork and detach
    my $pid = fork();
    if (!defined $pid) {
        unlink $tmpfile;
        return (0, "Fork failed: $!");
    }

    if ($pid == 0) {
        # Child: detach from parent
        setsid();
        open STDIN,  '<', '/dev/null';
        open STDOUT, '>', '/dev/null';
        open STDERR, '>', '/dev/null';
        exec('/bin/bash', $tmpfile) or exit(1);
    }

    # Parent: don't wait for child
    return (1, '');
}

sub _exec {
    my (@args) = @_;

    my $err = gensym;
    my $pid = open3(my $in, my $out, $err, $GNIZA_BIN, @args);
    close $in;

    my $stdout = do { local $/; <$out> } // '';
    my $stderr = do { local $/; <$err> } // '';
    close $out;
    close $err;

    waitpid($pid, 0);
    my $exit_code = $? >> 8;

    return ($exit_code == 0, $stdout, $stderr);
}

1;