Re: bug#39819: [PATCH 1/2] services: guix: Make /etc/guix/acl really declarative by default.

["Ludovic Courtès" <ludo@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 236 bytes --]

BTW, attached it the script I used to retrieve the signing keys of all
the build nodes of the build farm so we can have them declared in the
config of the head node.  You may find it handy if you have a similar
setup!

Ludo’.


[-- Attachment #2: the code --]
[-- Type: text/plain, Size: 1651 bytes --]

(use-modules (guix scripts offload)
             (guix ssh)
             (guix inferior)
             (ssh session)
             (srfi srfi-34)
             (ice-9 match))

(define open-ssh-session
  (@@ (guix scripts offload) open-ssh-session))

(define build-machine-name (@@ (guix scripts offload) build-machine-name))
(define build-machine-port (@@ (guix scripts offload) build-machine-port))

(define (fetch-key machine)
  (format #t "fetching key from ~s...~%" machine)
  (let* ((session  (open-ssh-session machine 5))
         (inferior (remote-inferior session)))
    (define key
      (inferior-eval '(begin
                        (use-modules (rnrs io ports))

                        (with-fluids ((%default-port-encoding "ISO-8859-1"))
                          (call-with-input-file "/etc/guix/signing-key.pub"
                            get-string-all)))
                     inferior))

    (define file
      (string-append (build-machine-name machine)
                     (match (build-machine-port machine)
                       (22 "")
                       (port
                        (string-append ":"
                                       (number->string
                                        port))))
                     ".pub"))

    (with-fluids ((%default-port-encoding "ISO-8859-1"))
      (call-with-output-file file
        (lambda (port)
          (display key port))))

    (close-inferior inferior)
    (disconnect! session)))

(let ((machines (load "/etc/guix/machines.scm")))
  (for-each (lambda (machine)
              (guard (c (pk 'fail c))
                (fetch-key machine)))
            machines))