Add remote building tests.
This commit is contained in:
parent
34ab5c9912
commit
b645f4eb0c
|
@ -25,6 +25,7 @@
|
||||||
/configure
|
/configure
|
||||||
/doc/version.texi
|
/doc/version.texi
|
||||||
/src/cuirass/config.scm
|
/src/cuirass/config.scm
|
||||||
|
/tests/cache
|
||||||
Makefile
|
Makefile
|
||||||
Makefile.in
|
Makefile.in
|
||||||
pre-inst-env
|
pre-inst-env
|
||||||
|
|
|
@ -125,6 +125,7 @@ TESTS = \
|
||||||
tests/database.scm \
|
tests/database.scm \
|
||||||
tests/http.scm \
|
tests/http.scm \
|
||||||
tests/metrics.scm \
|
tests/metrics.scm \
|
||||||
|
tests/remote.scm \
|
||||||
tests/utils.scm
|
tests/utils.scm
|
||||||
|
|
||||||
# Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if
|
# 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.
|
* Add "BuildSteps" table like in Hydra.
|
||||||
This will prevent package dependencies to be built multiple times.
|
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 new metrics.
|
||||||
- Add "build speed per machine" and "idle time per machine" metrics.
|
- Add "build speed per machine" and "idle time per machine" metrics.
|
||||||
|
|
||||||
|
|
|
@ -67,7 +67,8 @@
|
||||||
(make-atomic-box #f))
|
(make-atomic-box #f))
|
||||||
|
|
||||||
(define %cache-directory
|
(define %cache-directory
|
||||||
(make-parameter #f))
|
(make-parameter
|
||||||
|
(string-append (cache-directory #:ensure? #t) "/cuirass")))
|
||||||
|
|
||||||
(define %trigger-substitute-url
|
(define %trigger-substitute-url
|
||||||
(make-parameter #f))
|
(make-parameter #f))
|
||||||
|
@ -464,8 +465,7 @@ exiting."
|
||||||
(read-file-sexp
|
(read-file-sexp
|
||||||
(assoc-ref opts 'private-key-file))))
|
(assoc-ref opts 'private-key-file))))
|
||||||
|
|
||||||
(parameterize ((%cache-directory cache)
|
(parameterize ((%log-port log-port)
|
||||||
(%log-port log-port)
|
|
||||||
(%publish-port publish-port)
|
(%publish-port publish-port)
|
||||||
(%trigger-substitute-url trigger-substitute-url)
|
(%trigger-substitute-url trigger-substitute-url)
|
||||||
(%package-database database)
|
(%package-database database)
|
||||||
|
@ -475,6 +475,11 @@ exiting."
|
||||||
;; Enable core dump generation.
|
;; Enable core dump generation.
|
||||||
(setrlimit 'core #f #f)
|
(setrlimit 'core #f #f)
|
||||||
|
|
||||||
|
(and cache
|
||||||
|
(%cache-directory cache))
|
||||||
|
|
||||||
|
(mkdir-p (%cache-directory))
|
||||||
|
|
||||||
(when user
|
(when user
|
||||||
(gather-user-privileges user))
|
(gather-user-privileges user))
|
||||||
|
|
||||||
|
|
|
@ -56,6 +56,13 @@
|
||||||
(define %stop-process?
|
(define %stop-process?
|
||||||
(make-atomic-box #f))
|
(make-atomic-box #f))
|
||||||
|
|
||||||
|
;; The build request period.
|
||||||
|
(define %request-period
|
||||||
|
(make-parameter
|
||||||
|
(or (string->number
|
||||||
|
(getenv "REQUEST_PERIOD"))
|
||||||
|
10)))
|
||||||
|
|
||||||
(define (show-help)
|
(define (show-help)
|
||||||
(format #t "Usage: ~a remote-worker [OPTION]...
|
(format #t "Usage: ~a remote-worker [OPTION]...
|
||||||
Start a remote build worker.\n" (%program-name))
|
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
|
(run-command (bv->string command) server
|
||||||
#:reply (reply socket)
|
#:reply (reply socket)
|
||||||
#:worker worker)))
|
#:worker worker)))
|
||||||
(sleep 10)
|
(sleep (%request-period))
|
||||||
(loop)))))
|
(loop)))))
|
||||||
(pid pid)))
|
(pid pid)))
|
||||||
|
|
||||||
|
|
|
@ -23,6 +23,7 @@
|
||||||
#:use-module (ice-9 popen)
|
#:use-module (ice-9 popen)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
#:export (%db
|
#:export (%db
|
||||||
|
retry
|
||||||
test-init-db!))
|
test-init-db!))
|
||||||
|
|
||||||
(define %db
|
(define %db
|
||||||
|
@ -36,6 +37,18 @@
|
||||||
(close-pipe pipe)
|
(close-pipe pipe)
|
||||||
uri))
|
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!)
|
(define (test-init-db!)
|
||||||
"Initialize the test database."
|
"Initialize the test database."
|
||||||
(%create-database? #t)
|
(%create-database? #t)
|
||||||
|
|
|
@ -102,18 +102,6 @@
|
||||||
(systems '("a" "b"))
|
(systems '("a" "b"))
|
||||||
(last-seen 1)))
|
(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-group-with-cleanup "database"
|
||||||
(test-assert "db-init"
|
(test-assert "db-init"
|
||||||
(begin
|
(begin
|
||||||
|
|
|
@ -239,7 +239,7 @@
|
||||||
(test-cuirass-uri
|
(test-cuirass-uri
|
||||||
"/api/latestbuilds?nr=1&jobset=guix"))))
|
"/api/latestbuilds?nr=1&jobset=guix"))))
|
||||||
(#(build)
|
(#(build)
|
||||||
(lset= equal? (pk build)
|
(lset= equal? build
|
||||||
(json-string->scm
|
(json-string->scm
|
||||||
(object->json-string build-query-result))))))
|
(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