From 554f26ece3c6e3fb04d8069e6be1095e622a97c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 30 Dec 2013 22:46:21 +0100 Subject: archive: Add '--generate-key'. * guix/pk-crypto.scm (error-source, error-string): New procedures. * guix/pki.scm (%private-key-file): New variable. * guix/scripts/archive.scm (show-help): Document '--generate-key'. (%options): Add "generate-key". (generate-key-pair): New procedure. (guix-archive): Call 'generate-key' when OPTS contains a 'generate-key' pair. * doc/guix.texi (Setting Up the Daemon): Suggest generating a key pair. (Invoking guix archive): Document '--generate-key'. --- doc/guix.texi | 22 ++++++++++++++ guix/pk-crypto.scm | 18 ++++++++++++ guix/pki.scm | 4 +++ guix/scripts/archive.scm | 74 +++++++++++++++++++++++++++++++++++++++++------- 4 files changed, 108 insertions(+), 10 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index afa7654d54..ec529346c7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -237,6 +237,14 @@ case, shared memory support is unavailable in the chroot environment. The workaround is to make sure that @file{/dev/shm} is directly a @code{tmpfs} mount point.}. +Finally, you may want to generate a key pair to allow the daemon to +export signed archives of files from the store (@pxref{Invoking guix +archive}): + +@example +# guix archive --generate-key +@end example + Guix may also be used in a single-user setup, with @command{guix-daemon} running as an unprivileged user. However, to maximize non-interference of build processes, the daemon still needs to perform certain operations @@ -948,6 +956,20 @@ resulting archive to the standard output. Read an archive from the standard input, and import the files listed therein into the store. Abort if the archive has an invalid digital signature. + +@item --generate-key[=@var{parameters}] +Generate a new key pair for the daemons. This is a prerequisite before +archives can be exported with @code{--export}. Note that this operation +usually takes time, because it needs to gather enough entropy to +generate the key pair. + +The generated key pair is typically stored under @file{/etc/guix}, in +@file{signing-key.pub} (public key) and @file{signing-key.sec} (private +key, which must be kept secret.) When @var{parameters} is omitted, it +is a 4096-bit RSA key. Alternately, @var{parameters} can specify +@code{genkey} parameters suitable for Libgcrypt (@pxref{General +public-key related Functions, @code{gcry_pk_genkey},, gcrypt, The +Libgcrypt Reference Manual}). @end table To export store files as an archive to the standard output, run: diff --git a/guix/pk-crypto.scm b/guix/pk-crypto.scm index d5b3eeb350..50f709418c 100644 --- a/guix/pk-crypto.scm +++ b/guix/pk-crypto.scm @@ -25,6 +25,8 @@ #:use-module (rnrs bytevectors) #:use-module (ice-9 match) #:export (canonical-sexp? + error-source + error-string string->canonical-sexp canonical-sexp->string number->canonical-sexp @@ -98,6 +100,22 @@ (set-pointer-finalizer! ptr finalize-canonical-sexp!)) sexp)) +(define error-source + (let* ((ptr (libgcrypt-func "gcry_strsource")) + (proc (pointer->procedure '* ptr (list int)))) + (lambda (err) + "Return the error source (a string) for ERR, an error code as thrown +along with 'gcry-error'." + (pointer->string (proc err))))) + +(define error-string + (let* ((ptr (libgcrypt-func "gcry_strerror")) + (proc (pointer->procedure '* ptr (list int)))) + (lambda (err) + "Return the error description (a string) for ERR, an error code as +thrown along with 'gcry-error'." + (pointer->string (proc err))))) + (define string->canonical-sexp (let* ((ptr (libgcrypt-func "gcry_sexp_new")) (proc (pointer->procedure int ptr `(* * ,size_t ,int)))) diff --git a/guix/pki.scm b/guix/pki.scm index 1ed84e55f0..759cd040e9 100644 --- a/guix/pki.scm +++ b/guix/pki.scm @@ -23,6 +23,7 @@ #:use-module (ice-9 match) #:use-module (rnrs io ports) #:export (%public-key-file + %private-key-file current-acl public-keys->acl acl->public-keys @@ -69,6 +70,9 @@ element in KEYS must be a canonical sexp with type 'public-key'." (define %public-key-file (string-append %config-directory "/signing-key.pub")) +(define %private-key-file + (string-append %config-directory "/signing-key.sec")) + (define (ensure-acl) "Make sure the ACL file exists, and create an initialized one if needed." (unless (file-exists? %acl-file) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index df538ed1b7..a9e4155393 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -23,6 +23,8 @@ #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix ui) + #:use-module (guix pki) + #:use-module (guix pk-crypto) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -52,6 +54,9 @@ Export/import one or more packages from/to the store.\n")) (display (_ " --import import from the archive passed on stdin")) (newline) + (display (_ " + --generate-key[=PARAMETERS] + generate a key pair with the given parameters")) (display (_ " -e, --expression=EXPR build the package or derivation EXPR evaluates to")) (display (_ " @@ -95,6 +100,17 @@ Export/import one or more packages from/to the store.\n")) (option '("import") #f #f (lambda (opt name arg result) (alist-cons 'import #t result))) + (option '("generate-key") #f #t + (lambda (opt name arg result) + (catch 'gcry-error + (lambda () + (let ((params + (string->canonical-sexp + (or arg "(genkey (rsa (nbits 4:4096)))")))) + (alist-cons 'generate-key params result))) + (lambda args + (leave (_ "invalid key generation parameters: ~s~%") + arg))))) (option '(#\S "source") #f #f (lambda (opt name arg result) @@ -204,7 +220,41 @@ resulting archive to the standard output port." (if (or (assoc-ref opts 'dry-run?) (build-derivations store drv)) (export-paths store files (current-output-port)) - (leave (_ "unable to export the given packages"))))) + (leave (_ "unable to export the given packages~%"))))) + +(define (generate-key-pair parameters) + "Generate a key pair with PARAMETERS, a canonical sexp, and store it in the +right place." + (when (or (file-exists? %public-key-file) + (file-exists? %private-key-file)) + (leave (_ "key pair exists under '~a'; remove it first~%") + (dirname %public-key-file))) + + (format (current-error-port) + (_ "Please wait while gathering entropy to generate the key pair; +this may take time...~%")) + + (let* ((pair (catch 'gcry-error + (lambda () + (generate-key parameters)) + (lambda (key err) + (leave (_ "key generation failed: ~a: ~a~%") + (error-source err) + (error-string err))))) + (public (find-sexp-token pair 'public-key)) + (secret (find-sexp-token pair 'private-key))) + ;; Create the following files as #o400. + (umask #o266) + + (with-atomic-file-output %public-key-file + (lambda (port) + (display (canonical-sexp->string public) port))) + (with-atomic-file-output %private-key-file + (lambda (port) + (display (canonical-sexp->string secret) port))) + + ;; Make the public key readable by everyone. + (chmod %public-key-file #o444))) (define (guix-archive . args) (define (parse-options) @@ -220,13 +270,17 @@ resulting archive to the standard output port." ;; Ask for absolute file names so that .drv file names passed from the ;; user to 'read-derivation' are absolute when it returns. (with-fluids ((%file-port-name-canonicalization 'absolute)) - (let* ((opts (parse-options)) - (store (open-connection))) - - (cond ((assoc-ref opts 'export) - (export-from-store store opts)) - ((assoc-ref opts 'import) - (import-paths store (current-input-port))) + (let ((opts (parse-options))) + (cond ((assoc-ref opts 'generate-key) + => + generate-key-pair) (else - (leave - (_ "either '--export' or '--import' must be specified")))))))) + (let ((store (open-connection))) + (cond ((assoc-ref opts 'export) + (export-from-store store opts)) + ((assoc-ref opts 'import) + (import-paths store (current-input-port))) + (else + (leave + (_ "either '--export' or '--import' \ +must be specified~%"))))))))))) -- cgit v1.2.3