#!/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::Util; use Fatal qw( close closedir umask ); # obviate checking close's return code use File::Copy; use utf8; # allow '[[:alpha:]]' to match any letter, incl. international use Cwd; # for realpath() 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, $opt_modifications_spec); # Other globals my($rocon_etc_prefix, $rocon_state_prefix, $rocon_lib_prefix); my($rocon_progname, $sqlite_cmd, $db_file); eval `rocon-config --format=perl rocon_etc_prefix rocon_state_prefix rocon_lib_prefix`; ## no critic (ProhibitStringyEval, ProhibitBacktickOperators, RequireCheckingReturnValueOfEval) # Valid host and hostgroups are either without hyphens or underscores or with them but not ending with them. my($untied_identifier_regexp) = '[[:alpha:]](?:[[:alnum:]]*|[-_[:alnum:]]+[[:alnum:]])'; sub rocon { my($errstack_ref) = @_; my($rc, $rocon_conf_handle); # Set ADE options ADE::register_error_types(\%rocon_defined_errors); if (($rc=ADE::get_progname($errstack_ref, \$rocon_progname)) != $ADE::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 = $ENV{'ROCON_SSH_CMD'} ? $ENV{'ROCON_SSH_CMD'} : "ssh"; #$opt_ssh_cmd = 'ssh'; $opt_quiet = 0; $opt_timeout= 0; $opt_threads = 200; # Register options if (($rc=ADE::register_options($errstack_ref, 'rwemgc:sF:sqt:iT:iM:sAD', 'ssh:s,quiet,timeout:i,threads:i', 'main::rocon_opt_handler_%s')) != $ADE::OK) { return($rc); } # Register handler functions if (($rc=ADE::set_callbacks($errstack_ref, \&rocon_usage_help, \&rocon_version, \&rocon_paths)) != $ADE::OK) { return($rc); } # Process options ADE::debug($errstack_ref, 10, 'rocon: processing options ...'); if (($rc=ADE::process_options($errstack_ref)) != $ADE::OK) { return($rc); } # Sanity checks and derivations if (not defined $opt_mode) { ADE::show_bad_usage(); } ADE::debug($errstack_ref, 10, "rocon: opt_config_file=$opt_config_file"); if ($opt_mode ~~ [ qw( read write edit ) ] and $opt_config_file eq '-') { ADE::error($errstack_ref, 'rocon_err_misc', 'edit/read/write modes are meaningless if the config file is stdin'); return($ADE::FAIL); } if (($opt_config_file ne '-') and ($opt_mode ne 'write') and (not -r $opt_config_file)) { ADE::error($errstack_ref, 'rocon_err_misc', "$opt_config_file: can't read"); return($ADE::FAIL); } # # The SQLite database must be config-file specific (so that if the user specifies a different # # config file we don't reuse the old database), so we use the Z-encoded absolute path # # with all symlinks expanded. # ADE::encode_z($errstack_ref, Cwd::realpath($opt_config_file), \$db_file, undef, undef); # $db_file = "$rocon_state_prefix/$db_file.sqlite"; # ADE::debug($errstack_ref, 2, "rocon: db_file=$db_file"); # $sqlite_cmd = "$rocon_lib_prefix/sqlite3"; # if (! -x $sqlite_cmd) { # ADE::error($errstack_ref, 'rocon_err_misc', "$sqlite_cmd: can't execute"); # return($ADE::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, $db_file); } elsif ($opt_mode eq 'groups') { $rc = mode_groups($errstack_ref); } elsif ($opt_mode eq 'command') { $rc = mode_command($errstack_ref, $opt_command); } elsif ($opt_mode eq 'modify') { $rc = mode_modify($errstack_ref, $opt_modifications_spec); } elsif ($opt_mode eq 'add') { $rc = mode_add($errstack_ref); } elsif ($opt_mode eq 'delete') { $rc = mode_delete($errstack_ref); } else { } return ($rc) if ($rc != $ADE::OK); return($ADE::OK); } sub mode_match { my($errstack_ref, $db_file) = @_; my(@host_records, $perl_exp_string, $rocon_exp_string, $rc, $perl_exp_fncref); # Process arguments ADE::show_bad_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, undef)) != $ADE::OK) { return($rc); } #if ((! -f $db_file or (stat $opt_config_file)[9] > (stat $db_file)[9]) and ($rc=write_db_file($errstack_ref, \@host_records, $db_file)) != $ADE::OK) { # return($rc); #} if (($rc=rewrite_rocon_exp_string_as_perl_exp_string($errstack_ref, $rocon_exp_string, \@host_records, \$perl_exp_string)) != $ADE::OK) { return($rc); } # We used to do this: # # printf join '', map { "$_\n" } \ # sort map { ${$_}{'host'} } \ # grep { eval $perl_exp_string } \ # @host_records; # # but that takes a very long time (~130s for 2000 hosts). # The bit that is making it slow is this part: # # ... = grep { eval $perl_exp_string } @host_records; # # and the reason that is so slow is that perl is compiling # the code in $perl_exp_string *for each execution of the # loop (that's the loop that grep automatically makes). # # https://stackoverflow.com/questions/24911132/ suggests # to embed the code in a function definition and eval # *the definition*, not the execution. This makes a # massive difference, the the point where I no longer # need to use (a custom) SQLite instead! Phew! $perl_exp_fncref = eval("sub { return($perl_exp_string) }"); print join '', map { "$_\n" } sort map { ${$_}{'host'} } grep { $perl_exp_fncref->() } @host_records; ## no critic (ProhibitStringyEval) return($ADE::OK); } #sub write_db_file #{ # my($errstack_ref, $host_records_ref, $db_file) = @_; # my($db_dir, @hosts, %hostgroups, $host_record_ref, $sqlite_cmdline, $sql_file); # # Check we'll be able to write the file. # $db_dir = File::Basename::dirname($db_file); # if (! -d $db_dir and not mkdir $db_dir) { # ADE::error($errstack_ref, 'rocon_err_misc', "$db_dir: can't create"); # return($ADE::FAIL); # } elsif (! -w $db_dir) { # ADE::error($errstack_ref, 'rocon_err_misc', "$db_dir: can't write"); # return($ADE::FAIL); # } elsif (-f $db_file and ! -w $db_file) { # ADE::error($errstack_ref, 'rocon_err_misc', "$db_file: can't write"); # return($ADE::FAIL); # } # # Guts # # Get a list of all hosts and a list of all hostgroups. # @hosts = (); # %hostgroups = (); # use a dict to avoid having to duplicate # foreach my $host_record_ref (@{$host_records_ref}) { # push @hosts, ${$host_record_ref}{'host'}; # foreach my $hostgroup (keys %{${$host_record_ref}{'memberships'}}) { # $hostgroups{$hostgroup} = 1; # } # } # ADE::debug($errstack_ref, 10, "write_db_file: \@hosts=( " . (join ',', @hosts) . " )"); # ADE::debug($errstack_ref, 10, "write_db_file: keys \%hostgroups=( " . (join ',', keys %hostgroups) . " )"); # $sql_file = sprintf '/tmp/%s.%d.sql', $rocon_progname, $$; # ADE::debug($errstack_ref, 2, "write_db_file: sql_file=$sql_file"); # ADE::register_temp_file($errstack_ref, $sql_file); # open my $sql_handle, ">", $sql_file; # ADE::debug($errstack_ref, 2, "write_db_file: writing SQLite database ..."); # print $sql_handle "BEGIN TRANSACTION;\n"; # # CREATE TABLE hosts (host CHAR, INT, INT, ..., INT, INT, ..., PRIMARY KEY(host)); # print $sql_handle "CREATE TABLE hosts (host CHAR"; # foreach my $host (@hosts) { # print $sql_handle ", $host INT"; # } # foreach my $hostgroup (sort keys %hostgroups) { # print $sql_handle ", $hostgroup INT"; # } # print $sql_handle ", PRIMARY KEY (host));\n"; # foreach my $host_record_ref (@{$host_records_ref}) { # print $sql_handle "INSERT INTO hosts VALUES ('${$host_record_ref}{'host'}'"; # foreach my $host (@hosts) { # printf $sql_handle ", %d", (${$host_record_ref}{'host'} eq $host)?1:0; # } # foreach my $hostgroup (sort keys %hostgroups) { # printf $sql_handle ", %d", (defined ${${$host_record_ref}{'memberships'}}{$hostgroup})?1:0; # } # print $sql_handle ");\n"; # } # print $sql_handle "END TRANSACTION;\n"; # close $sql_handle; # ADE::register_temp_file($errstack_ref, "$db_file.$$"); # # Since rocon uses a special version of sqlite3 (with support for 10000 columns), # # then we cannot use DBI, which relies on a compiled in libsqlite. This in turn # # means that we can't use ADE's database interface functions. However, we keep # # use of sqlite to single commands, not to long sessions. # $sqlite_cmdline = "$sqlite_cmd $db_file.$$ < $sql_file"; # if (system $sqlite_cmdline) { # ADE::error($errstack_ref, 'rocon_err_misc', "$sqlite_cmd: failed to load SQL (hint: see messages above)"); # return($ADE::FAIL); # } # ADE::debug($errstack_ref, 2, "write_db_file: $sql_file: unlinking ..."); # unlink $sql_file; # ADE::deregister_temp_file($errstack_ref, $sql_file); # rename "$db_file.$$", $db_file; # ADE::deregister_temp_file($errstack_ref, "$db_file.$$"); # ADE::debug($errstack_ref, 2, "write_db_file: finished writing SQLite database"); # return($ADE::OK); #} sub mode_command { my($errstack_ref, $command) = @_; my(@host_records, $perl_exp_string, $rocon_exp_string, $rc, @commands, $length_of_longest_hostname, @hosts, $failed_count, @rcs); # Process arguments ADE::show_bad_usage($errstack_ref) if ($#ARGV+1 < 1); $rocon_exp_string = join ' ', @ARGV; ADE::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, undef)) != $ADE::OK) { return($rc); } ADE::debug($errstack_ref, 10, "mode_command: before calling rewrite_rocon_exp_string_as_perl_exp_string()"); if (($rc=rewrite_rocon_exp_string_as_perl_exp_string($errstack_ref, $rocon_exp_string, \@host_records, \$perl_exp_string)) != $ADE::OK) { return($rc); } ADE::debug($errstack_ref, 10, "mode_command: after calling rewrite_rocon_exp_string_as_perl_exp_string()"); @hosts = sort map { ${$_}{'host'} } grep { eval $perl_exp_string } @host_records; ## no critic (ProhibitStringyEval) $length_of_longest_hostname = List::Util::max(map { length } @hosts); ADE::debug($errstack_ref, 10, "mode_command: after calling 'sort map { .... } and List::Util::max"); @commands = map { sprintf "{ { { $opt_ssh_cmd $_ '$opt_command' < /dev/null; } 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; if (($rc=ADE::fork_multi($errstack_ref, $opt_timeout, $opt_threads, \@commands, \@rcs)) != $ADE::OK) { return($rc); } ## Process return codes if ($failed_count = grep { $_ } @rcs) { ADE::set_messaging_parameters($errstack_ref, stack=>$errstack_ref); ADE::error($errstack_ref, 'rocon_err_misc', sprintf 'the following hosts failed: %s', join ', ', map { ($rcs[$_] != 0) ? $hosts[$_] : () } (0..$#rcs)); return($ADE::FAIL); } return($ADE::OK); } sub mode_add { my($errstack_ref) = @_; my($rc,$found,$host_record,@host_records,$config_content,$host); # Process arguments ADE::show_bad_usage($errstack_ref) if ($#ARGV+1 < 1); # Sanity checks and derivations ADE::debug($errstack_ref, 10, "mode_add: calling load_config_file(...) ..."); if (($rc=load_config_file($errstack_ref, $opt_config_file, \@host_records, \$config_content)) != $ADE::OK) { return($rc); } # Check it doesn't exist already. foreach my $host (@ARGV) { ADE::debug($errstack_ref, 10, "mode_add: $host: checking not already in config data ..."); $found = 0; foreach $host_record (@host_records) { if (${$host_record}{'host'} eq $host) { $found = 1; last; } } if ($found) { ADE::error($errstack_ref, 'rocon_err_misc', "$host: already in config data"); return($ADE::FAIL); } } # Guts foreach my $host (@ARGV) { ADE::debug($errstack_ref, 10, "mode_add: $host: adding minimal record to config data ..."); $config_content .= "$host:\n"; } ADE::debug($errstack_ref, 10, "mode_add: calling save_config_file(...) ..."); if (($rc=save_config_file($errstack_ref, $config_content)) != $ADE::OK) { return($rc); } return($ADE::OK); } sub mode_delete { my($errstack_ref) = @_; my($rc,$found,$host_record,@host_records,$config_content,$host); # Process arguments ADE::show_bad_usage($errstack_ref) if ($#ARGV+1 < 1); # Sanity checks and derivations if (($rc=load_config_file($errstack_ref, $opt_config_file, \@host_records, \$config_content)) != $ADE::OK) { return($rc); } foreach my $host (@ARGV) { $found = 0; foreach $host_record (@host_records) { if (${$host_record}{'host'} eq $host) { $found = 1; last; } } if (not $found) { ADE::error($errstack_ref, 'rocon_err_misc', "$host: not in config file"); return($ADE::FAIL); } } # Guts foreach my $host (@ARGV) { $config_content =~ s/(^|\n)$host:[^\n]*\n/$1/; } if (($rc=save_config_file($errstack_ref, $config_content)) != $ADE::OK) { return($rc); } return($ADE::OK); } sub mode_modify { my($errstack_ref, $modifications_spec) = @_; my($rocon_exp_string, @add_membership_of_hostgroups, @del_membership_of_hostgroups, $sign, $hostgroup, $rc); my(@host_records, $perl_exp_string, @hosts, $config_content); # Process arguments ADE::show_bad_usage($errstack_ref) if ($#ARGV+1 < 1); $rocon_exp_string = join ' ', @ARGV; ADE::debug($errstack_ref, 10, "mode_modify: rocon_exp_string=$rocon_exp_string"); # Sanity checks and derivations if ($modifications_spec !~ /^[-+]$untied_identifier_regexp(?:,[-+]$untied_identifier_regexp)*$/) { ADE::show_bad_usage($errstack_ref); } @add_membership_of_hostgroups = (); @del_membership_of_hostgroups = (); foreach my $modification_spec (split /,/, $modifications_spec) { # No need to check *whether* this matches as above check already assured that. ($sign, $hostgroup) = ($modification_spec =~ /^([-+])($untied_identifier_regexp)$/); if ($sign eq '-') { push @del_membership_of_hostgroups, $hostgroup; } else { push @add_membership_of_hostgroups, $hostgroup; } } # Guts # We manipulate the raw content because we want to preserve any legal non-record content, such as # blank lines and comments, but we load the host records also because (1) we need to determine # which hosts match the selector expression and (2) having the host records on hand makes determinining # the necessity to make non-null modifications to a particular host much easier. if (($rc=load_config_file($errstack_ref, $opt_config_file, \@host_records, \$config_content)) != $ADE::OK) { return($rc); } if (($rc=rewrite_rocon_exp_string_as_perl_exp_string($errstack_ref, $rocon_exp_string, \@host_records, \$perl_exp_string)) != $ADE::OK) { return($rc); } @hosts = sort map { ${$_}{'host'} } grep { eval $perl_exp_string } @host_records; ## no critic (ProhibitStringyEval) ADE::debug($errstack_ref, 10, sprintf "mode_modify: \@hosts=(%s), \@del_membership_of_hostgroups=(%s), \@add_membership_of_hostgroups=(%s)", (join ',', @hosts), (join ',', @del_membership_of_hostgroups), (join ',', @add_membership_of_hostgroups)); # For each host record in the config file ... foreach my $host_record_ref (@host_records) { # ... if the host record is for a host that we've not been ask to modify then skip that record ... next if (not ${$host_record_ref}{'host'} ~~ @hosts); foreach my $del_membership_of_hostgroup (@del_membership_of_hostgroups) { # Skip deleting hostgroup membership if the host is already not a member of that hostgroup. next if (not defined ${$host_record_ref}{'memberships'}{$del_membership_of_hostgroup}); ADE::debug($errstack_ref, 10, "mode_modify: ${$host_record_ref}{'host'}: need to delete membership of $del_membership_of_hostgroup"); # When removing it there are a few different regexps that need to be checked. Only one # of these will match and removing the host group a specified group will not suddenly # make it match one of the other patterns. What that means is that it is safe to apply # all substitutions. Only one will have an effect and the others won't. # First: host is only in one hostgroup (and that is the one to remove). $config_content =~ s/(^|\n)(${$host_record_ref}{'host'}):$del_membership_of_hostgroup(:|\n)/$1$2:$3/; # Second: is in multiple hostgroups and the first is the one to remove. $config_content =~ s/(^|\n)(${$host_record_ref}{'host'}):$del_membership_of_hostgroup,/$1$2:/; # Third: is in multiple hostgroups and the last is the one to remove. $config_content =~ s/(^|\n)(${$host_record_ref}{'host'}):([^:\n]*),$del_membership_of_hostgroup(:|\n)/$1$2:$3$4/; # Fourth: is in multiple hostgroups and it is one of the middle ones to remove. $config_content =~ s/(^|\n)(${$host_record_ref}{'host'}):([^:\n]*),$del_membership_of_hostgroup,/$1$2:$3,/; } foreach my $add_membership_of_hostgroup (@add_membership_of_hostgroups) { # Skip adding hostgroup membership if the host is already a member of that hostgroup. next if (defined ${$host_record_ref}{'memberships'}{$add_membership_of_hostgroup}); ADE::debug($errstack_ref, 10, "mode_modify: ${$host_record_ref}{'host'}: need to add membership of $add_membership_of_hostgroup"); # 'scalar ' or 'scalar ' gives number of elements. ($# doesn't # work as for arrays, and in any case that would return index of last element, # not count of elements.) But remember that nested data structures always contain # *references* to substructures, not the actual substructures. This is why # to get the count of memberships we have %{${$host_record_ref}{'memberships'}} # and not the very similar looking %{$host_record_ref}{'memberships'}. if (not defined %{$host_record_ref}{'memberships'} or scalar %{${$host_record_ref}{'memberships'}} == 0) { $config_content =~ s/(^|\n)(${$host_record_ref}{'host'}):([^\n:]*)/$1$2:$add_membership_of_hostgroup$3/; } else { $config_content =~ s/(^|\n)(${$host_record_ref}{'host'}):([^\n:]*)/$1$2:$add_membership_of_hostgroup,$3/; } } } if (($rc=save_config_file($errstack_ref, $config_content)) != $ADE::OK) { return($rc); } return($ADE::OK); } sub mode_read { my($errstack_ref) = @_; my($rocon_conf_handle); # Process arguments ADE::show_bad_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::error($errstack_ref, 'rocon_err_misc', "$opt_config_file: not accessible"); return($ADE::FAIL); } } # Import config data. while (<$rocon_conf_handle>) { print; } if ($opt_config_file ne '-') { close $rocon_conf_handle; } return($ADE::OK); } sub mode_groups { my($errstack_ref) = @_; my(@host_records, $rc); # Process arguments ADE::show_bad_usage($errstack_ref) if ($#ARGV+1 != 0); # Sanity checks and derivations # Guts if (($rc=load_config_file($errstack_ref, $opt_config_file, \@host_records, undef)) != $ADE::OK) { return($rc); } # Note that the use of: # printf(join('', map { "$_\n" } @list)) # instead of: # printf("%s\n",join('\n', @list)) # means we don't need to handle empty lists specially. Also note Note use of 'keys %{ .... }' # to convert hash reference to hash. Finally, also note Anonymous ordering function # '{ $a cmp $b }' needed as sort expects integers otherwise. printf join '', map { "$_\n" } sort { $a cmp $b } List::Util::uniq(map { keys %{ ${$_}{'memberships'} } } @host_records ); return($ADE::OK); } sub mode_write { my($errstack_ref) = @_; my($rc, $config_content); # Process arguments ADE::show_bad_usage($errstack_ref) if ($#ARGV+1 != 0); # Sanity checks and derivations if (not -w $opt_config_file) { ADE::error($errstack_ref, 'rocon_err_misc', "$opt_config_file: not writable"); return($ADE::FAIL); } # Guts $config_content = ''; while (<>) { $config_content .= $_; } if (($rc=save_config_file($errstack_ref, $config_content)) != $ADE::OK) { return($rc); } return($ADE::OK); } sub save_config_file { my($errstack_ref, $config_content) = @_; my($tmp_config_file, $tmp_config_handle, $rc); ADE::debug($errstack_ref, 10, "save_config_file: saving config content to temporary file ..."); $tmp_config_file = sprintf '/tmp/%s.%d.conf', $rocon_progname, $$; ADE::register_temp_file($errstack_ref, $tmp_config_file); if (not open $tmp_config_handle, '>', $tmp_config_file) { ADE::error($errstack_ref, 'rocon_err_misc', "$tmp_config_file: couldn't write"); return($ADE::FAIL); } print $tmp_config_handle $config_content; close $tmp_config_handle; # Move the edited temporary config file into place. (This block # also in mode_edit().) if (not File::Copy::move($tmp_config_file, $opt_config_file)) { ADE::error($errstack_ref, 'rocon_err_misc', 'move failed'); return($ADE::FAIL); } ADE::deregister_temp_file($errstack_ref, $tmp_config_file); return($ADE::OK); } sub mode_edit { my($errstack_ref) = @_; my($tmp_config_file, $rc); # Process arguments ADE::show_bad_usage($errstack_ref) if ($#ARGV+1 != 0); # Sanity checks and derivations if (not -w $opt_config_file) { ADE::error($errstack_ref, 'rocon_err_misc', "$opt_config_file: not writable"); return($ADE::FAIL); } $tmp_config_file = sprintf '/tmp/%s.%d.conf', $rocon_progname, $$; # Guts ADE::debug($errstack_ref, 10, "mode_edit: copying $opt_config_file to $tmp_config_file ..."); ADE::register_temp_file($errstack_ref, $tmp_config_file); if (system "cp $opt_config_file $tmp_config_file") { ADE::error($errstack_ref, 'rocon_err_misc', 'system failed'); return($ADE::FAIL); } if (system "\${EDITOR:-vi} $tmp_config_file") { ADE::error($errstack_ref, 'rocon_err_misc', 'system failed'); return($ADE::FAIL); } # After the user has made edits, we use load_config_file, but passing undef for # datastores, in order the changes the user made. if (($rc=load_config_file($errstack_ref, $tmp_config_file, undef, undef)) != $ADE::OK) { return($rc); } # Move the edited temporary config file into place. (This block # also in save_config_file().) if (not File::Copy::move($tmp_config_file, $opt_config_file)) { ADE::error($errstack_ref, 'rocon_err_misc', 'move failed'); return($ADE::FAIL); } ADE::deregister_temp_file($errstack_ref, $tmp_config_file); return($ADE::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, undef)) != $ADE::OK) { return($rc); } if (system "cp $new_config_file $opt_config_file") { ADE::error($errstack_ref, 'rocon_err_misc', 'system failed'); return($ADE::FAIL); } return($ADE::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; # Work along the expression string, word by word, contructing *two* arrays that we # then turn into strings: the first is made of up the rationalised words in the # expression string (e.g. "NOT" changed to "not", hostgroup names replaced by # code to evaluate whether host '$_' (literally!) is in that hostgroup or not, etc), # which we will use to generate the list of hosts that match the expression; the # second is very similar but each hostgroup or hostgroup reference is just replaced # by the simplest maths-compatible expression I could think of, namely '1' (literally). # This second one will turn a host selector expression "AllHosts and not mercury" # into "1 and not 1", which we can that easily check if it is a valid expression. # "1 and not 1" is a valid expression, "1 and and 1" is not a valid expression. # This allows us to report whether the expression is valid *before* we actually # use it to filter the host list. foreach my $rocon_exp_word (split / /, $rocon_exp_string) { ADE::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 = $rocon_exp_word; # Anything else is a hostgroup or hostname. } elsif ($rocon_exp_word =~ /^$untied_identifier_regexp$/) { # 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::error($errstack_ref, 'rocon_err_misc', "$rocon_exp_word: not a known host or hostgroup"); return($ADE::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::error($errstack_ref, 'rocon_err_misc', "$rocon_exp_word: invalid token"); return($ADE::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::debug($errstack_ref, 10, "rewrite_rocon_exp_string_as_perl_exp_string: perl_evaluatable_exp_str_ref=${$perl_evaluatable_exp_str_ref}"); ADE::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::error($errstack_ref, 'rocon_err_misc', "$rocon_exp_string2: invalid expression"); return($ADE::FAIL); } return($ADE::OK); } sub load_config_file { my ($errstack_ref, $config_file, $host_records_ref, $config_content_ref) = @_; my ($rocon_conf_handle, %host_record, $found, $host, $comma_separated_hostgroup_list, $hostgroup, @tmp_host_records); # Open config file if ($config_file eq '-') { $rocon_conf_handle = \*STDIN; } else { if (not open $rocon_conf_handle, '<', $config_file) { ADE::error($errstack_ref, 'rocon_err_misc', "$config_file: not accessible"); return($ADE::FAIL); } } # Import config data. ${$config_content_ref} = '' if (defined $config_content_ref); while (<$rocon_conf_handle>) { ${$config_content_ref} .= $_ if (defined $config_content_ref); chomp; ADE::debug($errstack_ref, 10, "load_config_file: \$_=$_"); # Ignore blank lines and comments (for SOFT-66) next if (/^\s*(?:#|$)/); # Error on unparsable line. if (not (($host, $comma_separated_hostgroup_list) = (/^($untied_identifier_regexp):([^:]*)/))) { ADE::error($errstack_ref, 'rocon_err_misc', "$_: invalid line"); return($ADE::FAIL); } ADE::debug($errstack_ref, 10, "load_config_file: host=$host, comma_separated_hostgroup_list=$comma_separated_hostgroup_list"); # Error on host already present. $found = 0; foreach my $host_record_ref (@tmp_host_records) { if (${$host_record_ref}{'host'} eq $host) { $found = 1; last; } } if ($found) { ADE::error($errstack_ref, 'rocon_err_misc', "$host: duplicate entry"); return($ADE::FAIL); } # Construct a new host record. $host_record{'host'} = $host; foreach my $hostgroup (split /,/, $comma_separated_hostgroup_list) { ADE::debug($errstack_ref, 10, "load_config_file: hostgroup=$hostgroup"); # Value is unimportant; it is whether it is defined or not that we test. $host_record{'memberships'}{$hostgroup} = 1; } # Add the new host record to the temporary local host records. (We can't # put it into passed host records reference in case that is undefined by # the caller, but, on the other hand, we *must* put it into *something* # in order to check subsequent hosts in the config file are not duplicates.) push @tmp_host_records, { %host_record }; undef %host_record; } # Close config file. if ($config_file ne '-') { close $rocon_conf_handle; } # If the caller passed a reference to their own host records, then copy the # temporary local host records to that. @{$host_records_ref} = @tmp_host_records if (defined $host_records_ref); return($ADE::OK); } sub rocon_opt_handler_r { my($errstack_ref) = @_; $opt_mode = 'read'; return $ADE::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::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::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::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::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::debug($errstack_ref, 10, "rocon_opt_handler_c: opt_mode=$opt_mode, opt_command=$opt_command"); return $ADE::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::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::OK; } sub rocon_opt_handler_q { my($errstack_ref) = @_; $opt_quiet = 1; return $ADE::OK; } sub rocon_opt_handler_quiet ## no critic (RequireArgUnpacking) { return(rocon_opt_handler_q(@_)); } sub rocon_opt_handler_A { my($errstack_ref) = @_; $opt_mode = 'add'; return $ADE::OK; } sub rocon_opt_handler_D { my($errstack_ref) = @_; $opt_mode = 'delete'; return $ADE::OK; } sub rocon_opt_handler_M { my($errstack_ref, $local_modifications_spec) = @_; $opt_mode = 'modify'; $opt_modifications_spec = $local_modifications_spec; return $ADE::OK; } sub rocon_opt_handler_t { my($errstack_ref, $local_timeout) = @_; $opt_timeout = $local_timeout; return $ADE::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::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::extract_version($errstack_ref, $app_svnid, $version_text_ref)); } sub rocon_paths { my($errstack_ref, $pathlist_text_ref) = @_; my($rc); ${$pathlist_text_ref} = "Config-File: $opt_config_file\n" . "Ssh-Cmd: $opt_ssh_cmd"; return($ADE::OK); } sub rocon_usage_help { my($errstack_ref, $usage_text_short_ref, $usage_text_long_ref) = @_; #${$usage_text_short_ref} = "{ -e | { -c | -m | -M {+|-}[,...] } | -r | -w | -g }\n"; ${$usage_text_short_ref} = "[ ] [ ... ]\n"; ${$usage_text_long_ref} = " -q | --quiet quieten command output reporting\n" . " --ssh= path to ssh command\n" . " -t | --timeout= set timeout (default: $opt_timeout)\n" . " -T | --threads= set threads (default: $opt_threads)\n" . " -F use alternative config file\n" . "Op Mode: -e edit the config file\n" . " -c run on hosts\n" . " -m list matching hosts\n" . " -r read config file to stdout\n" . " -w write confilg file from stdin\n" . " -g list groups\n" . " -A add host\n" . " -D delete host\n" . " -M {+|-}[,...] modify hostgroups of hosts\n"; return($ADE::OK); } ADE::main(\&rocon);