Add 'guix challenge'.

* guix/scripts/challenge.scm, tests/challenge.scm: New files.
* Makefile.am (MODULES): Add the former.
  (SCM_TESTS): Add the latter.
* doc.am (SUBCOMMANDS): Add 'challenge'.
* doc/guix.texi (Substitutes): Add xref to 'guix challenge'.
  (Invoking guix challenge): New node.
* doc/contributing.texi (Submitting Patches): Add note about using 'guix
  challenge'.
* po/guix/POTFILES.in: Add guix/scripts/challenge.scm.
This commit is contained in:
Ludovic Courtès 2015-10-20 00:55:09 +02:00
parent ea0c6e0507
commit d23c20f1d0
7 changed files with 501 additions and 1 deletions

View file

@ -116,6 +116,7 @@ MODULES = \
guix/scripts/refresh.scm \
guix/scripts/system.scm \
guix/scripts/lint.scm \
guix/scripts/challenge.scm \
guix/scripts/import/cran.scm \
guix/scripts/import/gnu.scm \
guix/scripts/import/nix.scm \
@ -218,6 +219,7 @@ SCM_TESTS = \
tests/scripts.scm \
tests/size.scm \
tests/graph.scm \
tests/challenge.scm \
tests/file-systems.scm \
tests/services.scm \
tests/containers.scm

1
doc.am
View file

@ -113,6 +113,7 @@ endef
SUBCOMMANDS := \
archive \
build \
challenge \
download \
edit \
environment \

View file

@ -234,6 +234,17 @@ For important changes, check that dependent package (if applicable) are
not affected by the change; @code{guix refresh --list-dependent
@var{package}} will help you do that (@pxref{Invoking guix refresh}).
@item
Check whether the package's build process is deterministic. This
typically means checking whether an independent build of the package
yields the exact same result that you obtained, bit for bit.
A simple way to do that is with @command{guix challenge}
(@pxref{Invoking guix challenge}). You may run it once the package has
been committed and built by @code{hydra.gnu.org} to check whether it
obtains the same result as you did. Better yet: Find another machine
that can build it and run @command{guix publish}.
@end enumerate
When posting a patch to the mailing list, use @samp{[PATCH] @dots{}} as a

View file

@ -143,6 +143,7 @@ Utilities
* Invoking guix graph:: Visualizing the graph of packages.
* Invoking guix environment:: Setting up development environments.
* Invoking guix publish:: Sharing substitutes.
* Invoking guix challenge:: Challenging substitute servers.
GNU Distribution
@ -1600,7 +1601,10 @@ Guix has the foundations to maximize build reproducibility
(@pxref{Features}). In most cases, independent builds of a given
package or derivation should yield bit-identical results. Thus, through
a diverse set of independent package builds, we can strengthen the
integrity of our systems.
integrity of our systems. The @command{guix challenge} command aims to
help users assess substitute servers, and to assist developers in
finding out about non-deterministic package builds (@pxref{Invoking guix
challenge}).
In the future, we want Guix to have support to publish and retrieve
binaries to/from other users, in a peer-to-peer fashion. If you would
@ -3577,6 +3581,7 @@ programming interface of Guix in a convenient way.
* Invoking guix graph:: Visualizing the graph of packages.
* Invoking guix environment:: Setting up development environments.
* Invoking guix publish:: Sharing substitutes.
* Invoking guix challenge:: Challenging substitute servers.
@end menu
@node Invoking guix build
@ -4776,6 +4781,128 @@ Reference Manual}) on @var{port} (37146 by default). This is used
primarily for debugging a running @command{guix publish} server.
@end table
@node Invoking guix challenge
@section Invoking @command{guix challenge}
@cindex reproducible builds
@cindex verifiable builds
Do the binaries provided by this server really correspond to the source
code it claims to build? Is this package's build process deterministic?
These are the questions the @command{guix challenge} command attempts to
answer.
The former is obviously an important question: Before using a substitute
server (@pxref{Substitutes}), you'd rather @emph{verify} that it
provides the right binaries, and thus @emph{challenge} it. The latter
is what enables the former: If package builds are deterministic, then
independent builds of the package should yield the exact same result,
bit for bit; if a server provides a binary different from the one
obtained locally, it may be either corrupt or malicious.
We know that the hash that shows up in @file{/gnu/store} file names is
the hash of all the inputs of the process that built the file or
directory---compilers, libraries, build scripts,
etc. (@pxref{Introduction}). Assuming deterministic build processes,
one store file name should map to exactly one build output.
@command{guix challenge} checks whether there is, indeed, a single
mapping by comparing the build outputs of several independent builds of
any given store item.
The command's output looks like this:
@smallexample
$ guix challenge --substitute-urls="http://hydra.gnu.org http://guix.example.org"
updating list of substitutes from 'http://hydra.gnu.org'... 100.0%
updating list of substitutes from 'http://guix.example.org'... 100.0%
/gnu/store/@dots{}-openssl-1.0.2d contents differ:
local hash: 0725l22r5jnzazaacncwsvp9kgf42266ayyp814v7djxs7nk963q
http://hydra.gnu.org/nar/@dots{}-openssl-1.0.2d: 0725l22r5jnzazaacncwsvp9kgf42266ayyp814v7djxs7nk963q
http://guix.example.org/nar/@dots{}-openssl-1.0.2d: 1zy4fmaaqcnjrzzajkdn3f5gmjk754b43qkq47llbyak9z0qjyim
/gnu/store/@dots{}-git-2.5.0 contents differ:
local hash: 00p3bmryhjxrhpn2gxs2fy0a15lnip05l97205pgbk5ra395hyha
http://hydra.gnu.org/nar/@dots{}-git-2.5.0: 069nb85bv4d4a6slrwjdy8v1cn4cwspm3kdbmyb81d6zckj3nq9f
http://guix.example.org/nar/@dots{}-git-2.5.0: 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
/gnu/store/@dots{}-pius-2.1.1 contents differ:
local hash: 0k4v3m9z1zp8xzzizb7d8kjj72f9172xv078sq4wl73vnq9ig3ax
http://hydra.gnu.org/nar/@dots{}-pius-2.1.1: 0k4v3m9z1zp8xzzizb7d8kjj72f9172xv078sq4wl73vnq9ig3ax
http://guix.example.org/nar/@dots{}-pius-2.1.1: 1cy25x1a4fzq5rk0pmvc8xhwyffnqz95h2bpvqsz2mpvlbccy0gs
@end smallexample
@noindent
In this example, @command{guix challenge} first scans the store to
determine the set of locally-built derivations---as opposed to store
items that were downloaded from a substitute server---and then queries
all the substitute servers. It then reports those store items for which
the servers obtained a result different from the local build.
@cindex non-determinism, in package builds
As an example, @code{guix.example.org} always gets a different answer.
Conversely, @code{hydra.gnu.org} agrees with local builds, except in the
case of Git. This might indicate that the build process of Git is
non-deterministic, meaning that its output varies as a function of
various things that Guix does not fully control, in spite of building
packages in isolated environments (@pxref{Features}). Most common
sources of non-determinism include the addition of timestamps in build
results, the inclusion of random numbers, and directory listings sorted
by inode number. See @uref{http://reproducible.debian.net/howto/}, for
more information.
To find out what's wrong with this Git binary, we can do something along
these lines (@pxref{Invoking guix archive}):
@example
$ wget -q -O - http://hydra.gnu.org/nar/@dots{}-git-2.5.0 \
| guix archive -x /tmp/git
$ diff -ur /gnu/store/@dots{}-git.2.5.0 /tmp/git
@end example
This command shows the difference between the files resulting from the
local build, and the files resulting from the build on
@code{hydra.gnu.org} (@pxref{Overview, Comparing and Merging Files,,
diffutils, Comparing and Merging Files}). The @command{diff} command
works great for text files. When binary files differ, a better option
is @uref{http://diffoscope.org/, Diffoscope}, a tool that helps
visualize differences for all kinds of files.
Once you've done that work, you can tell whether the differences are due
to a non-deterministic build process or to a malicious server. We try
hard to remove sources of non-determinism in packages to make it easier
to verify substitutes, but of course, this is a process, one that
involves not just Guix but a large part of the free software community.
In the meantime, @command{guix challenge} is one tool to help address
the problem.
If you are writing packages for Guix, you are encouraged to check
whether @code{hydra.gnu.org} and other substitute servers obtain the
same build result as you did with:
@example
$ guix challenge @var{package}
@end example
@noindent
... where @var{package} is a package specification such as
@code{guile-2.0} or @code{glibc:debug}.
The general syntax is:
@example
guix challenge @var{options} [@var{packages}@dots{}]
@end example
The one option that matters is:
@table @code
@item --substitute-urls=@var{urls}
Consider @var{urls} the whitespace-separated list of substitute source
URLs to compare to.
@end table
@c *********************************************************************
@node GNU Distribution
@chapter GNU Distribution

244
guix/scripts/challenge.scm Normal file
View file

@ -0,0 +1,244 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 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 challenge)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix monads)
#:use-module (guix base32)
#:use-module (guix packages)
#:use-module (guix serialization)
#:use-module (guix scripts substitute)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:use-module (ice-9 format)
#:use-module (web uri)
#:export (discrepancies
discrepancy?
discrepancy-item
discrepancy-local-sha256
discrepancy-narinfos
guix-challenge))
;;; Commentary:
;;;
;;; Challenge substitute servers, checking whether they provide the same
;;; binaries as those built locally.
;;;
;;; Here we completely bypass the daemon to access substitutes. This is
;;; because we want to be able to report fine-grain information about
;;; discrepancies: We need to show the URL of the offending nar, its hash, and
;;; so on.
;;;
;;; Code:
(define ensure-store-item ;XXX: move to (guix ui)?
(@@ (guix scripts size) ensure-store-item))
;; Representation of a hash mismatch for ITEM.
(define-record-type <discrepancy>
(discrepancy item local-sha256 narinfos)
discrepancy?
(item discrepancy-item) ;string, /gnu/store/… item
(local-sha256 discrepancy-local-sha256) ;bytevector | #f
(narinfos discrepancy-narinfos)) ;list of <narinfo>
(define (locally-built? store item)
"Return true if ITEM was built locally."
;; XXX: For now approximate it by checking whether there's a build log for
;; ITEM. There could be false negatives, if logs have been removed.
(->bool (log-file store item)))
(define (query-locally-built-hash item)
"Return the hash of ITEM, a store item, if ITEM was built locally.
Otherwise return #f."
(lambda (store)
(guard (c ((nix-protocol-error? c)
(values #f store)))
(if (locally-built? store item)
(values (query-path-hash store item) store)
(values #f store)))))
(define-syntax-rule (report args ...)
(format (current-error-port) args ...))
(define (discrepancies items servers)
"Challenge the substitute servers whose URLs are listed in SERVERS by
comparing the hash of the substitutes of ITEMS that they serve. Return the
list of discrepancies.
This procedure does not authenticate narinfos from SERVERS, nor does it verify
that they are signed by an authorized public keys. The reason is that, by
definition, we may want to target unknown servers. Furthermore, no risk is
taken since we do not import the archives."
(define (compare item reference)
;; Return a procedure to compare the hash of ITEM with REFERENCE.
(lambda (narinfo url)
(if (not narinfo)
(begin
(warning (_ "~a: no substitute at '~a'~%")
item url)
#t)
(let ((value (narinfo-hash->sha256 (narinfo-hash narinfo))))
(bytevector=? reference value)))))
(define (select-reference item narinfos urls)
;; Return a "reference" narinfo among NARINFOS.
(match narinfos
((first narinfos ...)
(match servers
((url urls ...)
(if (not first)
(select-reference item narinfos urls)
(narinfo-hash->sha256 (narinfo-hash first))))))
(()
(leave (_ "no substitutes for '~a'~%") item))))
(mlet* %store-monad ((local (mapm %store-monad
query-locally-built-hash items))
(remote -> (append-map (cut lookup-narinfos <> items)
servers))
;; No 'assert-valid-narinfo' on purpose.
(narinfos -> (fold (lambda (narinfo vhash)
(if narinfo
(vhash-cons (narinfo-path narinfo) narinfo
vhash)
vhash))
vlist-null
remote)))
(return (filter-map (lambda (item local)
(let ((narinfos (vhash-fold* cons '() item narinfos)))
(define reference
(or local
(begin
(warning (_ "no local build for '~a'~%") item)
(select-reference item narinfos servers))))
(if (every (compare item reference)
narinfos servers)
#f
(discrepancy item local narinfos))))
items
local))))
(define* (summarize-discrepancy discrepancy
#:key (hash->string
bytevector->nix-base32-string))
"Write to the current error port a summary of DISCREPANCY, a <discrepancy>
object that denotes a hash mismatch."
(match discrepancy
(($ <discrepancy> item local (narinfos ...))
(report (_ "~a contents differ:~%") item)
(if local
(report (_ " local hash: ~a~%") (hash->string local))
(warning (_ "no local build for '~a'~%") item))
(for-each (lambda (narinfo)
(if narinfo
(report (_ " ~50a: ~a~%")
(uri->string (narinfo-uri narinfo))
(hash->string
(narinfo-hash->sha256 (narinfo-hash narinfo))))
(report (_ " ~50a: unavailable~%")
(uri->string (narinfo-uri narinfo)))))
narinfos))))
;;;
;;; Command-line options.
;;;
(define (show-help)
(display (_ "Usage: guix challenge [PACKAGE...]
Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
(display (_ "
--substitute-urls=URLS
compare build results with those at URLS"))
(newline)
(display (_ "
-h, --help display this help and exit"))
(display (_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(define %options
(list (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix challenge")))
(option '("substitute-urls") #t #f
(lambda (opt name arg result . rest)
(apply values
(alist-cons 'substitute-urls
(string-tokenize arg)
(alist-delete 'substitute-urls result))
rest)))))
(define %default-options
`((system . ,(%current-system))
(substitute-urls . ,%default-substitute-urls)))
;;;
;;; Entry point.
;;;
(define (guix-challenge . args)
(with-error-handling
(let* ((opts (parse-command-line args %options (list %default-options)))
(files (filter-map (match-lambda
(('argument . file) file)
(_ #f))
opts))
(system (assoc-ref opts 'system))
(urls (assoc-ref opts 'substitute-urls)))
(leave-on-EPIPE
(with-store store
(let ((files (match files
(()
(filter (cut locally-built? store <>)
(live-paths store)))
(x
files))))
(set-build-options store
#:use-substitutes? #f)
(run-with-store store
(mlet* %store-monad ((items (mapm %store-monad
ensure-store-item files))
(issues (discrepancies items urls)))
(for-each summarize-discrepancy issues)
(return (null? issues)))
#:system system)))))))
;;; challenge.scm ends here

View file

@ -22,6 +22,7 @@ guix/scripts/publish.scm
guix/scripts/edit.scm
guix/scripts/size.scm
guix/scripts/graph.scm
guix/scripts/challenge.scm
guix/gnu-maintenance.scm
guix/ui.scm
guix/http-client.scm

114
tests/challenge.scm Normal file
View file

@ -0,0 +1,114 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 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 (test-challenge)
#:use-module (guix tests)
#:use-module (guix hash)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix scripts challenge)
#:use-module (guix scripts substitute)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match))
(define %store
(open-connection-for-tests))
(define query-path-hash*
(store-lift query-path-hash))
(define-syntax-rule (test-assertm name exp)
(test-assert name
(run-with-store %store exp
#:guile-for-build (%guile-for-build))))
(define* (call-with-derivation-narinfo* drv thunk hash)
(lambda (store)
(with-derivation-narinfo drv (sha256 => hash)
(values (run-with-store store (thunk)) store))))
(define-syntax with-derivation-narinfo*
(syntax-rules (sha256 =>)
((_ drv (sha256 => hash) body ...)
(call-with-derivation-narinfo* drv
(lambda () body ...)
hash))))
(test-begin "challenge")
(test-assertm "no discrepancies"
(let ((text (random-text)))
(mlet* %store-monad ((drv (gexp->derivation "something"
#~(call-with-output-file
#$output
(lambda (port)
(display #$text port)))))
(out -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
(mlet %store-monad ((hash (query-path-hash* out)))
(with-derivation-narinfo* drv (sha256 => hash)
(>>= (discrepancies (list out) (%test-substitute-urls))
(lift1 null? %store-monad))))))))
(test-assertm "one discrepancy"
(let ((text (random-text)))
(mlet* %store-monad ((drv (gexp->derivation "something"
#~(call-with-output-file
#$output
(lambda (port)
(display #$text port)))))
(out -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
(mlet* %store-monad ((hash (query-path-hash* out))
(wrong-hash
-> (let* ((w (bytevector-copy hash))
(b (bytevector-u8-ref w 0)))
(bytevector-u8-set! w 0
(modulo (+ b 1) 128))
w)))
(with-derivation-narinfo* drv (sha256 => wrong-hash)
(>>= (discrepancies (list out) (%test-substitute-urls))
(match-lambda
((discrepancy)
(return
(and (string=? out (discrepancy-item discrepancy))
(bytevector=? hash
(discrepancy-local-sha256
discrepancy))
(match (discrepancy-narinfos discrepancy)
((bad)
(bytevector=? wrong-hash
(narinfo-hash->sha256
(narinfo-hash bad))))))))))))))))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))
;;; Local Variables:
;;; eval: (put 'with-derivation-narinfo* 'scheme-indent-function 2)
;;; End: