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.
master
Ludovic Courtès
parent
ce507041f7
commit
526382ff92
|
|
@ -84,3 +84,4 @@ GPATH
|
|||
GRTAGS
|
||||
GTAGS
|
||||
/nix-setuid-helper
|
||||
/nix/scripts/guix-authenticate
|
||||
|
|
|
|||
|
|
@ -73,6 +73,7 @@ MODULES = \
|
|||
guix/scripts/hash.scm \
|
||||
guix/scripts/pull.scm \
|
||||
guix/scripts/substitute-binary.scm \
|
||||
guix/scripts/authenticate.scm \
|
||||
guix/scripts/refresh.scm \
|
||||
guix.scm \
|
||||
$(GNU_SYSTEM_MODULES)
|
||||
|
|
@ -172,6 +173,8 @@ EXTRA_DIST = \
|
|||
srfi/srfi-64.scm \
|
||||
srfi/srfi-64.upstream.scm \
|
||||
tests/test.drv \
|
||||
tests/signing-key.pub \
|
||||
tests/signing-key.sec \
|
||||
build-aux/config.rpath \
|
||||
bootstrap \
|
||||
release.nix \
|
||||
|
|
|
|||
|
|
@ -105,6 +105,8 @@ if test "x$guix_build_daemon" = "xyes"; then
|
|||
[chmod +x nix/scripts/list-runtime-roots])
|
||||
AC_CONFIG_FILES([nix/scripts/substitute-binary],
|
||||
[chmod +x nix/scripts/substitute-binary])
|
||||
AC_CONFIG_FILES([nix/scripts/guix-authenticate],
|
||||
[chmod +x nix/scripts/guix-authenticate])
|
||||
fi
|
||||
|
||||
AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"])
|
||||
|
|
|
|||
|
|
@ -112,10 +112,10 @@ libstore_a_CPPFLAGS = \
|
|||
-DNIX_DATA_DIR=\"$(datadir)\" \
|
||||
-DNIX_STATE_DIR=\"$(localstatedir)/nix\" \
|
||||
-DNIX_LOG_DIR=\"$(localstatedir)/log/nix\" \
|
||||
-DNIX_CONF_DIR=\"$(sysconfdir)/nix\" \
|
||||
-DNIX_CONF_DIR=\"$(sysconfdir)/guix\" \
|
||||
-DNIX_LIBEXEC_DIR=\"$(libexecdir)\" \
|
||||
-DNIX_BIN_DIR=\"$(bindir)\" \
|
||||
-DOPENSSL_PATH="\"openssl\""
|
||||
-DOPENSSL_PATH="\"guix-authenticate\""
|
||||
|
||||
libstore_a_CXXFLAGS = \
|
||||
$(SQLITE3_CFLAGS) $(LIBGCRYPT_CFLAGS)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -80,6 +80,8 @@
|
|||
dead-paths
|
||||
collect-garbage
|
||||
delete-paths
|
||||
import-paths
|
||||
export-paths
|
||||
|
||||
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.
|
||||
(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
|
||||
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'
|
||||
|
|
@ -344,17 +369,30 @@ encoding conversion errors."
|
|||
|
||||
(let ((k (read-int p)))
|
||||
(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)
|
||||
((= k %stderr-read)
|
||||
(let ((len (read-int p)))
|
||||
(read-latin1-string p) ; FIXME: what to do?
|
||||
;; Read a byte stream from USER-PORT.
|
||||
(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))
|
||||
((= k %stderr-next)
|
||||
;; Log a string.
|
||||
(let ((s (read-latin1-string p)))
|
||||
(display s (current-build-output-port))
|
||||
#f))
|
||||
((= k %stderr-error)
|
||||
;; Report an error.
|
||||
(let ((error (read-latin1-string p))
|
||||
;; Currently the daemon fails to send a status code for early
|
||||
;; 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."
|
||||
(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.
|
||||
|
|
|
|||
|
|
@ -216,6 +216,12 @@ main (int argc, char *argv[])
|
|||
{
|
||||
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. */
|
||||
settings.substituters.clear ();
|
||||
settings.useSubstitutes = true;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -11,6 +11,7 @@ guix/scripts/gc.scm
|
|||
guix/scripts/hash.scm
|
||||
guix/scripts/pull.scm
|
||||
guix/scripts/substitute-binary.scm
|
||||
guix/scripts/authenticate.scm
|
||||
guix/gnu-maintenance.scm
|
||||
guix/ui.scm
|
||||
guix/http-client.scm
|
||||
|
|
|
|||
18
test-env.in
18
test-env.in
|
|
@ -40,6 +40,22 @@ then
|
|||
# Currently, in Nix builds, we're at ~106 chars...
|
||||
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.
|
||||
GUIX_BINARY_SUBSTITUTE_URL="file://$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 \
|
||||
NIX_LOCALSTATE_DIR NIX_LOG_DIR NIX_STATE_DIR NIX_DB_DIR \
|
||||
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.
|
||||
mkdir -p "$NIX_STORE_DIR"
|
||||
|
|
|
|||
|
|
@ -0,0 +1,4 @@
|
|||
(public-key
|
||||
(rsa
|
||||
(n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#)
|
||||
(e #010001#)))
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
(private-key
|
||||
(rsa
|
||||
(n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#)
|
||||
(e #010001#)
|
||||
(d #58CAD84653D0046A8EC3F9AA82D9C829B145422109FC3F12DA01A694B92FA296E70D366FB166454D30E632CEE3A033B4C41781BA10325F69FCDC0250CA19C8EEB352FA085992494098DB133E682ED38A931701F0DED1A1E508F4341A4FB446A04F019427C7CB3C44F251EEA9D386100DA80F125E0FD5CE1B0DFEC6D21516EACD#)
|
||||
(p #00D47F185147EC39393CCDA4E7323FFC20FC8B8073E2A54DD63BA392A66975E4204CA48572496A9DFD7522436B852C07472A5AB25B7706F7C14E6F33FBC420FF3B#)
|
||||
(q #00E9AD22F158060BC9AE3601DA623AFC60FFF3058795802CA92371C00097335CF9A23D7782DE353C9DBA93D7BB99E6A24A411107605E722481C5C191F80D7EB77F#)
|
||||
(u #59B45B95AE01A7A7370FAFDB08FE73A4793CE37F228961B09B1B1E7DDAD9F8D3E28F5C5E8B4B067E6B8E0BBF3F690B42991A79E46108DDCDA2514323A66964DE#)))
|
||||
|
|
@ -28,10 +28,12 @@
|
|||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (web uri)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (srfi srfi-64))
|
||||
|
||||
|
|
@ -344,6 +346,49 @@ Deriver: ~a~%"
|
|||
(build-derivations s (list d))
|
||||
#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")
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue