Merge pull request #1451 from stdweird/metaconfig_arbitrary_code_fc_s…

…tyke

ncm-metaconfig: support running arbitrary commands in various steps

ncm-filecopy/src/main/perl/filecopy.pm

@@ -150,7 +150,7 @@ sub Configure
         $cmd->execute();
         if ( $? ) {
             my $method = $confighash->{ignore_restart_failure} ? 'warn' : 'error';
-            $self->{$method}("Command failed. Command output: $cmd_output\n");
+            $self->$method("Command failed. Command output: $cmd_output\n");
         } else {
             $self->debug(1,"Command output: $cmd_output\n");
         }

ncm-metaconfig/src/main/pan/components/metaconfig/schema.pan

@@ -86,6 +86,23 @@ type ${project.artifactId}_textrender_convert = {
 
 type caf_service_action = string with match(SELF, '^(restart|reload|stop_sleep_start)$');
 
+type ${project.artifactId}_actions = {
+    @{Always run, happens before possible modifications.
+      A failure will cancel any file modification, unless the command is prefixed with -.}
+    'pre' ? string
+    @{Always run before possible modifications with the new (or unchanged) file content is
+      passed on stdin. A failure will cancel any file modification,
+      unless the command is prefixed with -.
+      Runs with 'keeps_state' enabled, so do not modify anything with this command.}
+    'test' ? string
+    @{Only run after file is modified, but before any daemon action is executed.
+      A failure in this command has no effect on whether the daemon action is executed later.}
+    'changed' ? string
+    @{Always run, regardless of whether file was modified or not, and after the 'changed' action
+      but before any daemon action. A failure of this command has no effect on the subsequent daemon action.}
+    'post' ? string
+};
+
 type ${project.artifactId}_config =  {
     @{File permissions. Defaults to 0644.}
     'mode' : long = 0644
@@ -118,9 +135,32 @@ type ${project.artifactId}_config =  {
     'contents' : ${project.artifactId}_extension
     @{Predefined conversions from EDG::WP4::CCM::TextRender}
     'convert' ? ${project.artifactId}_textrender_convert
+    @{Actions (i.e. names found in /software/components/metadata/commands) to run when processing the service.
+      Refer to the metaconfig_actions type definition for the available hooks
+      for when a command may be run.}
+    'actions' ? ${project.artifactId}_actions
 } = dict();
 
+@{Command must start with absolute path to executable.
+  If the executable is preceded with a '-', it means that a non-zero exit code (i.e. failure) is
+  treated as success w.r.t. reporting and continuation.}
+type ${project.artifactId}_command = string with match(SELF, '^-?/');
+
 type ${project.artifactId}_component = {
     include structure_component
     'services' : ${project.artifactId}_config{} with valid_absolute_file_paths(SELF)
+    @{Command registry for allowed actions, keys should be used as action value}
+    'commands' ? ${project.artifactId}_command{}
+} with {
+    foreach (esc_fn; srv; SELF['services']) {
+        if (exists(srv['actions'])) {
+            foreach (action; cmd_ref; srv['actions']) {
+                if (!(exists(SELF['commands']) && exists(SELF['commands'][cmd_ref]))) {
+                    error('Found %s action %s for %s, but no matching command registered',
+                            action, cmd_ref, unescape(esc_fn));
+                };
+            };
+        };
+    };
+    true;
 };

ncm-metaconfig/src/main/perl/metaconfig.pm

@@ -154,30 +154,94 @@ use EDG::WP4::CCM::TextRender 18.6.1;
 use CAF::Service;
 use CAF::ServiceActions;
 use EDG::WP4::CCM::Path qw(unescape);
+use Text::ParseWords qw(shellwords);
 use Readonly;
 
 our $EC = LC::Exception::Context->new->will_store_all;
 
 our $NoActionSupported = 1;
 
+# Run $service shell command of $type (ie a string) (if defined).
+#   If $commands is undefined, nothing will be run or logged
+#   $msg is a reporting prefix
+#   When $input is not undef, pass it on stdin
+# Return 1 on success, undef otherwise.
+sub run_shell_command
+{
+    my ($self, $commands, $type, $input) = @_;
+
+    return 1 if ! defined($commands);
+
+    my $command = $commands->{$type};
+    if ($command) {
+        my $error_on_fail = 1;
+        if ($command =~ m/^-/) {
+            $command =~ s/^-//;
+            $error_on_fail = 0;
+        }
+        my $cmd_ref = [shellwords($command)];
+        if (!@$cmd_ref) {
+            $self->error("Failed to split '$command'");
+            return;
+        }
+
+        $self->verbose("Going to run $type command '$command' as ['",
+                       join("','", @$cmd_ref), "']",
+                       $error_on_fail ? "" : " and no error reporting on fail");
+
+        my ($err, $out);
+        my %opts = (
+            log => $self,
+            stdout => \$out,
+            stderr => \$err,
+            );
+        if (defined($input)) {
+            $opts{stdin} = "$input";
+        };
+        if ($type eq 'test') {
+            $opts{keeps_state} = 1;
+        };
+
+        CAF::Process->new($cmd_ref, %opts)->execute();
+
+        my $ec = $?;
+
+        my $report = $ec && $error_on_fail ? 'error' : 'verbose';
+        $self->$report("run $type command '$command' ",
+                       ($ec ? 'failed' : 'ok'),
+                       ($error_on_fail ? '' : ' (no error on fail set)'),
+                       ,": stdout '$out'\n stderr '$err'",
+                       ($input ? "\n stdin '$input'" : ""));
+        return $ec && $error_on_fail ? undef : 1;
+    } else {
+        $self->debug(5, "No $type command to run");
+        return 1;
+    };
+}
+
 # Generate C<$file>, configuring C<$srv> using CAF::TextRender with
 # contents C<$contents> (if C<$contents>  is not defined,
 # C<$srv->{contents}> is used).
 # Also tracks the actions that need to be taken via the
 # C<$sa> C<CAF::ServiceActions> instance.
-# Returns undef in case of rendering failure, 1 otherwise.
+# C<$commands> is a hashref with pre/test/changed/post action commands.
+#   (If it is undefined, nothing will be run or logged, see run_shell_command)
+# Returns undef in case of rendering or other failure, 1 otherwise.
 sub handle_service
 {
-    my ($self, $file, $srv, $contents, $sa) = @_;
+    my ($self, $file, $srv, $contents, $sa, $commands) = @_;
+
+    return if ! $self->run_shell_command($commands, 'pre');
 
     $contents = $srv->{contents} if (! defined($contents));
 
-    my $trd = EDG::WP4::CCM::TextRender->new($srv->{module},
-                                             $contents,
-                                             log => $self,
-                                             eol => 0,
-                                             element => $srv->{convert},
-                                             );
+    my $trd = EDG::WP4::CCM::TextRender->new(
+        $srv->{module},
+        $contents,
+        log => $self,
+        eol => 0,
+        element => $srv->{convert},
+        );
 
     my %opts = (
         log => $self,
@@ -202,19 +266,49 @@ sub handle_service
         return;
     }
 
+    if (! $self->run_shell_command($commands, 'test', "$fh")) {
+        $fh->cancel();
+        return;
+    };
+
     if ($fh->close()) {
         $self->info("File $file updated");
         $sa->add($srv->{daemons}, msg => "for file $file");
+        return if ! $self->run_shell_command($commands, 'changed');
     } else {
         $self->verbose("File $file up-to-date");
     };
 
-    return 1;
+    return $self->run_shell_command($commands, 'post');
 }
 
+# Lookup actions in command registry, and return hashref with actual commands for each action
+sub resolve_command_actions
+{
+    my ($self, $command_registry, $actions) = @_;
+
+    my $commands = {};  # this will trigger reporting that nothing is configured is this stays empty
+    foreach my $type (sort keys %$actions) {
+        my $action = $actions->{$type};
+        my $command = $command_registry->{$action};
+        if ($command) {
+            $commands->{$type} = $command;
+            $self->verbose("Resolved $type action $action to command '$command'");
+        } else {
+            # Should not happen due to this being validated in the schema
+            $self->error("Unable to resolve $type action $action to command");
+        }
+    };
+    return $commands;
+}
+
+
 sub _configure_files
 {
-    my ($self, $config, $root) = @_;
+    my ($self, $config, %opts) = @_;
+
+    my $root = defined($opts{root}) ? $opts{root} : '';
+    my $run_commands = defined($opts{run_commands}) ? $opts{run_commands} : 1;
 
     my $t = $config->getElement($self->prefix)->getTree();
 
@@ -224,7 +318,9 @@ sub _configure_files
         my $srvc = $t->{services}->{$esc_filename};
         my $cont_el = $config->getElement($self->prefix()."/services/$esc_filename/contents");
         my $filename = ($root || '') . unescape($esc_filename);
-        $self->handle_service($filename, $srvc, $cont_el, $sa);
+        # Only when run_commands is false, use undef so nothing is even reported
+        my $commands = $run_commands ? $self->resolve_command_actions($t->{commands}, $srvc->{actions} || {}) : undef;
+        $self->handle_service($filename, $srvc, $cont_el, $sa, $commands);
     }
 
     return $sa;
@@ -243,14 +339,14 @@ sub Configure
 
 # Generate the files relative to metaconfig subdirectory
 # under the configuration cachemanager cache path.
-# No daemons will be restarted.
+# No daemons will be restarted, no commands run.
 sub aii_command
 {
     my ($self, $config) = @_;
 
     my $root = $config->{cache_path};
     if ($root) {
-        $self->_configure_files($config, "$root/metaconfig");
+        $self->_configure_files($config, root => "$root/metaconfig", run_commands => 0);
         return 1;
     } else {
         $self->error("No cache_path found for Configuration instance");

ncm-metaconfig/src/test/perl/actions.t

@@ -32,7 +32,6 @@ Test how the need for restarting a service is handled
 my $actions = {};
 my $cmp = NCM::Component::metaconfig->new('metaconfig');
 
-
 =pod
 
 =head2 Test actions taken via Configure

ncm-metaconfig/src/test/perl/aii_command.t

@@ -33,6 +33,6 @@ isa_ok($fh, "CAF::FileWriter");
 $fh = get_file("/foo/bar");
 ok(!defined($fh), "Nothing created at regular file location");
 
-ok(command_history_ok(undef, ['service foo']), "serivce foo not restarted");
+ok(command_history_ok(undef, ['service foo', 'cmd']), "serivce foo not restarted, no cmd run");
 
 done_testing();

ncm-metaconfig/src/test/perl/commands.t

@@ -0,0 +1,82 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Quattor qw(commands commands_fail_pre);
+use NCM::Component::metaconfig;
+use Test::MockModule;
+
+=pod
+
+=head1 DESCRIPTION
+
+Test the configure() method.
+
+=cut
+
+my $orig = 'X';
+
+sub clean
+{
+    set_file_contents("/foo/bar", "$orig");
+    command_history_reset();
+}
+
+my $cmp = NCM::Component::metaconfig->new('metaconfig');
+my $cfg = get_config_for_profile('commands');
+my $cfg_fail = get_config_for_profile('commands_fail_pre');
+
+clean();
+
+is($cmp->Configure($cfg), 1, "Configure succeeds");
+my $fh = get_file("/foo/bar");
+ok($orig ne "$fh", "orig content is not same as current $fh");
+
+ok($fh, "A file was actually created");
+isa_ok($fh, "CAF::FileWriter");
+
+# if default sysv init service changes, also modify the aii_command negative test
+ok(command_history_ok(['/cmd pre', '/cmd test', '/cmd changed', '/cmd post', 'service foo restart']),
+   "commands run and serivce foo restarted");
+
+clean();
+
+# changed failed, post does not run, daemons does run
+set_command_status('/cmd changed', 1);
+$cmp->Configure($cfg);
+ok(command_history_ok(['/cmd pre', '/cmd test', '/cmd changed', 'service foo restart'], ['/cmd post']),
+   "commands except post run and serivce foo restarted");
+my $fcnt = get_file_contents("/foo/bar");
+ok($orig ne "$fcnt", "orig content is not same as current $fcnt");
+
+clean();
+
+# test failed, changed, post and daemons do not run, content unmodified
+set_command_status('/cmd test', 1);
+$cmp->Configure($cfg);
+ok(command_history_ok(['/cmd pre', '/cmd test'], ['/cmd changed', 'service foo restart', '/cmd post']),
+   "commands run except changed, post and no serivce foo restarted");
+$fcnt = get_file_contents("/foo/bar");
+# unmodified
+is($orig, "$fcnt", "orig content is same as current $fcnt on test failed");
+
+clean();
+# pre failed, test, changed, post and daemons do not run, content unmodified
+set_command_status('/cmd pre', 1);
+$cmp->Configure($cfg);
+ok(command_history_ok(['/cmd pre'], ['/cmd test', '/cmd changed', 'service foo restart', '/cmd post']),
+   "commands run except test, changed, post and no serivce foo restarted");
+$fcnt = get_file_contents("/foo/bar");
+# unmodified
+is($orig, "$fcnt", "orig content is same as current $fcnt on pre failed");
+
+clean();
+# Rerun with cmd_pre that can fail. Test still fails as usual
+$cmp->Configure($cfg_fail);
+ok(command_history_ok(['/cmd pre', '/cmd test'], ['/cmd changed', 'service foo restart', '/cmd post']),
+   "commands pre fails, but is ok so still runs test, and no changed, post and no serivce foo restarted");
+$fcnt = get_file_contents("/foo/bar");
+# unmodified
+is($orig, "$fcnt", "orig content is same as current $fcnt on pre failed but ok to fail and test fails");
+
+
+done_testing();

ncm-metaconfig/src/test/perl/configure.t

@@ -1,12 +1,8 @@
 use strict;
 use warnings;
 use Test::More;
-use Test::Quattor qw(configure);
+use Test::Quattor qw(configure commands);
 use NCM::Component::metaconfig;
-use Test::MockModule;
-use CAF::Object;
-
-use JSON::XS;
 
 =pod
 

ncm-metaconfig/src/test/resources/aii.pan

@@ -1,3 +1,3 @@
 object template aii;
 
-include 'simple';
+include 'simple_commands';

ncm-metaconfig/src/test/resources/commands.pan

@@ -0,0 +1,3 @@
+object template commands;
+
+include 'simple_commands';

ncm-metaconfig/src/test/resources/commands_fail_pre.pan

@@ -0,0 +1,8 @@
+object template commands_fail_pre;
+
+include 'simple_commands';
+
+"/software/components/metaconfig/commands/cmd_pre_fail" =
+    "-" + value("/software/components/metaconfig/commands/cmd_pre");
+
+"/software/components/metaconfig/services/{/foo/bar}/actions/pre" = "cmd_pre_fail";

ncm-metaconfig/src/test/resources/simple_commands.pan

@@ -0,0 +1,15 @@
+unique template simple_commands;
+
+include 'simple';
+
+prefix "/software/components/metaconfig/commands";
+"cmd_pre" = "/cmd pre";
+"cmd_test" = "/cmd test";
+"cmd_changed" = "/cmd changed";
+"cmd_post" = "/cmd post";
+
+prefix "/software/components/metaconfig/services/{/foo/bar}/actions";
+"pre" = "cmd_pre";
+"test" = "cmd_test";
+"changed" = "cmd_changed";
+"post" = "cmd_post";