From b645f4eb0cc9980a85b7b940ca78cc05c4735731 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 22 Mar 2021 16:25:53 +0100 Subject: [PATCH] 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(-) create mode 100644 tests/remote.scm create mode 100644 tests/signing-key.pub create mode 100644 tests/signing-key.sec 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 * 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 +;;; +;;; 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 . + +(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#) + ) + )