Re: [PATCH 2/2] scripts: Add 'publish' command.

[Ludovic Courtès]

David Thompson <address@hidden> skribis:

> From 7200a8ca892308a03a92e737b493244154bab358 Mon Sep 17 00:00:00 2001
> From: David Thompson <address@hidden>
> Date: Tue, 17 Mar 2015 10:21:31 -0400
> Subject: [PATCH 2/2] scripts: Add 'publish' command.
>
> * guix/scripts/publish.scm: New file.
> * Makefile.am (MODULES): Add it.
> * doc/guix.texi ("Invoking guix publish"): New node.

Yaaay!

> address@hidden Invoking guix publish
> address@hidden Invoking @command{guix publish}
> +
> +The purpose of @command{guix publish} is to expose a Hydra-compatible
> +HTTP API for sharing substitutes from the local store.

s/API/interface/ maybe

I think we should first describe the functionality (what it means to
share the store over HTTP), and only then mention Hydra-compatibility
(which is not something users really care about.)

There should be a word about signing, with an xref to ‘guix archive’ I
think.  Perhaps later we could add an option to choose the signing key.

> address@hidden
> +guix-daemon --substitute-urls=example.org:8080

It should have “http://”.

Eventually™ it will be possible to specify substitute URLs from the
client; whether to actually use them with still be decided based on the
keys the sysadmin authorized.  Preliminary patch that adds
‘--substitute-urls’ to ‘guix build’ et al.:

