Add remote building tests.
This commit is contained in:
parent
34ab5c9912
commit
b645f4eb0c
|
@ -25,6 +25,7 @@
|
|||
/configure
|
||||
/doc/version.texi
|
||||
/src/cuirass/config.scm
|
||||
/tests/cache
|
||||
Makefile
|
||||
Makefile.in
|
||||
pre-inst-env
|
||||
|
|
|
@ -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
|
||||
|
|
6
TODO
6
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.
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))))))
|
||||
|
||||
|
|
|
@ -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))))
|
|
@ -0,0 +1,6 @@
|
|||
(public-key
|
||||
(ecc
|
||||
(curve Ed25519)
|
||||
(q #B379E6AB636C9C203884625D754126ED7A34841A98B0453E858D44D96ABDD33C#)
|
||||
)
|
||||
)
|
|
@ -0,0 +1,7 @@
|
|||
(private-key
|
||||
(ecc
|
||||
(curve Ed25519)
|
||||
(q #B379E6AB636C9C203884625D754126ED7A34841A98B0453E858D44D96ABDD33C#)
|
||||
(d #644E577FB9E8753BC590D3584A79FBE34F49BACEAA0F9AC1769BDE2FD66447D0#)
|
||||
)
|
||||
)
|
Loading…
Reference in New Issue