diff --git a/.gitignore b/.gitignore index a8a5cad74c..09a593e9fa 100644 --- a/.gitignore +++ b/.gitignore @@ -84,3 +84,4 @@ GPATH GRTAGS GTAGS /nix-setuid-helper +/nix/scripts/guix-authenticate diff --git a/Makefile.am b/Makefile.am index 2db77d57f3..34846c3e29 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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 \ diff --git a/config-daemon.ac b/config-daemon.ac index 5db08d099d..0717141198 100644 --- a/config-daemon.ac +++ b/config-daemon.ac @@ -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"]) diff --git a/daemon.am b/daemon.am index 77bfe71987..27c631b2da 100644 --- a/daemon.am +++ b/daemon.am @@ -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) diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm new file mode 100644 index 0000000000..cbafed79d0 --- /dev/null +++ b/guix/scripts/authenticate.scm @@ -0,0 +1,98 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; 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 . + +(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 diff --git a/guix/store.scm b/guix/store.scm index 08b0671b29..4ceca0daa2 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -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. diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc index 484a390936..cf87e39354 100644 --- a/nix/nix-daemon/guix-daemon.cc +++ b/nix/nix-daemon/guix-daemon.cc @@ -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; diff --git a/nix/scripts/guix-authenticate.in b/nix/scripts/guix-authenticate.in new file mode 100644 index 0000000000..5ce57915f0 --- /dev/null +++ b/nix/scripts/guix-authenticate.in @@ -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 diff --git a/po/POTFILES.in b/po/POTFILES.in index 0e30bb0880..beefdc901b 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -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 diff --git a/test-env.in b/test-env.in index 9224a80537..df73ecdc7a 100644 --- a/test-env.in +++ b/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" diff --git a/tests/signing-key.pub b/tests/signing-key.pub new file mode 100644 index 0000000000..092424a15d --- /dev/null +++ b/tests/signing-key.pub @@ -0,0 +1,4 @@ +(public-key + (rsa + (n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#) + (e #010001#))) diff --git a/tests/signing-key.sec b/tests/signing-key.sec new file mode 100644 index 0000000000..558e189102 --- /dev/null +++ b/tests/signing-key.sec @@ -0,0 +1,8 @@ +(private-key + (rsa + (n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#) + (e #010001#) + (d #58CAD84653D0046A8EC3F9AA82D9C829B145422109FC3F12DA01A694B92FA296E70D366FB166454D30E632CEE3A033B4C41781BA10325F69FCDC0250CA19C8EEB352FA085992494098DB133E682ED38A931701F0DED1A1E508F4341A4FB446A04F019427C7CB3C44F251EEA9D386100DA80F125E0FD5CE1B0DFEC6D21516EACD#) + (p #00D47F185147EC39393CCDA4E7323FFC20FC8B8073E2A54DD63BA392A66975E4204CA48572496A9DFD7522436B852C07472A5AB25B7706F7C14E6F33FBC420FF3B#) + (q #00E9AD22F158060BC9AE3601DA623AFC60FFF3058795802CA92371C00097335CF9A23D7782DE353C9DBA93D7BB99E6A24A411107605E722481C5C191F80D7EB77F#) + (u #59B45B95AE01A7A7370FAFDB08FE73A4793CE37F228961B09B1B1E7DDAD9F8D3E28F5C5E8B4B067E6B8E0BBF3F690B42991A79E46108DDCDA2514323A66964DE#))) diff --git a/tests/store.scm b/tests/store.scm index 281b923c28..6834ebc5e9 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -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")