nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
master
Ludovic Courtès 2017-03-22 09:50:06 +01:00
parent 5cd074ea32
commit ab2a74e4db
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 46 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
guix/pk-crypto.scm
View File

@ -23,11 +23,13 @@
#:use-module (system foreign) #:use-module (system foreign)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:export (canonical-sexp? #:export (canonical-sexp?
error-source error-source
error-string error-string
string->canonical-sexp string->canonical-sexp
canonical-sexp->string canonical-sexp->string
read-file-sexp
number->canonical-sexp number->canonical-sexp
canonical-sexp-car canonical-sexp-car
canonical-sexp-cdr canonical-sexp-cdr
@ -143,6 +145,12 @@ thrown along with 'gcry-error'."
(loop (* len 2)) (loop (* len 2))
(pointer->string buf size "ISO-8859-1"))))))) (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 (define canonical-sexp-car
(let* ((ptr (libgcrypt-func "gcry_sexp_car")) (let* ((ptr (libgcrypt-func "gcry_sexp_car"))
(proc (pointer->procedure '* ptr '(*)))) (proc (pointer->procedure '* ptr '(*))))

63
guix/scripts/publish.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -52,7 +52,10 @@
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module ((guix utils) #:select (compressed-file?)) #:use-module ((guix utils) #:select (compressed-file?))
#:use-module ((guix build utils) #:select (dump-port)) #:use-module ((guix build utils) #:select (dump-port))
#:export (guix-publish)) #:export (%public-key
%private-key
guix-publish))
(define (show-help) (define (show-help)
(format #t (_ "Usage: guix publish [OPTION]... (format #t (_ "Usage: guix publish [OPTION]...
@ -154,6 +157,9 @@ compression disabled~%"))
(define %default-options (define %default-options
`((port . 8080) `((port . 8080)
(public-key-file . ,%public-key-file)
(private-key-file . ,%private-key-file)
;; Default to fast & low compression. ;; Default to fast & low compression.
(compression . ,(if (zlib-available?) (compression . ,(if (zlib-available?)
%default-gzip-compression %default-gzip-compression
@ -162,18 +168,11 @@ compression disabled~%"))
(address . ,(make-socket-address AF_INET INADDR_ANY 0)) (address . ,(make-socket-address AF_INET INADDR_ANY 0))
(repl . #f))) (repl . #f)))
(define (lazy-read-file-sexp file) ;; The key pair used to sign narinfos.
"Return a promise to read the canonical sexp from FILE."
(delay
(call-with-input-file file
(compose string->canonical-sexp
read-string))))
(define %private-key (define %private-key
(lazy-read-file-sexp %private-key-file)) (make-parameter #f))
(define %public-key (define %public-key
(lazy-read-file-sexp %public-key-file)) (make-parameter #f))
(define %nix-cache-info (define %nix-cache-info
`(("StoreDir" . ,%store-directory) `(("StoreDir" . ,%store-directory)
@ -186,10 +185,10 @@ compression disabled~%"))
(define (signed-string s) (define (signed-string s)
"Sign the hash of the string S with the daemon's key." "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)) (hash (bytevector->hash-data (sha256 (string->utf8 s))
#:key-type (key-type public-key)))) #: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 (define base64-encode-string
(compose base64-encode string->utf8)) (compose base64-encode string->utf8))
@ -279,7 +278,7 @@ appropriate duration."
`((cache-control (max-age . ,ttl))) `((cache-control (max-age . ,ttl)))
'())) '()))
(cut display (cut display
(narinfo-string store store-path (force %private-key) (narinfo-string store store-path (%private-key)
#:compression compression) #:compression compression)
<>))))) <>)))))
@ -566,11 +565,12 @@ blocking."
(sockaddr:addr addr) (sockaddr:addr addr)
port))) port)))
(socket (open-server-socket address)) (socket (open-server-socket address))
(repl-port (assoc-ref opts 'repl))) (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. ;; Read the key right away so that (1) we fail early on if we can't
(force %private-key) ;; access them, and (2) we can then drop privileges.
(force %public-key) (public-key (read-file-sexp (assoc-ref opts 'public-key-file)))
(private-key (read-file-sexp (assoc-ref opts 'private-key-file))))
(when user (when user
;; Now that we've read the key material and opened the socket, we can ;; Now that we've read the key material and opened the socket, we can
@ -580,13 +580,16 @@ blocking."
(when (zero? (getuid)) (when (zero? (getuid))
(warning (_ "server running as root; \ (warning (_ "server running as root; \
consider using the '--user' option!~%"))) consider using the '--user' option!~%")))
(format #t (_ "publishing ~a on ~a, port ~d~%")
%store-directory (parameterize ((%public-key public-key)
(inet-ntop (sockaddr:fam address) (sockaddr:addr address)) (%private-key private-key))
(sockaddr:port address)) (format #t (_ "publishing ~a on ~a, port ~d~%")
(when repl-port %store-directory
(repl:spawn-server (repl:make-tcp-server-socket #:port repl-port))) (inet-ntop (sockaddr:fam address) (sockaddr:addr address))
(with-store store (sockaddr:port address))
(run-publish-server socket store (when repl-port
#:compression compression (repl:spawn-server (repl:make-tcp-server-socket #:port repl-port)))
#:narinfo-ttl ttl))))) (with-store store
(run-publish-server socket store
#:compression compression
#:narinfo-ttl ttl))))))

5
tests/publish.scm
View File

@ -33,6 +33,7 @@
#:use-module ((guix records) #:select (recutils->alist)) #:use-module ((guix records) #:select (recutils->alist))
#:use-module ((guix serialization) #:select (restore-file)) #:use-module ((guix serialization) #:select (restore-file))
#:use-module (guix pk-crypto) #:use-module (guix pk-crypto)
#:use-module ((guix pki) #:select (%public-key-file %private-key-file))
#:use-module (guix zlib) #:use-module (guix zlib)
#:use-module (web uri) #:use-module (web uri)
#:use-module (web client) #:use-module (web client)
@ -100,6 +101,10 @@
;; Wait until the two servers are ready. ;; Wait until the two servers are ready.
(wait-until-ready 6789) (wait-until-ready 6789)
;; Initialize the public/private key SRFI-39 parameters.
(%public-key (read-file-sexp %public-key-file))
(%private-key (read-file-sexp %private-key-file))
(test-begin "publish") (test-begin "publish")