#!/usr/bin/perl

use strict;
my($app_svnid) = '$HeadURL$ $LastChangedRevision$';
#  Allow bare words, so &ade_err_error() calls look nicer.
no strict 'subs';
use lib substr(`ade-config ade_lib_prefix`,0,-1) . '/include';
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;

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);
eval `rocon-config --format=perl rocon_etc_prefix`;

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


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

    #  Defaults for options
    $opt_config_file = $ENV{ROCON_CFG_FILE} ? $ENV{ROCON_CFG_FILE} : "$rocon_etc_prefix/$ade_app_progname.conf";
    $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_opt_register($errstack_ref, "rwemgc:sF:sqt:iT:i", "ssh:s,quiet,timeout:i,threads:i", "main::rocon_opt_handler_%s")) != $ade_err_ok) {
        return($rc);
    }

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

    #  Process options
    &ade_err_debug($errstack_ref, 10, "rocon: processing options ...");
    if (($rc=&ade_opt_process($errstack_ref)) != $ade_err_ok) {
        return($rc);
    } 

    #  Sanity checks and derivations
    if (!defined($opt_mode)) {
        &ade_msg_usage($errstack_ref);
    }
    &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_err_error($errstack_ref, rocon_err_misc, "edit/read/write modes are meaningless if the config file is stdin");
        return($ade_err_fail);
    }
    if ($opt_config_file ne '-' and $opt_mode ne 'read' and ! -r $opt_config_file) {
        &ade_err_error($errstack_ref, rocon_err_misc, "$opt_config_file: can't read");
        return($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_err_ok);

    return($ade_err_ok);
}

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

    #  Process arguments
    &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_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_err_ok) {
        return($rc);
    }
    printf(join('', map { "$_\n" } sort map { ${$_}{host} } grep { eval($perl_exp_string) } @host_records));
    
    return($ade_err_ok);
}

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

    #  Process arguments
    &ade_msg_usage($errstack_ref) if ($#ARGV+1 < 1);
    $rocon_exp_string = join(' ', @ARGV);
    &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_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_err_ok) {
        return($rc);
    }
    @hosts = sort map { ${$_}{host} } grep { eval($perl_exp_string) } @host_records;
    $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_spc_multifork($errstack_ref, $opt_timeout, $opt_threads, @commands);

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

    return($ade_err_ok);
}

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

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

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

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

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

    return($ade_err_ok);
}

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

    #  Process arguments
    &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_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_err_ok);
}

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

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

    #  Sanity checks and derivations
    if (! -w $opt_config_file) {
        &ade_err_error($errstack_ref, rocon_err_misc, "$opt_config_file: not writable");
        return($ade_err_fail);
    }
    $tmp_config_file = "/tmp/$ade_app_progname.$$.conf";

    #  Guts
    &ade_tmp_registerfile($errstack_ref, $tmp_config_file);
    if (not open($tmp_config_handle, ">", $tmp_config_file)) {
        &ade_err_error($errstack_ref, rocon_err_misc, "$tmp_config_file: couldn't write");
        return($ade_err_fail);
    }
    while (<STDIN>) {
        #  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_err_ok) {
        return($rc);
    }
    unlink($tmp_config_file);
    &ade_tmp_deregisterfile($errstack_ref, $tmp_config_file);

    return($ade_err_ok);
}

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

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

    #  Sanity checks and derivations
    if (! -w $opt_config_file) {
        &ade_err_error($errstack_ref, rocon_err_misc, "$opt_config_file: not writable");
        return($ade_err_fail);
    }
    $tmp_config_file = "/tmp/$ade_app_progname.$$.conf";

    #  Guts
    &ade_err_debug($errstack_ref, 10, "mode_edit: copying $opt_config_file to $tmp_config_file ...");
    &ade_tmp_registerfile($errstack_ref, $tmp_config_file);
    system("cp $opt_config_file $tmp_config_file");
    system("\${EDITOR:-vi} $tmp_config_file");
    if (($rc=&replace_config_file($errstack_ref, $tmp_config_file)) != $ade_err_ok) {
        return($rc);
    }
    unlink($tmp_config_file);
    &ade_tmp_deregisterfile($errstack_ref, $tmp_config_file);

    return($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_err_ok) {
        return($rc);
    }
    system("cp $new_config_file $opt_config_file");
    return($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($rocon_exp_word, $perl_evaluatable_exp_word, @perl_evaluatable_exp_words, $rocon_exp_string2);
    my($perl_validatable_exp_word, @perl_validatable_exp_words, $perl_validatable_exp_str);
    
    $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 $rocon_exp_word (split(/ /, $rocon_exp_string)) {
	&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 ((grep {lc($_) eq 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;
            my($host_record_ref, %host_record, $host_group);
            #  Scan all host records for the current word ...
            foreach $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 $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_err_error($errstack_ref, rocon_err_misc, "$rocon_exp_word: not a known host or hostgroup");
                return($ade_err_fail);
            }
            $perl_evaluatable_exp_word = sprintf('(defined(${$_}{memberships}{\'%s\'}) or (${$_}{host} eq \'%s\'))', $rocon_exp_word, $rocon_exp_word);
            $perl_validatable_exp_word = 1;
        } else {
            &ade_err_error($errstack_ref, rocon_err_misc, "$rocon_exp_word: invalid token");
            return($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_err_debug($errstack_ref, 10, "rewrite_rocon_exp_string_as_perl_exp_string: perl_evaluatable_exp_str_ref=${$perl_evaluatable_exp_str_ref}");
    &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 (!defined(eval $perl_validatable_exp_str)) {
        &ade_err_error($errstack_ref, rocon_err_misc, "$rocon_exp_string2: invalid expression");
        return($ade_err_fail);
    }
    
    return($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;
    } elsif (not open($rocon_conf_handle, "<", $config_file)) {
        &ade_err_error($errstack_ref, rocon_err_misc, "$config_file: not accessible");
        return($ade_err_fail);
    }

    #  Import config data.
    while (<$rocon_conf_handle>) {
        chomp;
	&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_]*)*)/))) {
            &ade_err_error($errstack_ref, rocon_err_misc, "$_: invalid line");
            return($ade_err_fail);
        }
	&ade_err_debug($errstack_ref, 10, "load_config_file: host=$host, comma_separated_hostgroup_list=$comma_separated_hostgroup_list");
        $host_record{host} = $host;
        foreach $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_err_debug($errstack_ref, 11, "load_config_file: Dump: " . Data::Dumper->Dump([$host_records_ref], [qw/$host_records_ref/]));
    return($ade_err_ok);
}

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

    $opt_mode = 'read';

    return $ade_err_ok;
} 

