#!/usr/bin/perl

use strict;
use warnings;
my($app_svnid) = '$HeadURL$ $LastChangedRevision$'; ## no critic (RequireInterpolationOfMetachars)
use lib substr(`ade-config ade_share_prefix`,0,-1) . '/include'; ## no critic (ProhibitBacktickOperators)
use ADE;
use Getopt::Long qw(:config no_ignore_case);
use experimental 'smartmatch';  # for perl 5.18
use Data::Dumper;
use List::MoreUtils;
use List::Util;
use Fatal qw( close closedir umask );   #  obviate checking close's return code

my(%rocon_defined_errors) = (
    rocon_err_misc         => { fmt => '%s' },
);

#  Options
my ($opt_mode, $opt_config_file, $opt_timeout, $opt_threads, $opt_ssh_cmd, $opt_quiet, $opt_command);

#  Other globals
my($rocon_etc_prefix);
my($rocon_progname);
eval `rocon-config --format=perl rocon_etc_prefix`; ## no critic (ProhibitStringyEval, ProhibitBacktickOperators, RequireCheckingReturnValueOfEval)

sub rocon
{
    my($errstack_ref) = @_;
    my($rc, $rocon_conf_handle);

    #  Set ADE options
    ADE::ade_err_registerdefderrs(\%rocon_defined_errors);

    if (($rc=ADE::ade_app_get_progname($errstack_ref, \$rocon_progname)) != $ADE::ADE_ERR_OK) {
        return($rc);
    }

    #  Defaults for options
    $opt_config_file = $ENV{'ROCON_CFG_FILE'} ? $ENV{'ROCON_CFG_FILE'} : sprintf '%s/%s.conf', $rocon_etc_prefix, $rocon_progname;
    $opt_mode = undef;
    #$opt_ssh_cmd = ${ROCON_SSH_CMD:-ssh}
    $opt_ssh_cmd = 'ssh';
    $opt_quiet = 0;
    $opt_timeout= 0;
    $opt_threads = 200;

    #  Register options
    if (($rc=ADE::ade_opt_register($errstack_ref, 'rwemgc:sF:sqt:iT:i', 'ssh:s,quiet,timeout:i,threads:i', 'main::rocon_opt_handler_%s')) != $ADE::ADE_ERR_OK) {
        return($rc);
    }

    #  Register handler functions
    if (($rc=ADE::ade_msg_register($errstack_ref, \&rocon_usage, \&rocon_version, \&rocon_listpaths)) != $ADE::ADE_ERR_OK) {
        return($rc);
    }

    #  Process options
    ADE::ade_err_debug($errstack_ref, 10, 'rocon: processing options ...');
    if (($rc=ADE::ade_opt_process($errstack_ref)) != $ADE::ADE_ERR_OK) {
        return($rc);
    }

    #  Sanity checks and derivations
    if (not defined $opt_mode) {
        ADE::ade_msg_usage($errstack_ref);
    }
    ADE::ade_err_debug($errstack_ref, 10, "rocon: opt_config_file=$opt_config_file");
    if ($opt_mode ~~ [ qw( read write edit ) ] and $opt_config_file eq '-') {
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', 'edit/read/write modes are meaningless if the config file is stdin');
        return($ADE::ADE_ERR_FAIL);
    }
    if (($opt_config_file ne '-') and ($opt_mode ne 'read') and (not -r $opt_config_file)) {
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', "$opt_config_file: can't read");
        return($ADE::ADE_ERR_FAIL);
    }


    #  We don't want any gnome-ask-pass or such popping up.
    delete $ENV{'DISPLAY'};

    #  Guts - delegate
    if ($opt_mode eq 'read') {
        $rc = mode_read($errstack_ref);
    } elsif ($opt_mode eq 'write') {
        $rc = mode_write($errstack_ref);
    } elsif ($opt_mode eq 'edit') {
        $rc = mode_edit($errstack_ref);
    } elsif ($opt_mode eq 'match') {
        $rc = mode_match($errstack_ref);
    } elsif ($opt_mode eq 'groups') {
        $rc = mode_groups($errstack_ref);
    } elsif ($opt_mode eq 'command') {
        $rc = mode_command($errstack_ref, $opt_command);
    } else {
    }
    return ($rc) if ($rc != $ADE::ADE_ERR_OK);

    return($ADE::ADE_ERR_OK);
}

sub mode_match
{
    my($errstack_ref) = @_;
    my(@host_records, $perl_exp_string, $rocon_exp_string, $rc);

    #  Process arguments
    ADE::ade_msg_usage($errstack_ref) if ($#ARGV+1 < 1);
    $rocon_exp_string = join ' ', @ARGV;

    #  Guts
    if (($rc=load_config_file($errstack_ref, $opt_config_file, \@host_records)) != $ADE::ADE_ERR_OK) {
        return($rc);
    }
    if (($rc=rewrite_rocon_exp_string_as_perl_exp_string($errstack_ref, $rocon_exp_string, \@host_records, \$perl_exp_string)) != $ADE::ADE_ERR_OK) {
        return($rc);
    }
    printf join '', map { "$_\n" } sort map { ${$_}{'host'} } grep { eval $perl_exp_string  } @host_records; ## no critic (ProhibitStringyEval)

    return($ADE::ADE_ERR_OK);
}

sub mode_command
{
    my($errstack_ref, $command) = @_;
    my(@host_records, $perl_exp_string, $rocon_exp_string, $rc, @commands, @rcs, $length_of_longest_hostname, @hosts, $failed_count);

    #  Process arguments
    ADE::ade_msg_usage($errstack_ref) if ($#ARGV+1 < 1);
    $rocon_exp_string = join ' ', @ARGV;
    ADE::ade_err_debug($errstack_ref, 10, "mode_command: rocon_exp_string=$rocon_exp_string");

    #  Guts
    if (($rc=load_config_file($errstack_ref, $opt_config_file, \@host_records)) != $ADE::ADE_ERR_OK) {
        return($rc);
    }
    if (($rc=rewrite_rocon_exp_string_as_perl_exp_string($errstack_ref, $rocon_exp_string, \@host_records, \$perl_exp_string)) != $ADE::ADE_ERR_OK) {
        return($rc);
    }
    @hosts = sort map { ${$_}{'host'} } grep { eval $perl_exp_string } @host_records; ## no critic (ProhibitStringyEval)
    $length_of_longest_hostname = List::Util::max(map { length } @hosts);
    @commands = map { sprintf "{ { { setsid ssh -n $_ '$opt_command'; } 2>&1 1>&3 3>&- | sed 's/^/%s/'; } 3>&1 1>&2 | sed 's/^/%s/'; }", ($opt_quiet ? '' : sprintf '%-*s ', $length_of_longest_hostname+9, "$_\[stderr]:"), ($opt_quiet ? '' : sprintf '%-*s ', $length_of_longest_hostname+9, "$_\[stdout]:") } @hosts;
    @rcs = ADE::ade_spc_multifork($errstack_ref, $opt_timeout, $opt_threads, @commands);

    #  Process return codes
    if ($failed_count = grep { $_ != $ADE::ADE_ERR_OK } @rcs) {
        ADE::ade_err_resetstack($errstack_ref, stack=>$errstack_ref);
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', sprintf 'the following hosts failed: %s', join ', ', map { ($rcs[$_] != 0) ? $hosts[$_] : () } 0..$#rcs);
        return($ADE::ADE_ERR_FAIL);
    }

    return($ADE::ADE_ERR_OK);
}

sub mode_write
{
    my($errstack_ref) = @_;
    my($rocon_conf_handle);

    #  Process arguments
    ADE::ade_msg_usage($errstack_ref) if ($#ARGV+1 != 0);

    #  Guts
    if ($opt_config_file eq '-') {
        $rocon_conf_handle = \*STDIN;
    } else {
        if (not open $rocon_conf_handle, '<', $opt_config_file) {
            ADE::ade_err_error($errstack_ref, 'rocon_err_misc', "$opt_config_file: not accessible");
            return($ADE::ADE_ERR_FAIL);
        }
    }

    #  Import config data.
    while (<$rocon_conf_handle>) {
        print;
    }

    if ($opt_config_file ne '-') {
        close $rocon_conf_handle;
    }

    return($ADE::ADE_ERR_OK);
}

sub mode_groups
{
    my($errstack_ref) = @_;
    my(@host_records, $rc);

    #  Process arguments
    ADE::ade_msg_usage($errstack_ref) if ($#ARGV+1 != 0);

    #  Sanity checks and derivations

    #  Guts
    if (($rc=load_config_file($errstack_ref, $opt_config_file, \@host_records)) != $ADE::ADE_ERR_OK) {
        return($rc);
    }

    #  sort is confused by List::MoreUtils::uniq()'s return value and complains:
    #  'Sort subroutine didn't return single value'. The insertion of the default
    #  sort algorithm '{ $a cmd $b }' fixes that.
    #
    #  Note that the use of:
    #      printf(join('', map { "$_\n" } @list))
    #  instead of:
    #      printf("%s\n",join('\n', @list))
    #  This means we don't need to handle empty lists specially.
    #
    #  And again note the use of 'keys %{ .... }' to convert hash reference to hash.
    printf join '', map { "$_\n" } sort { $a cmp $b } List::MoreUtils::uniq(map { keys %{ ${$_}{'memberships'} } } @host_records );

    return($ADE::ADE_ERR_OK);
}

sub mode_read
{
    my($errstack_ref) = @_;
    my($tmp_config_file, $tmp_config_handle, $rc);

    #  Process arguments
    ADE::ade_msg_usage($errstack_ref) if ($#ARGV+1 != 0);

    #  Sanity checks and derivations
    if (not  -w $opt_config_file) {
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', "$opt_config_file: not writable");
        return($ADE::ADE_ERR_FAIL);
    }
    $tmp_config_file = sprintf '/tmp/%s.%d.conf', $rocon_progname, $$;

    #  Guts
    ADE::ade_tmp_registerfile($errstack_ref, $tmp_config_file);
    if (not open $tmp_config_handle, '>', $tmp_config_file) {
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', "$tmp_config_file: couldn't write");
        return($ADE::ADE_ERR_FAIL);
    }
    while (<>) {
        #  See 'perldoc -f print' for why its not okay to omit '$_' here.
        print $tmp_config_handle $_;
    }
    close $tmp_config_handle;
    if (($rc=replace_config_file($errstack_ref, $tmp_config_file)) != $ADE::ADE_ERR_OK) {
        return($rc);
    }
    if (not unlink $tmp_config_file) {
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', 'unlink failed');
        return($ADE::ADE_ERR_FAIL);
    }
    ADE::ade_tmp_deregisterfile($errstack_ref, $tmp_config_file);

    return($ADE::ADE_ERR_OK);
}

sub mode_edit
{
    my($errstack_ref) = @_;
    my($tmp_config_file, $rc);

    #  Process arguments
    ADE::ade_msg_usage($errstack_ref) if ($#ARGV+1 != 0);

    #  Sanity checks and derivations
    if (not -w $opt_config_file) {
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', "$opt_config_file: not writable");
        return($ADE::ADE_ERR_FAIL);
    }
    $tmp_config_file = sprintf '/tmp/%s.%d.conf', $rocon_progname, $$;

    #  Guts
    ADE::ade_err_debug($errstack_ref, 10, "mode_edit: copying $opt_config_file to $tmp_config_file ...");
    ADE::ade_tmp_registerfile($errstack_ref, $tmp_config_file);
    if (not system "cp $opt_config_file $tmp_config_file") {
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', 'system failed');
        return($ADE::ADE_ERR_FAIL);
    }
    if (not system "\${EDITOR:-vi} $tmp_config_file") {
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', 'system failed');
        return($ADE::ADE_ERR_FAIL);
    }
    if (($rc=replace_config_file($errstack_ref, $tmp_config_file)) != $ADE::ADE_ERR_OK) {
        return($rc);
    }
    if (not unlink $tmp_config_file) {
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', 'unlink failed');
        return($ADE::ADE_ERR_FAIL);
    }
    ADE::ade_tmp_deregisterfile($errstack_ref, $tmp_config_file);

    return($ADE::ADE_ERR_OK);
}

sub replace_config_file
{
    my($errstack_ref, $new_config_file) = @_;
    my($rc, @host_records);

    if (($rc=load_config_file($errstack_ref, $new_config_file, \@host_records)) != $ADE::ADE_ERR_OK) {
        return($rc);
    }
    if (not system "cp $new_config_file $opt_config_file") {
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', 'system failed');
        return($ADE::ADE_ERR_FAIL);
    }
    return($ADE::ADE_ERR_OK);
}

sub rewrite_rocon_exp_string_as_perl_exp_string
{
    my($errstack_ref, $rocon_exp_string, $host_records_ref, $perl_evaluatable_exp_str_ref) = @_;
    my($perl_evaluatable_exp_word, @perl_evaluatable_exp_words, $rocon_exp_string2);
    my($perl_validatable_exp_word, @perl_validatable_exp_words, $perl_validatable_exp_str);
    my(%host_record);

    $rocon_exp_string = join ' ', @ARGV;
    $rocon_exp_string2 = $rocon_exp_string;

    #  Convert rocon expression to perl expression
    #  Pre-pad '((' and '))' to avoid split taking them as one word.
    $rocon_exp_string =~ s/([\(\)])/ $1 /g;
    #  Squeeze multiple blanks to avoid split extracting the empty string between two blanks.
    $rocon_exp_string =~ s/(^ *| *$| +(?= ))//g;
    foreach my $rocon_exp_word (split / /, $rocon_exp_string) {
	ADE::ade_err_debug($errstack_ref, 10, "rewrite_rocon_exp_string_as_perl_exp_string: rocon_exp_word=$rocon_exp_word");
        #  Keywords are replaced with lower case keywords (because 'NOT' etc are not understood by perl)
        if (lc $rocon_exp_word ~~ [ qw(\( \) and or not) ]) {
            $perl_evaluatable_exp_word = lc $rocon_exp_word;
            $perl_validatable_exp_word = lc $rocon_exp_word;
        #  Integers and floats go through
        } elsif ($rocon_exp_word =~ /^\d+(?:|\.\d+)$/ or $rocon_exp_word =~ /^\.\d+$/) {
            $perl_evaluatable_exp_word = $rocon_exp_word;
            $perl_validatable_exp_word = lc $rocon_exp_word;
        #  Anything else is a hostgroup or hostname.
        } elsif ($rocon_exp_word =~ /^[A-Za-z][-A-Za-z0-9_]*$/) {
            #  Some private variables used just in this clause.
            my($matched_flag) = 0;
            #  Scan all host records for the current word ...
            foreach my $host_record_ref (@{$host_records_ref}) {
                #  ... in the 'host' attribute and ...
	        if ($rocon_exp_word eq ${$host_record_ref}{'host'}) {
                    $matched_flag = 1;
                    last;
                }
                #  ... and in keys of the 'memberships' attribute (which is a hash).
                foreach my $host_group (keys %{${$host_record_ref}{'memberships'}}) {
                    if ($rocon_exp_word eq $host_group) {
                        $matched_flag = 1;
                        last;
                    }
                }
                #  That last 'last' broke out of scanning remaining host's memberships;
                #  this one below breaks out of scanning remaining hosts.
                last if ($matched_flag);
            }
            if (not $matched_flag) {
                ADE::ade_err_error($errstack_ref, 'rocon_err_misc', "$rocon_exp_word: not a known host or hostgroup");
                return($ADE::ADE_ERR_FAIL);
            }
            $perl_evaluatable_exp_word = sprintf '(defined ${$_}{\'memberships\'}{\'%s\'} or (${$_}{\'host\'} eq \'%s\'))', $rocon_exp_word, $rocon_exp_word; ## no critic (RequireInterpolationOfMetachars)
            $perl_validatable_exp_word = 1;
        } else {
            ADE::ade_err_error($errstack_ref, 'rocon_err_misc', "$rocon_exp_word: invalid token");
            return($ADE::ADE_ERR_FAIL);
        }
        push @perl_evaluatable_exp_words, $perl_evaluatable_exp_word;
        push @perl_validatable_exp_words, $perl_validatable_exp_word;
    }
    ${$perl_evaluatable_exp_str_ref} = join ' ', @perl_evaluatable_exp_words;
    $perl_validatable_exp_str        = join ' ', @perl_validatable_exp_words;
    ADE::ade_err_debug($errstack_ref, 10, "rewrite_rocon_exp_string_as_perl_exp_string: perl_evaluatable_exp_str_ref=${$perl_evaluatable_exp_str_ref}");
    ADE::ade_err_debug($errstack_ref, 10, "rewrite_rocon_exp_string_as_perl_exp_string: perl_validatable_exp_str=$perl_validatable_exp_str");

    #  Check expression is valid.
    if (not defined eval $perl_validatable_exp_str) { ## no critic (ProhibitStringyEval)
        ADE::ade_err_error($errstack_ref, 'rocon_err_misc', "$rocon_exp_string2: invalid expression");
        return($ADE::ADE_ERR_FAIL);
    }

    return($ADE::ADE_ERR_OK);
}

sub load_config_file
{
    my ($errstack_ref, $config_file, $host_records_ref) = @_;
    my ($rocon_conf_handle, %host_record);
    my ($host, $comma_separated_hostgroup_list, $hostgroup);

    #  Guts start here
    #@host_records = ();

    #  Open config file
    if ($config_file eq '-') {
        $rocon_conf_handle = \*STDIN;
    } else {
        if (not open $rocon_conf_handle, '<', $config_file) {
            ADE::ade_err_error($errstack_ref, 'rocon_err_misc', "$config_file: not accessible");
            return($ADE::ADE_ERR_FAIL);
        }
    }

    #  Import config data.
    while (<$rocon_conf_handle>) {
        chomp;
	ADE::ade_err_debug($errstack_ref, 10, "load_config_file: \$_=$_");
        #  Ignore blank lines and comments (for SOFT-66)
        next if (/^\s*(?:#|$)/);
        if (not (($host, $comma_separated_hostgroup_list) = (/^([A-Za-z][-A-Za-z0-9_]*):([A-Za-z][-A-Za-z0-9_]*(?:,[A-Za-z][-A-Za-z0-9_]*)*)/))) {  ## no critic (ProhibitComplexRegexes)
            ADE::ade_err_error($errstack_ref, 'rocon_err_misc', "$_: invalid line");
            return($ADE::ADE_ERR_FAIL);
        }
	ADE::ade_err_debug($errstack_ref, 10, "load_config_file: host=$host, comma_separated_hostgroup_list=$comma_separated_hostgroup_list");
        $host_record{'host'} = $host;
        foreach my $hostgroup (split /,/, $comma_separated_hostgroup_list) {
            #  Value is unimportant; it is whether it is defined or not that we test.
            $host_record{'memberships'}{$hostgroup} = 1;
        }
        push @{$host_records_ref}, { %host_record };
        undef %host_record;
    }

    #  Close config file.
    if ($config_file ne '-') {
        close $rocon_conf_handle;
    }

    ADE::ade_err_debug($errstack_ref, 11, 'load_config_file: Dump: ' . Data::Dumper->Dump([$host_records_ref], [qw/$host_records_ref/]));
    return($ADE::ADE_ERR_OK);
}

sub rocon_opt_handler_r
{
    my($errstack_ref) = @_;

    $opt_mode = 'read';

    return $ADE::ADE_ERR_OK;
}

sub rocon_opt_handler_read ## no critic (RequireArgUnpacking)
{
    return(rocon_opt_handler_r(@_));
}

sub rocon_opt_handler_w
{
    my($errstack_ref) = @_;

    $opt_mode = 'write';

    return $ADE::ADE_ERR_OK;
}

sub rocon_opt_handler_write ## no critic (RequireArgUnpacking)
{
    return(rocon_opt_handler_w(@_));
}

sub rocon_opt_handler_e
{
    my($errstack_ref) = @_;

    $opt_mode = 'edit';

    return $ADE::ADE_ERR_OK;
}

sub rocon_opt_handler_edit ## no critic (RequireArgUnpacking)
{
    return(rocon_opt_handler_e(@_));
}

sub rocon_opt_handler_m
{
    my($errstack_ref) = @_;

    $opt_mode = 'match';

    return $ADE::ADE_ERR_OK;
}

sub rocon_opt_handler_match ## no critic (RequireArgUnpacking)
{
    return(rocon_opt_handler_m(@_));
}

sub rocon_opt_handler_g
{
    my($errstack_ref) = @_;

    $opt_mode = 'groups';

    return $ADE::ADE_ERR_OK;
}

sub rocon_opt_handler_groups ## no critic (RequireArgUnpacking)
{
    return(rocon_opt_handler_g(@_));
}

sub rocon_opt_handler_c
{
    my($errstack_ref, $local_command) = @_;

    $opt_mode = 'command';
    $opt_command = $local_command;
    #ADE::ade_err_debug($errstack_ref, 10, "rocon_opt_handler_c: opt_mode=$opt_mode, opt_command=$opt_command");

    return $ADE::ADE_ERR_OK;
}

sub rocon_opt_handler_command ## no critic (RequireArgUnpacking)
{
    return(rocon_opt_handler_c(@_));
}

sub rocon_opt_handler_F ## no critic (Capitalization)
{
    my($errstack_ref, $local_config_file) = @_;

    $opt_config_file = $local_config_file;

    return $ADE::ADE_ERR_OK;
}

sub rocon_opt_handler_config ## no critic (RequireArgUnpacking)
{
    return(rocon_opt_handler_F(@_));
}

sub rocon_opt_handler_ssh
{
    my($errstack_ref, $local_ssh_cmd) = @_;

    $opt_ssh_cmd = $local_ssh_cmd;

    return $ADE::ADE_ERR_OK;
}

sub rocon_opt_handler_q
{
    my($errstack_ref) = @_;

    $opt_quiet = 1;

    return $ADE::ADE_ERR_OK;
}

sub rocon_opt_handler_quiet ## no critic (RequireArgUnpacking)
{
    return(rocon_opt_handler_q(@_));
}

sub rocon_opt_handler_t
{
    my($errstack_ref, $local_timeout) = @_;

    $opt_timeout = $local_timeout;

    return $ADE::ADE_ERR_OK;
}

sub rocon_opt_handler_timeout ## no critic (RequireArgUnpacking)
{
    return(rocon_opt_handler_t(@_));
}

sub rocon_opt_handler_T ## no critic (Capitalization)
{
    my($errstack_ref, $local_threads) = @_;

    $opt_threads = $local_threads;

    return $ADE::ADE_ERR_OK;
}

sub rocon_opt_handler_threads ## no critic (RequireArgUnpacking)
{
    return(rocon_opt_handler_T(@_));
}

sub rocon_version
{
    my($errstack_ref, $version_text_ref) = @_;

    return(ADE::ade_smf_extractversionfromsvnstring($errstack_ref, $app_svnid, $version_text_ref));
}

sub rocon_listpaths
{
    my($errstack_ref, $pathlist_text_ref) = @_;
    my($rc);

    ${$pathlist_text_ref} = "Config-File: $opt_config_file\n" .
                            "Ssh-Cmd: $opt_ssh_cmd";
    return($ADE::ADE_ERR_OK);
}

sub rocon_usage
{
    my($errstack_ref, $usage_text_ref, $passno) = @_;

    if ($passno == 1) {
        ${$usage_text_ref} = "{ -e | { -c <cmd> | -m } <expr> | -r | -w | -g }\n";
    } elsif ($passno == 2) {
        ${$usage_text_ref} = "         -e                                  edit the config file\n" .
                             "         -c <cmd>                            run <cmd> on matching hosts\n" .
                             "         -m                                  list matching hosts\n" .
                             "         -w                                  read config file, write to stdout\n" .
                             "         -F <file>                           use alternative config file\n" .
                             "         -r                                  read stdin, write to config file\n" .
                             "         -g                                  list groups\n" .
                             "         -q        | --quiet                 quieten command output reporting\n" .
                             "                     --ssh=<cmd>             path to ssh command\n" .
                             "         -t <secs> | --timeout=<secs>        set timeout (default: $opt_timeout)\n";
    }

    return($ADE::ADE_ERR_OK);
}

ADE::ade_gep_main(\&rocon);