controller: new perl wrapper

Controller is able to read simple YAML configuration file with
list of task to be performed in parallel (the task actually are
run the testsuite remotely, commit results to DB, count
statistics and upload results).

* controller/bin/dtf-controller.in: New template for binary.
* controller/libexec/dtf-commit-results.in: Copy whole result
directory instead of 'dtf' subdir only.
* controller/.gitignore: Ignore new binary.
* controller/Makefile.am: Build dtf-commit-results.

4 files changed, 142 insertions, 2 deletions

diff --git a/controller/.gitignore b/controller/.gitignore
index 40bb7f6..aec98c7 100644
--- a/controller/.gitignore
+++ b/controller/.gitignore
@@ -6,6 +6,7 @@ config.*
 configure
 dtf.sh
 dtf-commit-results
+dtf-controller
 dtf-get-machine
 dtf-result-stats
 dtf-run-remote
diff --git a/controller/Makefile.am b/controller/Makefile.am
index 9fecd61..80ecb63 100644
--- a/controller/Makefile.am
+++ b/controller/Makefile.am
@@ -1,4 +1,7 @@
-bin_SCRIPTS = bin/dtf-run-remote bin/dtf-get-machine
+bin_SCRIPTS = \
+	bin/dtf-run-remote \
+	bin/dtf-get-machine \
+	bin/dtf-controller
 
 sysconf_DATA = etc/dtf.sh
 
@@ -38,6 +41,9 @@ bin/dtf-run-remote: bin/dtf-run-remote.in .dep
 bin/dtf-get-machine: bin/dtf-get-machine.in .dep
 	$(INSTANTIATE_SCRIPT)
 
+bin/dtf-controller: bin/dtf-controller.in .dep
+	$(INSTANTIATE_SCRIPT)
+
 etc/dtf.sh: etc/dtf.sh.in .dep
 	$(INSTANTIATE)
 
diff --git a/controller/bin/dtf-controller.in b/controller/bin/dtf-controller.in
new file mode 100644
index 0000000..e8fc5c8
--- /dev/null
+++ b/controller/bin/dtf-controller.in
@@ -0,0 +1,133 @@
+#!/bin/perl
+
+use strict;
+use warnings;
+use utf8;
+
+use Data::Dumper;
+use Encode 'encode_utf8';
+use File::Temp qw/ :mktemp /;
+use Getopt::Long        qw(:config auto_help);
+
+use POSIX ":sys_wait_h";
+use POSIX qw(strftime);
+
+# yaml (quick) parser
+use YAML::Syck;
+
+our @children;
+
+our $opt_runfile = "runfile.yml";
+
+sub load_runfile
+{
+    open my $fd, '<', $opt_runfile
+            or die "can't open yaml file '$opt_runfile'";
+    my $config = YAML::Syck::LoadFile($fd)
+            or die "can't parse '$opt_runfile'";
+
+    # print Dumper $config;
+    return $config;
+}
+
+sub subcommand
+{
+    my $cmd = $_[0];
+    my $out_file = $_[1] . ".stdout";
+    my $err_file = $_[1] . ".stderr";
+
+    my $pid = fork();
+    if ($pid eq 0) {
+        open (STDOUT, ">", "$out_file") or die "can not open out log";
+        open (STDERR, ">", "$err_file") or die "can not open err log";
+        exec @$cmd or die "can't exec";
+    } else {
+        $SIG{INT} = 'IGNORE';
+        wait;
+        return $? >> 8;
+    }
+}
+
+sub child_task
+{
+    my $run = $_[0];
+    my $dir = $_[1];
+    my $config = $_[2];
+
+    my $task = "$run->{distro}-$run->{distro_version}";
+
+    my $rc = subcommand [
+        '@bindir@/dtf-run-remote',
+        '--taskdir',
+        $run->{taskdir},
+        '--workdir',
+        $dir,
+    ], "$dir/dtf-run-remote";
+
+    # Note that the 'dtf-run-remote' must return EXIT_SUCCESS even if some of
+    # its tests failed.
+    if ($rc ne 0) {
+        print STDERR "$task: failed dtf-run-remote";
+        exit (1);
+    }
+
+    my $resultdir = "$config->{db}/$run->{distro}/"
+                  . "$run->{distro_version}/$run->{arch}/"
+                  . "results_$config->{starttime}-$run->{stamp}";
+
+    $rc = subcommand [
+        '@libexecdir@/dtf-commit-results',
+        "$dir",
+        "$config->{db}/$run->{distro}/$run->{distro_version}/$run->{arch}/",
+    ], "$resultdir";
+    if ($rc ne 0) {
+        print STDERR "$task: failed dtf-commit-results";
+        exit (1);
+    }
+}
+
+sub main
+{
+    my $config = load_runfile;
+
+    print $config->{description}. "\n";
+
+    $config->{starttime} = strftime "%Y%m%d_%H%M%S", gmtime;
+
+    for my $run (@{$config->{runs}}) {
+        # dies on error - which is OK
+        my $dir = File::Temp->newdir("/tmp/dtf-controller-XXXXXX", CLEANUP => 0);
+
+        ($run->{stamp} = $dir) =~ s/.*-//;
+
+        my $pid = fork();
+        if ($pid == 0) {
+
+            child_task($run, $dir, $config);
+            ## child ##
+            exit (0);
+        }
+        else {
+            push @children, $pid;
+        }
+    }
+
+    $SIG{INT} = sub {
+        print ".. waiting for children SIGINTing\n";
+    };
+
+    # wait for all pseudo sub-processes
+    my $child;
+    do {
+        sleep (0.5);
+        $child = waitpid (-1, 0);
+    } while ($child > 0);
+
+    print "Finished..";
+}
+
+GetOptions(
+    "runfile=s",
+) || exit (1);
+
+main;
diff --git a/controller/libexec/dtf-commit-results.in b/controller/libexec/dtf-commit-results.in
index 86b31d7..6b33022 100644
--- a/controller/libexec/dtf-commit-results.in
+++ b/controller/libexec/dtf-commit-results.in
@@ -16,4 +16,4 @@ then
     exit 1
 fi
 
-( cd "$resultdir" && tar -xf dtf.tar.gz && cp -r dtf "$db/$ressubdir" )
+( cd "$resultdir" && tar -xf dtf.tar.gz && cp -r . "$db" )