aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/pk-crypto.scm8
-rw-r--r--guix/scripts/publish.scm63
-rw-r--r--tests/publish.scm5
3 files changed, 46 insertions, 30 deletions
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 <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.
;;;
@@ -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))))))
diff --git a/tests/publish.scm b/tests/publish.scm
index 0fd3b50ecb..c0a0f72d9b 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -33,6 +33,7 @@
#:use-module ((guix records) #:select (recutils->alist))
#:use-module ((guix serialization) #:select (restore-file))
#:use-module (guix pk-crypto)
+ #:use-module ((guix pki) #:select (%public-key-file %private-key-file))
#:use-module (guix zlib)
#:use-module (web uri)
#:use-module (web client)
@@ -100,6 +101,10 @@
;; Wait until the two servers are ready.
(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")