From ab2a74e4dbfd396566a8b14223f5849304d4fe6b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 22 Mar 2017 09:50:06 +0100 Subject: publish: The public and private keys are now SRFI-39 parameters. * guix/scripts/publish.scm (%default-options): Add 'public-key-file' and 'private-key-file'. (lazy-read-file-sexp): Remove. (%private-key, %public-key): Turn into SRFI-39 parameters. (signed-string, render-narinfo): Adjust accordingly. (guix-publish): Honor 'public-key-file' and 'private-key-file' from OPTS. Use 'parameterize'. * guix/pk-crypto.scm (read-file-sexp): New procedure. * tests/publish.scm: Initialize '%public-key' and '%private-key'. --- guix/pk-crypto.scm | 8 ++++++ guix/scripts/publish.scm | 63 +++++++++++++++++++++++++----------------------- 2 files changed, 41 insertions(+), 30 deletions(-) (limited to 'guix') diff --git a/guix/pk-crypto.scm b/guix/pk-crypto.scm index 7017006a71..55ba7b1bb8 100644 --- a/guix/pk-crypto.scm +++ b/guix/pk-crypto.scm @@ -23,11 +23,13 @@ #:use-module (system foreign) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) #:export (canonical-sexp? error-source error-string string->canonical-sexp canonical-sexp->string + read-file-sexp number->canonical-sexp canonical-sexp-car canonical-sexp-cdr @@ -143,6 +145,12 @@ thrown along with 'gcry-error'." (loop (* len 2)) (pointer->string buf size "ISO-8859-1"))))))) +(define (read-file-sexp file) + "Return the canonical sexp read from FILE." + (call-with-input-file file + (compose string->canonical-sexp + read-string))) + (define canonical-sexp-car (let* ((ptr (libgcrypt-func "gcry_sexp_car")) (proc (pointer->procedure '* ptr '(*)))) diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 33a7b3bd42..57eea792b6 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson -;;; Copyright © 2015, 2016 Ludovic Courtès +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -52,7 +52,10 @@ #:use-module (guix scripts) #:use-module ((guix utils) #:select (compressed-file?)) #:use-module ((guix build utils) #:select (dump-port)) - #:export (guix-publish)) + #:export (%public-key + %private-key + + guix-publish)) (define (show-help) (format #t (_ "Usage: guix publish [OPTION]... @@ -154,6 +157,9 @@ compression disabled~%")) (define %default-options `((port . 8080) + (public-key-file . ,%public-key-file) + (private-key-file . ,%private-key-file) + ;; Default to fast & low compression. (compression . ,(if (zlib-available?) %default-gzip-compression @@ -162,18 +168,11 @@ compression disabled~%")) (address . ,(make-socket-address AF_INET INADDR_ANY 0)) (repl . #f))) -(define (lazy-read-file-sexp file) - "Return a promise to read the canonical sexp from FILE." - (delay - (call-with-input-file file - (compose string->canonical-sexp - read-string)))) - +;; The key pair used to sign narinfos. (define %private-key - (lazy-read-file-sexp %private-key-file)) - + (make-parameter #f)) (define %public-key - (lazy-read-file-sexp %public-key-file)) + (make-parameter #f)) (define %nix-cache-info `(("StoreDir" . ,%store-directory) @@ -186,10 +185,10 @@ compression disabled~%")) (define (signed-string s) "Sign the hash of the string S with the daemon's key." - (let* ((public-key (force %public-key)) + (let* ((public-key (%public-key)) (hash (bytevector->hash-data (sha256 (string->utf8 s)) #:key-type (key-type public-key)))) - (signature-sexp hash (force %private-key) public-key))) + (signature-sexp hash (%private-key) public-key))) (define base64-encode-string (compose base64-encode string->utf8)) @@ -279,7 +278,7 @@ appropriate duration." `((cache-control (max-age . ,ttl))) '())) (cut display - (narinfo-string store store-path (force %private-key) + (narinfo-string store store-path (%private-key) #:compression compression) <>))))) @@ -566,11 +565,12 @@ blocking." (sockaddr:addr addr) port))) (socket (open-server-socket address)) - (repl-port (assoc-ref opts 'repl))) - ;; Read the key right away so that (1) we fail early on if we can't - ;; access them, and (2) we can then drop privileges. - (force %private-key) - (force %public-key) + (repl-port (assoc-ref opts 'repl)) + + ;; Read the key right away so that (1) we fail early on if we can't + ;; access them, and (2) we can then drop privileges. + (public-key (read-file-sexp (assoc-ref opts 'public-key-file))) + (private-key (read-file-sexp (assoc-ref opts 'private-key-file)))) (when user ;; Now that we've read the key material and opened the socket, we can @@ -580,13 +580,16 @@ blocking." (when (zero? (getuid)) (warning (_ "server running as root; \ consider using the '--user' option!~%"))) - (format #t (_ "publishing ~a on ~a, port ~d~%") - %store-directory - (inet-ntop (sockaddr:fam address) (sockaddr:addr address)) - (sockaddr:port address)) - (when repl-port - (repl:spawn-server (repl:make-tcp-server-socket #:port repl-port))) - (with-store store - (run-publish-server socket store - #:compression compression - #:narinfo-ttl ttl))))) + + (parameterize ((%public-key public-key) + (%private-key private-key)) + (format #t (_ "publishing ~a on ~a, port ~d~%") + %store-directory + (inet-ntop (sockaddr:fam address) (sockaddr:addr address)) + (sockaddr:port address)) + (when repl-port + (repl:spawn-server (repl:make-tcp-server-socket #:port repl-port))) + (with-store store + (run-publish-server socket store + #:compression compression + #:narinfo-ttl ttl)))))) -- cgit v1.2.3 From 46f58390cb5a01d6cb59070e8e76e9a78e9b933e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 22 Mar 2017 11:26:05 +0100 Subject: publish: Add '--public-key' and '--private-key'. * guix/scripts/publish.scm (show-help, %options): Add --public-key and --private-key. * doc/guix.texi (Invoking guix publish): Document it. --- doc/guix.texi | 12 ++++++++++++ guix/scripts/publish.scm | 10 ++++++++++ 2 files changed, 22 insertions(+) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 8d27dd2031..6c4e1800c1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6523,6 +6523,18 @@ This allows the user's Guix to keep substitute information in cache for guarantee that the store items it provides will indeed remain available for as long as @var{ttl}. +@item --public-key=@var{file} +@itemx --private-key=@var{file} +Use the specific @var{file}s as the public/private key pair used to sign +the store items being published. + +The files must correspond to the same key pair (the private key is used +for signing and the public key is merely advertised in the signature +metadata). They must contain keys in the canonical s-expression format +as produced by @command{guix archive --generate-key} (@pxref{Invoking +guix archive}). By default, @file{/etc/guix/signing-key.pub} and +@file{/etc/guix/signing-key.sec} are used. + @item --repl[=@var{port}] @itemx -r [@var{port}] Spawn a Guile REPL server (@pxref{REPL Servers,,, guile, GNU Guile diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 57eea792b6..5a5ef68422 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -71,6 +71,10 @@ Publish ~a over HTTP.\n") %store-directory) compress archives at LEVEL")) (display (_ " --ttl=TTL announce narinfos can be cached for TTL seconds")) + (display (_ " + --public-key=FILE use FILE as the public key for signatures")) + (display (_ " + --private-key=FILE use FILE as the private key for signatures")) (display (_ " -r, --repl[=PORT] spawn REPL server on PORT")) (newline) @@ -148,6 +152,12 @@ compression disabled~%")) (leave (_ "~a: invalid duration~%") arg)) (alist-cons 'narinfo-ttl (time-second duration) result)))) + (option '("public-key") #t #f + (lambda (opt name arg result) + (alist-cons 'public-key-file arg result))) + (option '("private-key" "secret-key") #t #f + (lambda (opt name arg result) + (alist-cons 'private-key-file arg result))) (option '(#\r "repl") #f #t (lambda (opt name arg result) ;; If port unspecified, use default Guile REPL port. -- cgit v1.2.3 From cdd7a7d2106d295ca10fc23a94b6e9d1c8b5a82a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 22 Mar 2017 13:31:54 +0100 Subject: publish: Make the nar URL prefix a parameter. * guix/scripts/publish.scm (narinfo-string): Add #:nar-path and honor it. (render-narinfo): Likewise. (make-request-handler): Likewise. (run-publish-server): Likewise. * tests/publish.scm ("custom nar path"): New test. --- guix/scripts/publish.scm | 54 ++++++++++++++++++++++++++++++------------------ tests/publish.scm | 30 +++++++++++++++++++++++++++ 2 files changed, 64 insertions(+), 20 deletions(-) (limited to 'guix') diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 5a5ef68422..ba5be04818 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -204,16 +204,17 @@ compression disabled~%")) (compose base64-encode string->utf8)) (define* (narinfo-string store store-path key - #:key (compression %no-compression)) + #:key (compression %no-compression) + (nar-path "nar")) "Generate a narinfo key/value string for STORE-PATH; an exception is raised if STORE-PATH is invalid. Produce a URL that corresponds to COMPRESSION. The -narinfo is signed with KEY." +narinfo is signed with KEY. NAR-PATH specifies the prefix for nar URLs." (let* ((path-info (query-path-info store store-path)) (compression (if (compressed-file? store-path) %no-compression compression)) (url (encode-and-join-uri-path - `("nar" + `(,@(split-and-decode-uri-path nar-path) ,@(match compression (($ 'none) '()) @@ -275,11 +276,12 @@ References: ~a~%" %nix-cache-info)))) (define* (render-narinfo store request hash - #:key ttl (compression %no-compression)) + #:key ttl (compression %no-compression) + (nar-path "nar")) "Render metadata for the store path corresponding to HASH. If TTL is true, advertise it as the maximum validity period (in seconds) via the 'Cache-Control' header. This allows 'guix substitute' to cache it for an -appropriate duration." +appropriate duration. NAR-PATH specifies the prefix for nar URLs." (let ((store-path (hash-part->path store hash))) (if (string-null? store-path) (not-found request) @@ -289,6 +291,7 @@ appropriate duration." '())) (cut display (narinfo-string store store-path (%private-key) + #:nar-path nar-path #:compression compression) <>))))) @@ -478,7 +481,12 @@ blocking." (define* (make-request-handler store #:key narinfo-ttl + (nar-path "nar") (compression %no-compression)) + (define nar-path? + (let ((expected (split-and-decode-uri-path nar-path))) + (cut equal? expected <>))) + (lambda (request body) (format #t "~a ~a~%" (request-method request) @@ -494,19 +502,23 @@ blocking." ;; NARINFO-TTL. (render-narinfo store request hash #:ttl narinfo-ttl + #:nar-path nar-path #:compression compression)) + ;; /nar/file/NAME/sha256/HASH + (("file" name "sha256" hash) + (guard (c ((invalid-base32-character? c) + (not-found request))) + (let ((hash (nix-base32-string->bytevector hash))) + (render-content-addressed-file store request + name 'sha256 hash)))) ;; Use different URLs depending on the compression type. This ;; guarantees that /nar URLs remain valid even when 'guix publish' ;; is restarted with different compression parameters. - ;; /nar/ - (("nar" store-item) - (render-nar store request store-item - #:compression %no-compression)) ;; /nar/gzip/ - (("nar" "gzip" store-item) - (if (zlib-available?) + ((components ... "gzip" store-item) + (if (and (nar-path? components) (zlib-available?)) (render-nar store request store-item #:compression (match compression @@ -516,19 +528,21 @@ blocking." %default-gzip-compression))) (not-found request))) - ;; /nar/file/NAME/sha256/HASH - (("file" name "sha256" hash) - (guard (c ((invalid-base32-character? c) - (not-found request))) - (let ((hash (nix-base32-string->bytevector hash))) - (render-content-addressed-file store request - name 'sha256 hash)))) - (_ (not-found request))) + ;; /nar/ + ((components ... store-item) + (if (nar-path? components) + (render-nar store request store-item + #:compression %no-compression) + (not-found request))) + + (x (not-found request))) (not-found request)))) (define* (run-publish-server socket store - #:key (compression %no-compression) narinfo-ttl) + #:key (compression %no-compression) + (nar-path "nar") narinfo-ttl) (run-server (make-request-handler store + #:nar-path nar-path #:narinfo-ttl narinfo-ttl #:compression compression) concurrent-http-server diff --git a/tests/publish.scm b/tests/publish.scm index c0a0f72d9b..ea0f4a3477 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -232,6 +232,36 @@ References: ~%" (list (assoc-ref info "Compression") (dirname (assoc-ref info "URL"))))) +(test-equal "custom nar path" + ;; Serve nars at /foo/bar/chbouib instead of /nar. + (list `(("StorePath" . ,%item) + ("URL" . ,(string-append "foo/bar/chbouib/" (basename %item))) + ("Compression" . "none")) + 200 + 404) + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6798" "-C0" + "--nar-path=///foo/bar//chbouib/")))))) + (wait-until-ready 6798) + (let* ((base "http://localhost:6798/") + (part (store-path-hash-part %item)) + (url (string-append base part ".narinfo")) + (nar-url (string-append base "foo/bar/chbouib/" + (basename %item))) + (body (http-get-port url))) + (list (filter (lambda (item) + (match item + (("Compression" . _) #t) + (("StorePath" . _) #t) + (("URL" . _) #t) + (_ #f))) + (recutils->alist body)) + (response-code (http-get nar-url)) + (response-code + (http-get (string-append base "nar/" (basename %item)))))))) + (test-equal "/nar/ with properly encoded '+' sign" "Congrats!" (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))) -- cgit v1.2.3 From 4bb5e0aeb3b7f5396dff1fcd2b85b65af5e07038 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 22 Mar 2017 14:00:06 +0100 Subject: publish: Add '--nar-path'. * guix/scripts/publish.scm (show-help, %options): Add '--nar-path'. (%default-options): Add 'nar-path'. (guix-publish): Honor it. --- doc/guix.texi | 8 ++++++++ guix/scripts/publish.scm | 10 ++++++++++ 2 files changed, 18 insertions(+) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 6c4e1800c1..b57e219562 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6523,6 +6523,14 @@ This allows the user's Guix to keep substitute information in cache for guarantee that the store items it provides will indeed remain available for as long as @var{ttl}. +@item --nar-path=@var{path} +Use @var{path} as the prefix for the URLs of ``nar'' files +(@pxref{Invoking guix archive, normalized archives}). + +By default, nars are served at a URL such as +@code{/nar/gzip/@dots{}-coreutils-8.25}. This option allows you to +change the @code{/nar} part to @var{path}. + @item --public-key=@var{file} @itemx --private-key=@var{file} Use the specific @var{file}s as the public/private key pair used to sign diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index ba5be04818..d8ac72f4ef 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -71,6 +71,8 @@ Publish ~a over HTTP.\n") %store-directory) compress archives at LEVEL")) (display (_ " --ttl=TTL announce narinfos can be cached for TTL seconds")) + (display (_ " + --nar-path=PATH use PATH as the prefix for nar URLs")) (display (_ " --public-key=FILE use FILE as the public key for signatures")) (display (_ " @@ -152,6 +154,9 @@ compression disabled~%")) (leave (_ "~a: invalid duration~%") arg)) (alist-cons 'narinfo-ttl (time-second duration) result)))) + (option '("nar-path") #t #f + (lambda (opt name arg result) + (alist-cons 'nar-path arg result))) (option '("public-key") #t #f (lambda (opt name arg result) (alist-cons 'public-key-file arg result))) @@ -167,6 +172,9 @@ compression disabled~%")) (define %default-options `((port . 8080) + ;; By default, serve nars under "/nar". + (nar-path . "nar") + (public-key-file . ,%public-key-file) (private-key-file . ,%private-key-file) @@ -589,6 +597,7 @@ blocking." (sockaddr:addr addr) port))) (socket (open-server-socket address)) + (nar-path (assoc-ref opts 'nar-path)) (repl-port (assoc-ref opts 'repl)) ;; Read the key right away so that (1) we fail early on if we can't @@ -615,5 +624,6 @@ consider using the '--user' option!~%"))) (repl:spawn-server (repl:make-tcp-server-socket #:port repl-port))) (with-store store (run-publish-server socket store + #:nar-path nar-path #:compression compression #:narinfo-ttl ttl)))))) -- cgit v1.2.3