~ruther/guix-local

27991c97e64c95be4cae7f2b0a843565df329215 — Ludovic Courtès 9 years ago 2b51338
offload: Allow testing machines that match a regexp.

* 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'.
2 files changed, 22 insertions(+), 9 deletions(-)

M doc/guix.texi
M guix/scripts/offload.scm
M doc/guix.texi => doc/guix.texi +6 -0
@@ 1005,6 1005,12 @@ command line:
# guix offload test machines-qualif.scm
@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
@section Invoking @command{guix-daemon}

M guix/scripts/offload.scm => guix/scripts/offload.scm +16 -9
@@ 708,16 708,18 @@ allowed on MACHINE.  Return +∞ if MACHINE is unreachable."
          (leave (_ "failed to import '~a' from '~a'~%")
                 item name)))))

(define (check-machine-availability machine-file)
  "Check that each machine in MACHINE-FILE is usable as a build machine."
(define (check-machine-availability machine-file pred)
  "Check that each machine matching PRED in MACHINE-FILE is usable as a build
machine."
  (define (build-machine=? m1 m2)
    (and (string=? (build-machine-name m1) (build-machine-name m2))
         (= (build-machine-port m1) (build-machine-port m2))))

  ;; 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.
  (let ((machines (delete-duplicates (build-machines machine-file)
                                     build-machine=?)))
  (let ((machines (filter pred
                          (delete-duplicates (build-machines machine-file)
                                             build-machine=?))))
    (info (_ "testing ~a build machines defined in '~a'...~%")
          (length machines) machine-file)
    (let* ((names    (map build-machine-name machines))


@@ 781,11 783,16 @@ allowed on MACHINE.  Return +∞ if MACHINE is unreachable."
             (loop (read-line)))))))
    (("test" rest ...)
     (with-error-handling
       (let ((file (match rest
                     ((file) file)
                     (()     %machine-file)
                     (_      (leave (_ "wrong number of arguments~%"))))))
         (check-machine-availability (or file %machine-file)))))
       (let-values (((file pred)
                     (match rest
                       ((file regexp)
                        (values 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")
     (show-version-and-exit "guix offload"))
    (("--help")