futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

offload: Allow testing machines that match a regexp.

Browse Source 
* guix/scripts/offload.scm (check-machine-availability): Add 'pred'
parameter and honor it.
(guix-offload): for the "test" sub-command, accept an extra 'regexp'
parameter.  Pass a second argument to 'check-machine-availability'.
This commit is contained in:
Ludovic Courtès 2016-12-09 23:12:06 +01:00
parent 2b513387cd
commit 27991c97e6
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 22 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
doc/guix.texi
View File

@ -1005,6 +1005,12 @@ command line:
# guix offload test machines-qualif.scm # guix offload test machines-qualif.scm
@end example @end example
Last, you can test the subset of the machines whose name matches a
regular expression like this:
@example
# guix offload test machines.scm '\.gnu\.org$'
@end example
@node Invoking guix-daemon @node Invoking guix-daemon
@section Invoking @command{guix-daemon} @section Invoking @command{guix-daemon}

25
guix/scripts/offload.scm
View File

@ -708,16 +708,18 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
(leave (_ "failed to import '~a' from '~a'~%") (leave (_ "failed to import '~a' from '~a'~%")
item name))))) item name)))))
(define (check-machine-availability machine-file) (define (check-machine-availability machine-file pred)
"Check that each machine in MACHINE-FILE is usable as a build machine." "Check that each machine matching PRED in MACHINE-FILE is usable as a build
machine."
(define (build-machine=? m1 m2) (define (build-machine=? m1 m2)
(and (string=? (build-machine-name m1) (build-machine-name m2)) (and (string=? (build-machine-name m1) (build-machine-name m2))
(= (build-machine-port m1) (build-machine-port m2)))) (= (build-machine-port m1) (build-machine-port m2))))
;; A given build machine may appear several times (e.g., once for ;; A given build machine may appear several times (e.g., once for
;; "x86_64-linux" and a second time for "i686-linux"); test them only once. ;; "x86_64-linux" and a second time for "i686-linux"); test them only once.
(let ((machines (delete-duplicates (build-machines machine-file) (let ((machines (filter pred
build-machine=?))) (delete-duplicates (build-machines machine-file)
build-machine=?))))
(info (_ "testing ~a build machines defined in '~a'...~%") (info (_ "testing ~a build machines defined in '~a'...~%")
(length machines) machine-file) (length machines) machine-file)
(let* ((names (map build-machine-name machines)) (let* ((names (map build-machine-name machines))
@ -781,11 +783,16 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
(loop (read-line))))))) (loop (read-line)))))))
(("test" rest ...) (("test" rest ...)
(with-error-handling (with-error-handling
(let ((file (match rest (let-values (((file pred)
((file) file) (match rest
(() %machine-file) ((file regexp)
(_ (leave (_ "wrong number of arguments~%")))))) (values file
(check-machine-availability (or file %machine-file))))) (compose (cut string-match regexp <>)
build-machine-name)))
((file) (values file (const #t)))
(() (values %machine-file (const #t)))
(_ (leave (_ "wrong number of arguments~%"))))))
(check-machine-availability (or file %machine-file) pred))))
(("--version") (("--version")
(show-version-and-exit "guix offload")) (show-version-and-exit "guix offload"))
(("--help") (("--help")