daemon: Implement signed archive import/export.

* guix/scripts/authenticate.scm, nix/scripts/guix-authenticate.in,
  tests/signing-key.pub, tests/signing-key.sec: New files.
* po/POTFILES.in: Add 'guix/scripts/authenticate.scm'.
* guix/store.scm (dump-port): New procedure.
  (process-stderr): Add 'user-port' optional parameter.  Handle
  the %STDERR-WRITE and %STDERR-READ cases as expected.
  (import-paths, export-path, export-paths): New procedures.
* tests/store.scm ("export/import several paths", "import corrupt
  path"): New tests.
* Makefile.am (MODULES): Add 'guix/scripts/authenticate.scm'.
  (EXTRA_DIST): Add 'tests/signing-key.{pub,sec}'.
* daemon.am (libstore_a_CPPFLAGS)[-DNIX_CONF_DIR]: Change 'NIX_CONF_DIR'
  to .../guix.  Change 'OPENSSL_PATH' to 'guix-authenticate'.
* config-daemon.ac: Instantiate 'nix/scripts/guix-authenticate'.
* nix/nix-daemon/guix-daemon.cc (main): Augment $PATH to include
  'settings.nixLibexecDir'.
* test-env.in: Export 'NIX_CONF_DIR' and 'NIX_LIBEXEC_DIR'.  Populate
  $NIX_CONF_DIR.
This commit is contained in:
Ludovic Courtès 2013-12-20 17:17:42 +01:00
parent ce507041f7
commit 526382ff92
13 changed files with 273 additions and 7 deletions

1
.gitignore vendored
View File

@ -84,3 +84,4 @@ GPATH
GRTAGS GRTAGS
GTAGS GTAGS
/nix-setuid-helper /nix-setuid-helper
/nix/scripts/guix-authenticate

View File

@ -73,6 +73,7 @@ MODULES = \
guix/scripts/hash.scm \ guix/scripts/hash.scm \
guix/scripts/pull.scm \ guix/scripts/pull.scm \
guix/scripts/substitute-binary.scm \ guix/scripts/substitute-binary.scm \
guix/scripts/authenticate.scm \
guix/scripts/refresh.scm \ guix/scripts/refresh.scm \
guix.scm \ guix.scm \
$(GNU_SYSTEM_MODULES) $(GNU_SYSTEM_MODULES)
@ -172,6 +173,8 @@ EXTRA_DIST = \
srfi/srfi-64.scm \ srfi/srfi-64.scm \
srfi/srfi-64.upstream.scm \ srfi/srfi-64.upstream.scm \
tests/test.drv \ tests/test.drv \
tests/signing-key.pub \
tests/signing-key.sec \
build-aux/config.rpath \ build-aux/config.rpath \
bootstrap \ bootstrap \
release.nix \ release.nix \

View File

@ -105,6 +105,8 @@ if test "x$guix_build_daemon" = "xyes"; then
[chmod +x nix/scripts/list-runtime-roots]) [chmod +x nix/scripts/list-runtime-roots])
AC_CONFIG_FILES([nix/scripts/substitute-binary], AC_CONFIG_FILES([nix/scripts/substitute-binary],
[chmod +x nix/scripts/substitute-binary]) [chmod +x nix/scripts/substitute-binary])
AC_CONFIG_FILES([nix/scripts/guix-authenticate],
[chmod +x nix/scripts/guix-authenticate])
fi fi
AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"]) AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"])

View File

@ -112,10 +112,10 @@ libstore_a_CPPFLAGS = \
-DNIX_DATA_DIR=\"$(datadir)\" \ -DNIX_DATA_DIR=\"$(datadir)\" \
-DNIX_STATE_DIR=\"$(localstatedir)/nix\" \ -DNIX_STATE_DIR=\"$(localstatedir)/nix\" \
-DNIX_LOG_DIR=\"$(localstatedir)/log/nix\" \ -DNIX_LOG_DIR=\"$(localstatedir)/log/nix\" \
-DNIX_CONF_DIR=\"$(sysconfdir)/nix\" \ -DNIX_CONF_DIR=\"$(sysconfdir)/guix\" \
-DNIX_LIBEXEC_DIR=\"$(libexecdir)\" \ -DNIX_LIBEXEC_DIR=\"$(libexecdir)\" \
-DNIX_BIN_DIR=\"$(bindir)\" \ -DNIX_BIN_DIR=\"$(bindir)\" \
-DOPENSSL_PATH="\"openssl\"" -DOPENSSL_PATH="\"guix-authenticate\""
libstore_a_CXXFLAGS = \ libstore_a_CXXFLAGS = \
$(SQLITE3_CFLAGS) $(LIBGCRYPT_CFLAGS) $(SQLITE3_CFLAGS) $(LIBGCRYPT_CFLAGS)

View File

@ -0,0 +1,98 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts authenticate)
#:use-module (guix config)
#:use-module (guix utils)
#:use-module (guix pk-crypto)
#:use-module (guix ui)
#:use-module (rnrs io ports)
#:use-module (ice-9 match)
#:export (guix-authenticate))
;;; Commentary:
;;;
;;; This program is used internally by the daemon to sign exported archive
;;; (the 'export-paths' RPC), and to authenticate imported archives (the
;;; 'import-paths' RPC.)
;;;
;;; Code:
(define (read-gcry-sexp file)
"Read a gcrypt sexp from FILE and return it."
(call-with-input-file file
(compose string->gcry-sexp get-string-all)))
(define (read-hash-data file)
"Read sha256 hash data from FILE and return it as a gcrypt sexp."
(let* ((hex (call-with-input-file file get-string-all))
(bv (base16-string->bytevector (string-trim-both hex))))
(bytevector->hash-data bv)))
;;;
;;; Entry point with 'openssl'-compatible interface. We support this
;;; interface because that's what the daemon expects, and we want to leave it
;;; unmodified currently.
;;;
(define (guix-authenticate . args)
(match args
(("rsautl" "-sign" "-inkey" key "-in" hash-file)
;; Sign the hash in HASH-FILE with KEY, and return an sexp that includes
;; both the hash and the actual signature.
(let* ((secret-key (read-gcry-sexp key))
(data (read-hash-data hash-file)))
(format #t
"(guix-signature ~a (payload ~a))"
(gcry-sexp->string (sign data secret-key))
(gcry-sexp->string data))
#t))
(("rsautl" "-verify" "-inkey" key "-pubin" "-in" signature-file)
;; Read the signature as produced above, check it against KEY, and print
;; the signed data to stdout upon success.
(let* ((public-key (read-gcry-sexp key))
(sig+data (read-gcry-sexp signature-file))
(data (find-sexp-token sig+data 'payload))
(signature (find-sexp-token sig+data 'sig-val)))
(if (and data signature)
(if (verify signature data public-key)
(begin
(display (bytevector->base16-string
(hash-data->bytevector data)))
#t) ; success
(begin
(format (current-error-port)
"error: invalid signature: ~a~%"
(gcry-sexp->string signature))
(exit 1)))
(begin
(format (current-error-port)
"error: corrupt signature data: ~a~%"
(gcry-sexp->string sig+data))
(exit 1)))))
(("--help")
(display (_ "Usage: guix authenticate OPTION...
Sign or verify the signature on the given file. This tool is meant to
be used internally by 'guix-daemon'.\n")))
(("--version")
(show-version-and-exit "guix authenticate"))
(else
(leave (_ "wrong arguments")))))
;;; authenticate.scm ends here

View File

@ -80,6 +80,8 @@
dead-paths dead-paths
collect-garbage collect-garbage
delete-paths delete-paths
import-paths
export-paths
current-build-output-port current-build-output-port
@ -323,7 +325,30 @@ operate, should the disk become full. Return a server object."
;; The port where build output is sent. ;; The port where build output is sent.
(make-parameter (current-error-port))) (make-parameter (current-error-port)))
(define (process-stderr server) (define* (dump-port in out
#:optional len
#:key (buffer-size 16384))
"Read LEN bytes from IN (or as much as possible if LEN is #f) and write it
to OUT, using chunks of BUFFER-SIZE bytes."
(define buffer
(make-bytevector buffer-size))
(let loop ((total 0)
(bytes (get-bytevector-n! in buffer 0
(if len
(min len buffer-size)
buffer-size))))
(or (eof-object? bytes)
(and len (= total len))
(let ((total (+ total bytes)))
(put-bytevector out buffer 0 bytes)
(loop total
(get-bytevector-n! in buffer 0
(if len
(min (- len total) buffer-size)
buffer-size)))))))
(define* (process-stderr server #:optional user-port)
"Read standard output and standard error from SERVER, writing it to "Read standard output and standard error from SERVER, writing it to
CURRENT-BUILD-OUTPUT-PORT. Return #t when SERVER is done sending data, and CURRENT-BUILD-OUTPUT-PORT. Return #t when SERVER is done sending data, and
#f otherwise; in the latter case, the caller should call `process-stderr' #f otherwise; in the latter case, the caller should call `process-stderr'
@ -344,17 +369,30 @@ encoding conversion errors."
(let ((k (read-int p))) (let ((k (read-int p)))
(cond ((= k %stderr-write) (cond ((= k %stderr-write)
(read-latin1-string p) ;; Write a byte stream to USER-PORT.
(let* ((len (read-int p))
(m (modulo len 8)))
(dump-port p user-port len)
(unless (zero? m)
;; Consume padding, as for strings.
(get-bytevector-n p (- 8 m))))
#f) #f)
((= k %stderr-read) ((= k %stderr-read)
(let ((len (read-int p))) ;; Read a byte stream from USER-PORT.
(read-latin1-string p) ; FIXME: what to do? (let* ((max-len (read-int p))
(data (get-bytevector-n user-port max-len))
(len (bytevector-length data)))
(write-int len p)
(put-bytevector p data)
(write-padding len p)
#f)) #f))
((= k %stderr-next) ((= k %stderr-next)
;; Log a string.
(let ((s (read-latin1-string p))) (let ((s (read-latin1-string p)))
(display s (current-build-output-port)) (display s (current-build-output-port))
#f)) #f))
((= k %stderr-error) ((= k %stderr-error)
;; Report an error.
(let ((error (read-latin1-string p)) (let ((error (read-latin1-string p))
;; Currently the daemon fails to send a status code for early ;; Currently the daemon fails to send a status code for early
;; errors like DB schema version mismatches, so check for EOF. ;; errors like DB schema version mismatches, so check for EOF.
@ -624,6 +662,39 @@ MIN-FREED bytes have been collected. Return the paths that were
collected, and the number of bytes freed." collected, and the number of bytes freed."
(run-gc server (gc-action delete-specific) paths min-freed)) (run-gc server (gc-action delete-specific) paths min-freed))
(define (import-paths server port)
"Import the set of store paths read from PORT into SERVER's store. An error
is raised if the set of paths read from PORT is not signed (as per
'export-path #:sign? #t'.) Return the list of store paths imported."
(let ((s (nix-server-socket server)))
(write-int (operation-id import-paths) s)
(let loop ((done? (process-stderr server port)))
(or done? (loop (process-stderr server port))))
(read-store-path-list s)))
(define* (export-path server path port #:key (sign? #t))
"Export PATH to PORT. When SIGN? is true, sign it."
(let ((s (nix-server-socket server)))
(write-int (operation-id export-path) s)
(write-store-path path s)
(write-arg boolean sign? s)
(let loop ((done? (process-stderr server port)))
(or done? (loop (process-stderr server port))))
(= 1 (read-int s))))
(define* (export-paths server paths port #:key (sign? #t))
"Export the store paths listed in PATHS to PORT, signing them if SIGN?
is true."
(let ((s (nix-server-socket server)))
(let loop ((paths paths))
(match paths
(()
(write-int 0 port))
((head tail ...)
(write-int 1 port)
(and (export-path server head port #:sign? sign?)
(loop tail)))))))
;;; ;;;
;;; Store paths. ;;; Store paths.

View File

@ -216,6 +216,12 @@ main (int argc, char *argv[])
{ {
settings.processEnvironment (); settings.processEnvironment ();
/* Hackily help 'local-store.cc' find our 'guix-authenticate' program, which
is known as 'OPENSSL_PATH' here. */
std::string search_path (getenv ("PATH"));
search_path = settings.nixLibexecDir + ":" + search_path;
setenv ("PATH", search_path.c_str (), 1);
/* Use our substituter by default. */ /* Use our substituter by default. */
settings.substituters.clear (); settings.substituters.clear ();
settings.useSubstitutes = true; settings.useSubstitutes = true;

View File

@ -0,0 +1,11 @@
#!@SHELL@
# A shorthand for "guix authenticate", for use by the daemon.
if test "x$GUIX_UNINSTALLED" = "x"
then
prefix="@prefix@"
exec_prefix="@exec_prefix@"
exec "@bindir@/guix" authenticate "$@"
else
exec guix authenticate "$@"
fi

View File

@ -11,6 +11,7 @@ guix/scripts/gc.scm
guix/scripts/hash.scm guix/scripts/hash.scm
guix/scripts/pull.scm guix/scripts/pull.scm
guix/scripts/substitute-binary.scm guix/scripts/substitute-binary.scm
guix/scripts/authenticate.scm
guix/gnu-maintenance.scm guix/gnu-maintenance.scm
guix/ui.scm guix/ui.scm
guix/http-client.scm guix/http-client.scm

View File

@ -40,6 +40,22 @@ then
# Currently, in Nix builds, we're at ~106 chars... # Currently, in Nix builds, we're at ~106 chars...
NIX_STATE_DIR="@GUIX_TEST_ROOT@/var/$$" NIX_STATE_DIR="@GUIX_TEST_ROOT@/var/$$"
# The configuration directory, for import/export signing keys.
NIX_CONF_DIR="@GUIX_TEST_ROOT@/etc"
if [ ! -d "$NIX_CONF_DIR" ]
then
# Copy the keys so that the secret key has the right permissions (the
# daemon errors out when this is not the case.)
mkdir -p "$NIX_CONF_DIR"
cp "@abs_top_srcdir@/tests/signing-key.sec" \
"@abs_top_srcdir@/tests/signing-key.pub" \
"$NIX_CONF_DIR"
chmod 400 "$NIX_CONF_DIR/signing-key.sec"
fi
# For 'guix-authenticate'.
NIX_LIBEXEC_DIR="@abs_top_builddir@/nix/scripts"
# A place to store data of the substituter. # A place to store data of the substituter.
GUIX_BINARY_SUBSTITUTE_URL="file://$NIX_STATE_DIR/substituter-data" GUIX_BINARY_SUBSTITUTE_URL="file://$NIX_STATE_DIR/substituter-data"
rm -rf "$NIX_STATE_DIR/substituter-data" rm -rf "$NIX_STATE_DIR/substituter-data"
@ -51,7 +67,7 @@ then
export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR \ export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR \
NIX_LOCALSTATE_DIR NIX_LOG_DIR NIX_STATE_DIR NIX_DB_DIR \ NIX_LOCALSTATE_DIR NIX_LOG_DIR NIX_STATE_DIR NIX_DB_DIR \
NIX_ROOT_FINDER NIX_SETUID_HELPER GUIX_BINARY_SUBSTITUTE_URL \ NIX_ROOT_FINDER NIX_SETUID_HELPER GUIX_BINARY_SUBSTITUTE_URL \
XDG_CACHE_HOME NIX_CONF_DIR NIX_LIBEXEC_DIR XDG_CACHE_HOME
# Do that because store.scm calls `canonicalize-path' on it. # Do that because store.scm calls `canonicalize-path' on it.
mkdir -p "$NIX_STORE_DIR" mkdir -p "$NIX_STORE_DIR"

4
tests/signing-key.pub Normal file
View File

@ -0,0 +1,4 @@
(public-key
(rsa
(n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#)
(e #010001#)))

8
tests/signing-key.sec Normal file
View File

@ -0,0 +1,8 @@
(private-key
(rsa
(n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#)
(e #010001#)
(d #58CAD84653D0046A8EC3F9AA82D9C829B145422109FC3F12DA01A694B92FA296E70D366FB166454D30E632CEE3A033B4C41781BA10325F69FCDC0250CA19C8EEB352FA085992494098DB133E682ED38A931701F0DED1A1E508F4341A4FB446A04F019427C7CB3C44F251EEA9D386100DA80F125E0FD5CE1B0DFEC6D21516EACD#)
(p #00D47F185147EC39393CCDA4E7323FFC20FC8B8073E2A54DD63BA392A66975E4204CA48572496A9DFD7522436B852C07472A5AB25B7706F7C14E6F33FBC420FF3B#)
(q #00E9AD22F158060BC9AE3601DA623AFC60FFF3058795802CA92371C00097335CF9A23D7782DE353C9DBA93D7BB99E6A24A411107605E722481C5C191F80D7EB77F#)
(u #59B45B95AE01A7A7370FAFDB08FE73A4793CE37F228961B09B1B1E7DDAD9F8D3E28F5C5E8B4B067E6B8E0BBF3F690B42991A79E46108DDCDA2514323A66964DE#)))

View File

@ -28,10 +28,12 @@
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (web uri) #:use-module (web uri)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)) #:use-module (srfi srfi-64))
@ -344,6 +346,49 @@ Deriver: ~a~%"
(build-derivations s (list d)) (build-derivations s (list d))
#f)))) #f))))
(test-assert "export/import several paths"
(let* ((texts (unfold (cut >= <> 10)
(lambda _ (random-text))
1+
0))
(files (map (cut add-text-to-store %store "text" <>) texts))
(dump (call-with-bytevector-output-port
(cut export-paths %store files <>))))
(delete-paths %store files)
(and (every (negate file-exists?) files)
(let* ((source (open-bytevector-input-port dump))
(imported (import-paths %store source)))
(and (equal? imported files)
(every file-exists? files)
(equal? texts
(map (lambda (file)
(call-with-input-file file
get-string-all))
files)))))))
(test-assert "import corrupt path"
(let* ((text (random-text))
(file (add-text-to-store %store "text" text))
(dump (call-with-bytevector-output-port
(cut export-paths %store (list file) <>))))
(delete-paths %store (list file))
;; Flip a bit in the middle of the stream.
(let* ((index (quotient (bytevector-length dump) 3))
(byte (bytevector-u8-ref dump index)))
(bytevector-u8-set! dump index (logxor #xff byte)))
(and (not (file-exists? file))
(guard (c ((nix-protocol-error? c)
(pk 'c c)
(and (not (zero? (nix-protocol-error-status c)))
(string-contains (nix-protocol-error-message c)
"corrupt"))))
(let* ((source (open-bytevector-input-port dump))
(imported (import-paths %store source)))
(pk 'corrupt-imported imported)
#f)))))
(test-end "store") (test-end "store")