From 0c345ec6b2db80b0517e4a63b8eb55333948fcbf Mon Sep 17 00:00:00 2001
From: Pavel Raiskup <praiskup@redhat.com>
Date: Sun, 26 Oct 2014 19:50:49 +0100
Subject: 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.
---
 controller/bin/dtf-controller.in | 133 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 133 insertions(+)
 create mode 100644 controller/bin/dtf-controller.in

(limited to 'controller/bin')

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;
-- 
cgit