sub rocon_opt_handler_read
{
    return(&rocon_opt_handler_r(@_));
}

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

    $opt_mode = 'write';

    return $ade_err_ok;
} 

sub rocon_opt_handler_write
{
    return(&rocon_opt_handler_w(@_));
}

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

    $opt_mode = 'edit';

    return $ade_err_ok;
} 

sub rocon_opt_handler_edit
{
    return(&rocon_opt_handler_e(@_));
}

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

    $opt_mode = 'match';

    return $ade_err_ok;
} 

sub rocon_opt_handler_match
{
    return(&rocon_opt_handler_m(@_));
}

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

    $opt_mode = 'groups';

    return $ade_err_ok;
} 

sub rocon_opt_handler_groups
{
    return(&rocon_opt_handler_g(@_));
}

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

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

    return $ade_err_ok;
} 

sub rocon_opt_handler_command
{
    return(&rocon_opt_handler_c(@_));
}

sub rocon_opt_handler_F
{
    my($errstack_ref, $local_config_file) = @_;

    $opt_config_file = $local_config_file;

    return $ade_err_ok;
} 

sub rocon_opt_handler_config
{
    return(&rocon_opt_handler_F(@_));
}

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

    $opt_ssh_cmd = $local_ssh_cmd;

    return $ade_err_ok;
} 

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

    $opt_quiet = 1;

    return $ade_err_ok;
} 

sub rocon_opt_handler_quiet
{
    return(&rocon_opt_handler_q(@_));
}

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

    $opt_timeout = $local_timeout;

    return $ade_err_ok;
} 

sub rocon_opt_handler_timeout
{
    return(&rocon_opt_handler_t(@_));
}

sub rocon_opt_handler_T
{
    my($errstack_ref, $local_threads) = @_;

    $opt_threads = $local_threads;

    return $ade_err_ok;
} 

sub rocon_opt_handler_threads
{
    return(&rocon_opt_handler_T(@_));
}

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

    return(&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_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_err_ok);
}

&ade_gep_main(\&rocon);