[no subject]

[Mathieu Othacehe]

branch: master
commit b645f4eb0cc9980a85b7b940ca78cc05c4735731
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Mon Mar 22 16:25:53 2021 +0100

    Add remote building tests.
---
 .gitignore                            |   1 +
 Makefile.am                           |   1 +
 TODO                                  |   6 --
 src/cuirass/scripts/remote-server.scm |  11 ++-
 src/cuirass/scripts/remote-worker.scm |   9 +-
 tests/common.scm                      |  13 +++
 tests/database.scm                    |  12 ---
 tests/http.scm                        |   2 +-
 tests/remote.scm                      | 174 ++++++++++++++++++++++++++++++++++
 tests/signing-key.pub                 |   6 ++
 tests/signing-key.sec                 |   7 ++
 11 files changed, 219 insertions(+), 23 deletions(-)

diff --git a/.gitignore b/.gitignore
index 47627e3..95ed6cb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -25,6 +25,7 @@
 /configure
 /doc/version.texi
 /src/cuirass/config.scm
+/tests/cache
 Makefile
 Makefile.in
 pre-inst-env
diff --git a/Makefile.am b/Makefile.am
index cec42e9..82d8512 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -125,6 +125,7 @@ TESTS = \
   tests/database.scm \
   tests/http.scm \
   tests/metrics.scm \
+  tests/remote.scm \
   tests/utils.scm
 
 # Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling.  Otherwise, if
diff --git a/TODO b/TODO
index f540f4c..625b232 100644
--- a/TODO
+++ b/TODO
@@ -8,12 +8,6 @@ Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
 * Add "BuildSteps" table like in Hydra.
 This will prevent package dependencies to be built multiple times.
 
-* Add tests for the remote building mechanism.
-- Write test cases covering the nominal remote building scenario, with a
-  server dispatching build tasks to multiple local workers.
-- Write test cases covering workers disconnection and reconnection.
-- Write test cases covering build timeout.
-
 * Add new metrics.
 - Add "build speed per machine" and "idle time per machine" metrics.
 
diff --git a/src/cuirass/scripts/remote-server.scm 
b/src/cuirass/scripts/remote-server.scm
index 43547f4..94ce3ea 100644
--- a/src/cuirass/scripts/remote-server.scm
+++ b/src/cuirass/scripts/remote-server.scm
@@ -67,7 +67,8 @@
   (make-atomic-box #f))
 
 (define %cache-directory
-  (make-parameter #f))
+  (make-parameter
+   (string-append (cache-directory #:ensure? #t) "/cuirass")))
 
 (define %trigger-substitute-url
   (make-parameter #f))
@@ -464,8 +465,7 @@ exiting."
             (read-file-sexp
              (assoc-ref opts 'private-key-file))))
 
-      (parameterize ((%cache-directory cache)
-                     (%log-port log-port)
+      (parameterize ((%log-port log-port)
                      (%publish-port publish-port)
                      (%trigger-substitute-url trigger-substitute-url)
                      (%package-database database)
@@ -475,6 +475,11 @@ exiting."
         ;; Enable core dump generation.
         (setrlimit 'core #f #f)
 
+        (and cache
+             (%cache-directory cache))
+
+        (mkdir-p (%cache-directory))
+
         (when user
           (gather-user-privileges user))
 
diff --git a/src/cuirass/scripts/remote-worker.scm 
b/src/cuirass/scripts/remote-worker.scm
index 93300ab..56ecc17 100644
--- a/src/cuirass/scripts/remote-worker.scm
+++ b/src/cuirass/scripts/remote-worker.scm
@@ -56,6 +56,13 @@
 (define %stop-process?
   (make-atomic-box #f))
 
+;; The build request period.
+(define %request-period
+  (make-parameter
+   (or (string->number
+        (getenv "REQUEST_PERIOD"))
+       10)))
+
 (define (show-help)
   (format #t "Usage: ~a remote-worker [OPTION]...
 Start a remote build worker.\n" (%program-name))
@@ -306,7 +313,7 @@ and executing them.  The worker can reply on the same 
socket."
               (run-command (bv->string command) server
                            #:reply (reply socket)
                            #:worker worker)))
-           (sleep 10)
+           (sleep (%request-period))
            (loop)))))
     (pid pid)))
 
diff --git a/tests/common.scm b/tests/common.scm
index 75cac1d..3412c8b 100644
--- a/tests/common.scm
+++ b/tests/common.scm
@@ -23,6 +23,7 @@
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
   #:export (%db
+            retry
             test-init-db!))
 
 (define %db
@@ -36,6 +37,18 @@
     (close-pipe pipe)
     uri))
 
+(define* (retry f #:key times delay)
+  (let loop ((attempt 1))
+    (let ((result (f)))
+      (cond
+       (result result)
+       (else
+        (if (>= attempt times)
+            #f
+            (begin
+              (sleep delay)
+              (loop (+ 1 attempt)))))))))
+
 (define (test-init-db!)
   "Initialize the test database."
   (%create-database? #t)
diff --git a/tests/database.scm b/tests/database.scm
index b9bfca2..b0823c4 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -102,18 +102,6 @@
    (systems '("a" "b"))
    (last-seen 1)))
 
-(define* (retry f #:key times delay)
-  (let loop ((attempt 1))
-    (let ((result (f)))
-      (cond
-       (result result)
-       (else
-        (if (>= attempt times)
-            #f
-            (begin
-              (sleep delay)
-              (loop (+ 1 attempt)))))))))
-
 (test-group-with-cleanup "database"
   (test-assert "db-init"
     (begin
diff --git a/tests/http.scm b/tests/http.scm
index 5b77cb2..80857b3 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -239,7 +239,7 @@
               (test-cuirass-uri
                "/api/latestbuilds?nr=1&jobset=guix"))))
       (#(build)
-       (lset= equal? (pk build)
+       (lset= equal? build
               (json-string->scm
                (object->json-string build-query-result))))))
 
diff --git a/tests/remote.scm b/tests/remote.scm
new file mode 100644
index 0000000..884365a
--- /dev/null
+++ b/tests/remote.scm
@@ -0,0 +1,174 @@
+;;; remote.scm -- test the remote building mechanism
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; This file is part of Cuirass.
+;;;
+;;; Cuirass is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Cuirass is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Cuirass.  If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (cuirass database)
+             (cuirass specification)
+             (gnu packages base)
+             (guix build utils)
+             (guix channels)
+             (guix derivations)
+             (guix gexp)
+             (guix monads)
+             (guix packages)
+             (guix store)
+             (tests common)
+             (squee)
+             (srfi srfi-64)
+             (ice-9 match)
+             (ice-9 threads))
+
+(define server
+  (make-parameter #f))
+
+(define worker
+  (make-parameter #f))
+
+(define (start-worker)
+  (worker
+   (match (primitive-fork)
+     (0
+      (setenv "REQUEST_PERIOD" "1")
+      (execlp "cuirass" "cuirass" "remote-worker"
+              "--server=127.0.0.1:5555"
+              "--private-key=tests/signing-key.sec"
+              "--public-key=tests/signing-key.pub"))
+     (pid pid))))
+
+(define (stop-worker)
+  (let ((worker (worker)))
+    (kill worker SIGINT)
+    (waitpid worker)))
+
+(define (start-server)
+  (server
+   (match (primitive-fork)
+     (0
+      (mkdir-p "tests/cache")
+      (execlp "cuirass" "cuirass" "remote-server"
+              (string-append "--database=" (%package-database))
+              "--cache=tests/cache"
+              "--private-key=tests/signing-key.sec"
+              "--public-key=tests/signing-key.pub"))
+     (pid pid))))
+
+(define (stop-server)
+  (let ((server (server)))
+    (kill server SIGINT)
+    (waitpid server)))
+
+(define* (dummy-drv #:optional sleep)
+  (with-store store
+    (derivation-file-name
+     (run-with-store store
+       (let ((exp #~(begin
+                      (when #$sleep
+                        (sleep #$sleep))
+                      (mkdir #$output))))
+         (gexp->derivation "foo" exp))))))
+
+(define drv
+  (dummy-drv))
+
+(define drv-with-timeout
+  (dummy-drv 2))
+
+(define* (make-build #:key
+                     drv
+                     output
+                     (timeout 0))
+  `((#:derivation . ,drv)
+    (#:eval-id . 1)
+    (#:job-name . "fake-job")
+    (#:system . "x86_64-linux")
+    (#:nix-name . "fake-1.0")
+    (#:log . "unused so far")
+    (#:status . ,(build-status scheduled))
+    (#:outputs . (("out" . ,output)))
+    (#:timestamp . 1501347493)
+    (#:timeout . ,timeout)))
+
+(test-group-with-cleanup "remote"
+  (test-assert "db-init"
+    (begin
+      (test-init-db!)
+      #t))
+
+  (test-assert "fill-db"
+    (let ((build build)
+          (spec
+           (specification
+            (name "guix")
+            (build 'hello)))
+          (checkouts
+           (list
+            (checkout->channel-instance "dir1"
+                                        #:name 'guix
+                                        #:url "url1"
+                                        #:commit "fakesha1"))))
+      (db-add-or-update-specification spec)
+      (db-add-evaluation "guix" checkouts
+                         #:timestamp 1501347493)
+      (db-add-build (make-build #:drv drv
+                                #:output "fake-1"))))
+
+  (test-assert "remote-server"
+    (begin
+      (start-server)
+      #t))
+
+  (test-assert "remote-worker"
+    (begin
+      (start-worker)
+      #t))
+
+  (test-assert "build done"
+    (retry
+     (lambda ()
+       (eq? (assq-ref (db-get-build drv) #:status)
+            (build-status succeeded)))
+     #:times 10
+     #:delay 1))
+
+  (test-assert "build timeout"
+    (begin
+      (db-add-build (make-build #:drv drv-with-timeout
+                                #:output "fake-2"
+                                #:timeout 1))
+      (retry
+       (lambda ()
+         (eq? (assq-ref (db-get-build drv-with-timeout) #:status)
+              (build-status failed)))
+       #:times 10
+       #:delay 1)))
+
+  (test-assert "worker restart"
+    (begin
+      (stop-worker)
+      (start-worker)
+      (db-update-build-status! drv (build-status scheduled))
+      (retry
+       (lambda ()
+         (eq? (assq-ref (db-get-build drv) #:status)
+              (build-status succeeded)))
+       #:times 10
+       #:delay 1)))
+
+  (test-assert "clean-up"
+    (begin
+      (stop-worker)
+      (stop-server))))
diff --git a/tests/signing-key.pub b/tests/signing-key.pub
new file mode 100644
index 0000000..9093619
--- /dev/null
+++ b/tests/signing-key.pub
@@ -0,0 +1,6 @@
+(public-key 
+ (ecc 
+  (curve Ed25519)
+  (q #B379E6AB636C9C203884625D754126ED7A34841A98B0453E858D44D96ABDD33C#)
+  )
+ )
diff --git a/tests/signing-key.sec b/tests/signing-key.sec
new file mode 100644
index 0000000..1d80d10
--- /dev/null
+++ b/tests/signing-key.sec
@@ -0,0 +1,7 @@
+(private-key 
+ (ecc 
+  (curve Ed25519)
+  (q #B379E6AB636C9C203884625D754126ED7A34841A98B0453E858D44D96ABDD33C#)
+  (d #644E577FB9E8753BC590D3584A79FBE34F49BACEAA0F9AC1769BDE2FD66447D0#)
+  )
+ )