Start submitting builds for system tests

This'll enable getting system test information in to the data service, which
will in turn enable starting running system tests for patches when
appropriate.

2 files changed, 98 insertions, 2 deletions

diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index 8be33ca..18e4b74 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -15,7 +15,8 @@
             builds-missing-for-derivation-changes?
 
             start-submit-patch-builds-thread
-            start-submit-branch-builds-thread))
+            start-submit-branch-builds-thread
+            start-submit-master-branch-system-tests-thread))
 
 (define %systems-to-submit-builds-for
   '("x86_64-linux"
@@ -391,3 +392,95 @@
               (loop (cdr changes)
                     builds-to-submit-details
                     build-ids-to-keep-set))))))
+
+(define %system-tests-that-change-every-revision
+  '("btrfs-raid10-root-os"
+    "btrfs-raid10-root-os-degraded"
+    "btrfs-raid-root-os"
+    "btrfs-root-on-subvolume-os"
+    "btrfs-root-os"
+    "docker-system"
+    "encrypted-home-os"
+    "encrypted-root-not-boot-os"
+    "encrypted-root-os"
+    "f2fs-root-os"
+    "gui-installed-desktop-os-encrypted"
+    "gui-installed-os"
+    "gui-installed-os-encrypted"
+    "gui-uefi-installed-os"
+    "installed-extlinux-os"
+    "installed-os"
+    "iso-image-installer"
+    "jfs-root-os"
+    "lvm-separate-home-os"
+    "raid-root-os"
+    "separate-home-os"
+    "separate-store-os"
+    "xfs-root-os"))
+
+(define (start-submit-master-branch-system-tests-thread database
+                                                        build-coordinator
+                                                        guix-data-service)
+  (define %systems
+    '("x86_64-linux" "aarch64-linux"))
+
+  (define (submit-builds)
+    (simple-format #t "submitting system test builds\n")
+    (let* ((processed-revision-commits
+            (filter-map
+             (lambda (revision-details)
+               (if (assoc-ref revision-details "data_available")
+                   (assoc-ref revision-details "commit-hash")
+                   #f))
+             (branch-revisions
+              (branch-revisions-url 2 "master"))))
+           (recent-processed-revision-commits
+            (if (> (length processed-revision-commits)
+                   5)
+                (take processed-revision-commits 5)
+                5)))
+
+      (for-each
+       (lambda (commit)
+         (for-each
+          (lambda (system)
+            (let* ((system-tests
+                    (revision-system-tests
+                     (revision-system-tests-url
+                      commit #:system system))))
+              (for-each
+               (lambda (system-test-details)
+                 (let ((name
+                        (assoc-ref system-test-details "name"))
+                       (builds
+                        (assoc-ref system-test-details "builds")))
+
+                   (when (and (not
+                               (member name
+                                       %system-tests-that-change-every-revision))
+                              (= (vector-length builds) 0))
+                     (submit-build build-coordinator
+                                   guix-data-service
+                                   (assoc-ref system-test-details "derivation")))))
+               system-tests)))
+          %systems))
+       recent-processed-revision-commits)))
+
+  (call-with-new-thread
+   (lambda ()
+     (while #t
+       (with-exception-handler
+           (lambda (exn)
+             (simple-format
+              (current-error-port)
+              "exception in submit system test builds thread: ~A\n"
+              exn))
+         (lambda ()
+           (with-throw-handler #t
+             submit-builds
+             (lambda args
+               (display (backtrace) (current-error-port))
+               (newline (current-error-port)))))
+         #:unwind? #t)
+
+       (sleep 3600)))))
diff --git a/scripts/guix-qa-frontpage.in b/scripts/guix-qa-frontpage.in
index 6ae3f52..a3a70af 100644
--- a/scripts/guix-qa-frontpage.in
+++ b/scripts/guix-qa-frontpage.in
@@ -129,7 +129,10 @@
                                           "https://data.qa.guix.gnu.org")
         (start-submit-branch-builds-thread database
                                            "http://127.0.0.1:8746"
-                                           "https://data.qa.guix.gnu.org"))
+                                           "https://data.qa.guix.gnu.org")
+        (start-submit-master-branch-system-tests-thread database
+                                                        "http://127.0.0.1:8746"
+                                                        "https://data.qa.guix.gnu.org"))
 
       (when (assq-ref opts 'manage-patch-branches)
         (start-manage-patch-branches-thread database))