1 files changed, 133 insertions, 0 deletions
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;