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'.
This commit is contained in:
Ludovic Courtès
parent
dedb5d947e
commit
554f26ece3
@ -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:
|
||||
|
||||
@ -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))))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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~%")))))))))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user