--- a/guix/store.scm
+++ b/guix/store.scm
@@ -484,11 +512,11 @@ encoding conversion errors."
     (when (>= (nix-server-minor-version server) 10)
       (send (boolean use-substitutes?)))
     (when (>= (nix-server-minor-version server) 12)
-      (let ((pairs (if timeout
-                       `(("build-timeout" . ,(number->string timeout))
-                         ,@binary-caches)
-                       binary-caches)))
-        (send (string-pairs pairs))))
+      (let ((pairs `(,@(if timeout
+                           `(("build-timeout" . ,(number->string timeout)))
+                           '())
+                     ("substitute-urls" . ,(string-join substitute-urls)))))
+        (send (string-pairs (pk 'pairs pairs)))))
     (let loop ((done? (process-stderr server)))
       (or done? (process-stderr server)))))
 
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 370c2a3..df38b5e 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -110,6 +110,9 @@ options handled by 'set-build-options-from-command-line', 
and listed in
   (display (_ "
       --no-substitutes   build instead of resorting to pre-built substitutes"))
   (display (_ "
+      --substitute-urls=URLS
+                         fetch substitute from URLS if they are authorized"))
+  (display (_ "
       --no-build-hook    do not attempt to offload builds via the build hook"))
   (display (_ "
       --max-silent-time=SECONDS
@@ -133,6 +136,8 @@ options handled by 'set-build-options-from-command-line', 
and listed in
                      #:max-build-jobs (or (assoc-ref opts 'max-jobs) 1)
                      #:fallback? (assoc-ref opts 'fallback?)
                      #:use-substitutes? (assoc-ref opts 'substitutes?)
+                     #:substitute-urls (or (assoc-ref opts 'substitute-urls)
+                                           '())
                      #:use-build-hook? (assoc-ref opts 'build-hook?)
                      #:max-silent-time (assoc-ref opts 'max-silent-time)
                      #:timeout (assoc-ref opts 'timeout)
@@ -166,6 +171,13 @@ options handled by 'set-build-options-from-command-line', 
and listed in
                          (alist-cons 'substitutes? #f
                                      (alist-delete 'substitutes? result))
                          rest)))
+        (option '("substitute-urls") #t #f
+                (lambda (opt name arg result . rest)
+                  (apply values
+                         (alist-cons 'substitute-urls
+                                     (string-tokenize arg)
+                                     (alist-delete 'substitute-urls result))
+                         rest)))
         (option '("no-build-hook") #f #f
                 (lambda (opt name arg result . rest)
                   (apply values

diff --git a/guix/scripts/substitute-binary.scm 
b/guix/scripts/substitute-binary.scm
index 903564c..1d45753 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -631,7 +631,10 @@ found."
   (assoc-ref (daemon-options) option))
 
 (define %cache-url
-  (match (and=> (find-daemon-option "substitute-urls")
+  (match (and=> (string-append
+                 (find-daemon-option "untrusted-substitute-urls") ;client
+                 " "
+                 (find-daemon-option "substitute-urls"))          ;admin
                 string-tokenize)
     ((url)
      url)

I won’t commit it yet because at this point the substituter caches only
from one server, so users could populate
/var/guix/substitute-binary/cache and lead other users to use the
substituter that they chose (or to use nothing if the substituter server
in question returned 404 for all the narinfos.)

That should be easily fixed though (for the interested reader? ;-)).

> --- /dev/null
> +++ b/guix/scripts/publish.scm

Make sure to add the license header.

> +  (display (_ "Usage: guix publish [OPTION]...
> +Publish the store directory over HTTP.\n"))

Maybe “Publish ~a over HTTP” with (%store-directory) would be more
immediately obvious (and translations would be accurate ;-)).

> +(define (load-derivation file-name)
> +  "Read the derivation located at FILE-NAME."
> +  (with-input-from-file file-name
> +    (lambda ()
> +      (read-derivation (current-input-port)))))

(call-with-input-file file read-derivation)

> +(define (sign-string s)
> +  "Sign the hash of the string S with the daemon's key."
> +  (let ((hash (bytevector->hash-data (sha256 (string->utf8 s)))))
> +    (signature-sexp hash %private-key %public-key)))

I had to change it to:

  (define (sign-string s)
    "Sign the hash of the string S with the daemon's key."
    (let ((hash (bytevector->hash-data (sha256 (string->utf8 s))
                                       #:key-type (key-type %public-key))))
      (signature-sexp hash %private-key %public-key)))

Otherwise, ‘bytevector->hash-data’ will assume you have an ECC key and
‘sign’ will raise an exception if you happen to have an RSA key, for
instance.

Maybe ‘signed-string’ would be a more appropriate name since it’s a pure
function.

> +(define (narinfo-string store-path path-info derivation deriver key)

Docstring please.  I would suggest using keyword arguments for arguments
above position 2.

Aren’t ‘derivation’ and ‘deriver’ redundant with ‘path-info’?

> +  (let* ((url (string-append "nar/" (basename store-path)))
> +         (nar-hash (bytevector->base32-string
> +                    (path-info-hash path-info)))
> +         (nar-size (path-info-nar-size path-info))
> +         (references (string-join (map basename (path-info-refs path-info))
> +                                  " "))
> +         (system (derivation-system derivation))
> +         (deriver (basename deriver))
> +         (info (format #f

Please align the RHS and maybe use single-word identifiers.  (I hate it
when I look this fussy.)

> +    (values '((content-type . (application/x-nix-archive
> +                               (charset . "ISO-8859-1"))))

Please add a comment saying that choosing ISO-8859-1 is crucial since
otherwise HTTP clients will interpret the byte stream as UTF-8 and
arbitrarily change invalid byte sequences.  We don’t want anyone to feel
that pain again.  ;-)

> +      (format #t "Publishing store on port ~d~%" port)

Lowercase and use (_ "publishing ..."), and add the file to
po/guix/POTFILES.in.

Now, it would be good to add a bunch of tests.  :-)

Perhaps one way to do it would be to write them in Scheme, and invoke
‘guix-publish’ in a thread, similar to the HTTP tests in
tests/lint.scm.  From there we could check .narinfo and .nar URLs.
WDYT?

Thanks for working on it in spite of the numerous issues you
encountered!

Ludo’.