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:
		
							parent
							
								
									dedb5d947e
								
							
						
					
					
						commit
						554f26ece3
					
				
					 4 changed files with 108 additions and 10 deletions
				
			
		| 
						 | 
				
			
			@ -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~%")))))))))))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue