ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch 'master' into dbus-update

Browse source
This commit is contained in:
Mark H Weaver 2015-10-20 14:11:43 -04:00
commit 7c6fb733e9
19 changed files with 642 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile.am
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
configure.ac
View file

@ -206,6 +206,7 @@ AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
AC_CONFIG_FILES([test-env], [chmod +x test-env])
dnl Emacs interface.
AC_PATH_PROG([DOT_USER_PROGRAM], [dot], [dot])
AM_PATH_LISPDIR
AM_CONDITIONAL([HAVE_EMACS], [test "x$EMACS" != "xno"])

1
doc.am
View file

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

11
doc/contributing.texi
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

154
doc/guix.texi
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
@ -1931,6 +1935,31 @@ The list of authorized keys is kept in the human-editable file
s-expressions''} and is structured as an access-control list in the
@url{http://theworld.com/~cme/spki.txt, Simple Public-Key Infrastructure
(SPKI)}.
@item --extract=@var{directory}
@itemx -x @var{directory}
Read a single-item archive as served by substitute servers
(@pxref{Substitutes}) and extract it to @var{directory}. This is a
low-level operation needed in only very narrow use cases; see below.
For example, the following command extracts the substitute for Emacs
served by @code{hydra.gnu.org} to @file{/tmp/emacs}:
@example
$ wget -O - \
http://hydra.gnu.org/nar/@dots{}-emacs-24.5 \
| bunzip2 | guix archive -x /tmp/emacs
@end example
Single-item archives are different from multiple-item archives produced
by @command{guix archive --export}; they contain a single store item,
and they do @emph{not} embed a signature. Thus this operation does
@emph{no} signature verification and its output should be considered
unsafe.
The primary purpose of this operation is to facilitate inspection of
archive contents coming from possibly untrusted substitute servers.
@end table
To export store files as an archive to the standard output, run:
@ -3552,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
@ -4751,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

3
emacs/guix-backend.el
View file

@ -56,9 +56,10 @@
(require 'geiser-guile)
(require 'guix-geiser)
(require 'guix-config)
(require 'guix-external)
(require 'guix-emacs)
(defvar guix-load-path guix-emacs-interface-directory
(defvar guix-load-path guix-config-emacs-interface-directory
"Directory with scheme files for \"guix.el\" package.")
(defvar guix-helper-file

16
emacs/guix-config.el.in
View file

@ -1,6 +1,7 @@
;;; guix-config.el --- Compile-time configuration of Guix.
;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;; This file is part of GNU Guix.
@ -19,21 +20,18 @@
;;; Code:
(defconst guix-emacs-interface-directory
(defconst guix-config-emacs-interface-directory
(replace-regexp-in-string "${prefix}" "@prefix@" "@emacsuidir@"))
(defconst guix-state-directory
(defconst guix-config-state-directory
;; This must match `NIX_STATE_DIR' as defined in `daemon.am'.
(or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix"))
(defvar guix-guile-program "@GUILE@"
"Name of the guile executable used for Guix REPL.
May be either a string (the name of the executable) or a list of
strings of the form:
(defconst guix-config-guile-program "@GUILE@"
"Name of the 'guile' executable defined at configure time.")
(NAME . ARGS)
Where ARGS is a list of arguments to the guile program.")
(defconst guix-config-dot-program "@DOT_USER_PROGRAM@"
"Name of the 'dot' executable defined at configure time.")
(provide 'guix-config)

21
emacs/guix-devel.el
View file

@ -254,6 +254,20 @@ Each rule should have a form (SYMBOL VALUE). See `put' for details."
0)))
(lisp-indent-specform count state indent-point normal-indent)))
(defun guix-devel-indent-modify-phases-keyword (count)
"Return indentation function for 'modify-phases' keywords."
(lambda (state indent-point normal-indent)
(when (ignore-errors
(goto-char (nth 1 state)) ; start of keyword sexp
(backward-up-list)
(looking-at "(modify-phases\\>"))
(lisp-indent-specform count state indent-point normal-indent))))
(defalias 'guix-devel-indent-modify-phases-keyword-1
(guix-devel-indent-modify-phases-keyword 1))
(defalias 'guix-devel-indent-modify-phases-keyword-2
(guix-devel-indent-modify-phases-keyword 2))
(guix-devel-scheme-indent
(bag 0)
(build-system 0)
@ -293,7 +307,12 @@ Each rule should have a form (SYMBOL VALUE). See `put' for details."
(with-monad 1)
(with-mutex 1)
(with-store 1)
(wrap-program 1))
(wrap-program 1)
;; 'modify-phases' keywords:
(replace 'guix-devel-indent-modify-phases-keyword-1)
(add-after 'guix-devel-indent-modify-phases-keyword-2)
(add-before 'guix-devel-indent-modify-phases-keyword-2))
(defvar guix-devel-keys-map

18
emacs/guix-external.el
View file

@ -23,11 +23,27 @@
;;; Code:
(require 'guix-config)
(defgroup guix-external nil
"Settings for external programs."
:group 'guix)
(defcustom guix-dot-program (executable-find "dot")
(defcustom guix-guile-program guix-config-guile-program
"Name of the 'guile' executable used for Guix REPL.
May be either a string (the name of the executable) or a list of
strings of the form:
(NAME . ARGS)
Where ARGS is a list of arguments to the guile program."
:type 'string
:group 'guix-external)
(defcustom guix-dot-program
(if (file-name-absolute-p guix-config-dot-program)
guix-config-dot-program
(executable-find "dot"))
"Name of the 'dot' executable."
:type 'string
:group 'guix-external)

2
emacs/guix-profiles.el
View file

@ -26,7 +26,7 @@
"User profile.")
(defvar guix-default-profile
(concat guix-state-directory
(concat guix-config-state-directory
"/profiles/per-user/"
(getenv "USER")
"/guix-profile")

3
gnu/packages/freedesktop.scm
View file

@ -46,6 +46,7 @@ (define-module (gnu packages freedesktop)
#:use-module (gnu packages doxygen)
#:use-module (gnu packages libffi)
#:use-module (gnu packages acl)
#:use-module (gnu packages admin)
#:use-module (gnu packages polkit))
(define-public xdg-utils
@ -175,6 +176,8 @@ (define-public elogind
`(("linux-pam" ,linux-pam)
("linux-libre-headers" ,linux-libre-headers)
("libcap" ,libcap)
("dmd" ,dmd) ;for 'halt' and 'reboot', invoked
;when pressing the power button
("dbus" ,dbus)
("eudev" ,eudev)))
(home-page "https://github.com/andywingo/elogind")

8
gnu/packages/gnunet.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
@ -143,13 +143,13 @@ (define-public libmicrohttpd
(define-public gnurl
(package
(name "gnurl")
(version "7.37.0")
(version "7.45.0")
(source (origin
(method url-fetch)
(uri (string-append "https://gnunet.org/sites/default/files/gnurl-"
version ".tar.gz"))
version ".tar.bz2"))
(sha256
(base32 "1l2q9ih63vkm65zn886kmhqsx906pzx3qjvsxymlmf18kiv18pfd"))))
(base32 "0hd8w4wyjwagd4k6vm6srphqbmysz08rcwf8z7f4b2d6d2yrn3mm"))))
(build-system gnu-build-system)
(inputs `(("gnutls" ,gnutls)
("libidn" ,libidn)

4
gnu/packages/maths.scm
View file

@ -79,13 +79,13 @@ (define-module (gnu packages maths)
(define-public units
(package
(name "units")
(version "2.11")
(version "2.12")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/units/units-" version
".tar.gz"))
(sha256 (base32
"1gjs3wc212aaiq4r76hx9nl1h3fa39n0ljwl9420d6ixl3rdmdjk"))))
"1jxvjknz2jhq773jrwx9gc1df3gfy73yqmkjkygqxzpi318yls3q"))))
(build-system gnu-build-system)
(synopsis "Conversion between thousands of scales")
(description

10
guix/scripts/archive.scm
View file

@ -20,6 +20,7 @@ (define-module (guix scripts archive)
#:use-module (guix config)
#:use-module (guix utils)
#:use-module ((guix build utils) #:select (mkdir-p))
#:use-module ((guix serialization) #:select (restore-file))
#:use-module (guix store)
#:use-module (guix packages)
#:use-module (guix derivations)
@ -63,6 +64,8 @@ (define (show-help)
--import import from the archive passed on stdin"))
(display (_ "
--missing print the files from stdin that are missing"))
(display (_ "
-x, --extract=DIR extract the archive on stdin to DIR"))
(newline)
(display (_ "
--generate-key[=PARAMETERS]
@ -119,6 +122,9 @@ (define %options
(option '("missing") #f #f
(lambda (opt name arg result)
(alist-cons 'missing #t result)))
(option '("extract" #\x) #t #f
(lambda (opt name arg result)
(alist-cons 'extract arg result)))
(option '("generate-key") #f #t
(lambda (opt name arg result)
(catch 'gcry-error
@ -328,6 +334,10 @@ (define (lines port)
(missing (remove (cut valid-path? store <>)
files)))
(format #t "~{~a~%~}" missing)))
((assoc-ref opts 'extract)
=>
(lambda (target)
(restore-file (current-input-port) target)))
(else
(leave
(_ "either '--export' or '--import' \

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

40
guix/scripts/substitute.scm
View file

@ -53,6 +53,25 @@ (define-module (guix scripts substitute)
#:use-module (web response)
#:use-module (guix http-client)
#:export (narinfo-signature->canonical-sexp
narinfo?
narinfo-path
narinfo-uri
narinfo-uri-base
narinfo-compression
narinfo-file-hash
narinfo-file-size
narinfo-hash
narinfo-size
narinfo-references
narinfo-deriver
narinfo-system
narinfo-signature
narinfo-hash->sha256
assert-valid-narinfo
lookup-narinfos
read-narinfo
write-narinfo
guix-substitute))
@ -231,6 +250,12 @@ (define-record-type <narinfo>
;; for more information.
(contents narinfo-contents))
(define (narinfo-hash->sha256 hash)
"If the string HASH denotes a sha256 hash, return it as a bytevector.
Otherwise return #f."
(and (string-prefix? "sha256:" hash)
(nix-base32-string->bytevector (string-drop hash 7))))
(define (narinfo-signature->canonical-sexp str)
"Return the value of a narinfo's 'Signature' field as a canonical sexp."
(match (string-split str #\;)
@ -429,10 +454,17 @@ (define (cache-entry cache-uri narinfo)
(value ,(and=> narinfo narinfo->string))))
(let ((file (narinfo-cache-file cache-url path)))
(mkdir-p (dirname file))
(with-atomic-file-output file
(lambda (out)
(write (cache-entry cache-url narinfo) out))))
(catch 'system-error
(lambda ()
(mkdir-p (dirname file))
(with-atomic-file-output file
(lambda (out)
(write (cache-entry cache-url narinfo) out))))
(lambda args
;; We may not have write access to the local cache when called from an
;; unprivileged process such as 'guix challenge'.
(unless (= EACCES (system-error-errno args))
(apply throw args)))))
narinfo)

1
po/guix/POTFILES.in
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:

15
tests/guix-archive.sh
View file

@ -24,9 +24,11 @@ guix archive --version
archive="t-archive-$$"
archive_alt="t-archive-alt-$$"
tmpdir="t-archive-dir-$$"
rm -f "$archive" "$archive_alt"
rm -rf "$tmpdir"
trap 'rm -f "$archive" "$archive_alt"' EXIT
trap 'rm -f "$archive" "$archive_alt"; rm -rf "$tmpdir"' EXIT
guix archive --export guile-bootstrap > "$archive"
guix archive --export guile-bootstrap:out > "$archive_alt"
@ -39,7 +41,7 @@ cmp "$archive" "$archive_alt"
guix archive --export `guix build guile-bootstrap` > "$archive_alt"
cmp "$archive" "$archive_alt"
# Check the exit value and stderr upon import.
# Check the exit value upon import.
guix archive --import < "$archive"
if guix archive something-that-does-not-exist
@ -63,5 +65,14 @@ echo something invalid > "$archive"
if guix archive --missing < "$archive"
then false; else true; fi
# Check '--extract'.
guile -c "(use-modules (guix serialization))
(call-with-output-file \"$archive\"
(lambda (port)
(write-file \"$(guix build guile-bootstrap)\" port)))"
guix archive -x "$tmpdir" < "$archive"
test -x "$tmpdir/bin/guile"
test -d "$tmpdir/lib/guile"
if echo foo | guix archive --authorize
then false; else true; fi