guix-bioinformatics
/
guix
3
0
Fork 0
Code Issues 0 Pull Requests 0 Releases 0 Wiki Activity
Browse Source

Merge branch 'core-updates'

gn-latest-20200428
Ludovic Courtès 6 years ago
parent
2eea253f4d 00fe93338d
commit
f513527a8e
28 changed files with 547 additions and 172 deletions
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +29
    -22
      Makefile.am
  2. +83
    -0
      build-aux/check-final-inputs-self-contained.scm
  3. +6
    -0
      doc/guix.texi
  4. +2
    -0
      gnu-system.am
  5. +10
    -15
      gnu/packages/admin.scm
  6. +5
    -0
      gnu/packages/apr.scm
  7. +125
    -20
      gnu/packages/base.scm
  8. +8
    -2
      gnu/packages/cross-base.scm
  9. +14
    -2
      gnu/packages/gawk.scm
  10. +73
    -30
      gnu/packages/gcc.scm
  11. +19
    -15
      gnu/packages/gettext.scm
  12. +2
    -1
      gnu/packages/guile.scm
  13. +4
    -3
      gnu/packages/icu4c.scm
  14. +6
    -1
      gnu/packages/libunistring.scm
  15. +9
    -3
      gnu/packages/linux.scm
  16. +24
    -7
      gnu/packages/make-bootstrap.scm
  17. +2
    -2
      gnu/packages/multiprecision.scm
  18. +6
    -2
      gnu/packages/ncurses.scm
  19. +15
    -0
      gnu/packages/patches/guile-ncurses-tests.patch
  20. +17
    -0
      gnu/packages/patches/icu4c-test-date-format.patch
  21. +3
    -8
      gnu/packages/qemu.scm
  22. +6
    -1
      gnu/packages/tor.scm
  23. +10
    -6
      gnu/system.scm
  24. +11
    -1
      guix/build-system/gnu.scm
  25. +5
    -1
      guix/build/gnu-build-system.scm
  26. +37
    -24
      guix/build/utils.scm
  27. +9
    -3
      guix/scripts/substitute-binary.scm
  28. +7
    -3
      guix/scripts/system.scm

+ 29
- 22
Makefile.am View File

@@ -186,27 +186,28 @@ tests/guix-gc.log: \
# Public key used to sign substitutes from hydra.gnu.org.
dist_pkgdata_DATA = hydra.gnu.org.pub

EXTRA_DIST = \
HACKING \
ROADMAP \
TODO \
.dir-locals.el \
build-aux/hydra/gnu-system.scm \
build-aux/hydra/demo-os.scm \
build-aux/hydra/guix.scm \
build-aux/check-available-binaries.scm \
build-aux/download.scm \
build-aux/list-packages.scm \
build-aux/sync-descriptions.scm \
srfi/srfi-37.scm.in \
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 \
EXTRA_DIST = \
HACKING \
ROADMAP \
TODO \
.dir-locals.el \
build-aux/hydra/gnu-system.scm \
build-aux/hydra/demo-os.scm \
build-aux/hydra/guix.scm \
build-aux/check-available-binaries.scm \
build-aux/check-final-inputs-self-contained.scm \
build-aux/download.scm \
build-aux/list-packages.scm \
build-aux/sync-descriptions.scm \
srfi/srfi-37.scm.in \
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 \
$(TESTS)

if !BUILD_DAEMON_OFFLOAD
@@ -264,7 +265,7 @@ AM_DISTCHECK_CONFIGURE_FLAGS = \
--enable-daemon

dist-hook: sync-descriptions gen-ChangeLog assert-no-store-file-names
distcheck-hook: assert-binaries-available
distcheck-hook: assert-binaries-available assert-final-inputs-self-contained

sync-descriptions:
-$(top_builddir)/pre-inst-env $(GUILE) \
@@ -292,5 +293,11 @@ assert-binaries-available:
$(top_builddir)/pre-inst-env "$(GUILE)" \
"$(top_srcdir)/build-aux/check-available-binaries.scm"

# Make sure the final inputs don't refer to bootstrap tools.
assert-final-inputs-self-contained:
$(top_builddir)/pre-inst-env "$(GUILE)" \
"$(top_srcdir)/build-aux/check-final-inputs-self-contained.scm"

.PHONY: sync-descriptions gen-ChangeLog clean-go
.PHONY: assert-no-store-file-names assert-binaries-available
.PHONY: assert-final-inputs-self-contained

+ 83
- 0
build-aux/check-final-inputs-self-contained.scm View File

@@ -0,0 +1,83 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 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/>.

;;;
;;; Check whether important binaries are available at hydra.gnu.org.
;;;

(use-modules (guix store)
(guix packages)
(guix derivations)
(guix ui)
(gnu packages base)
(ice-9 match)
(srfi srfi-1)
(srfi srfi-26))

(define %supported-systems
'("x86_64-linux" "i686-linux"))

(define (final-inputs store system)
"Return the list of outputs directories of the final inputs for SYSTEM."
(append-map (match-lambda
((name package)
(let ((drv (package-derivation store package system)))
;; Libc's 'debug' output refers to gcc-cross-boot0, but it's
;; hard to avoid, so we tolerate it. This should be the
;; only exception.
(filter-map (match-lambda
(("debug" . directory)
(if (string=? "glibc" (package-name package))
#f
directory))
((_ . directory) directory))
(derivation->output-paths drv)))))
%final-inputs))

(define (assert-valid-substitute substitute)
"Make sure SUBSTITUTE does not refer to any bootstrap inputs, and bail out
if it does."
(let ((references (substitutable-references substitute)))
(when (any (cut string-contains <> "boot") references)
(leave (_ "'~a' refers to bootstrap inputs: ~s~%")
(substitutable-path substitute) references))))

(define (test-final-inputs store system)
"Check whether the final inputs for SYSTEM are clean---i.e., they don't
refer to the bootstrap tools."
(format #t "checking final inputs for '~a'...~%" system)
(let* ((inputs (final-inputs store system))
(available (substitutable-path-info store inputs)))
(for-each (lambda (dir)
(unless (find (lambda (substitute)
(string=? (substitutable-path substitute)
dir))
available)
(leave (_ "~a (system: ~a) has no substitute~%")
dir system)))
inputs)

(for-each assert-valid-substitute available)))

;; Entry point.
(with-store store
(set-build-options store #:use-substitutes? #t)

(for-each (cut test-final-inputs store <>)
%supported-systems))


+ 6
- 0
doc/guix.texi View File

@@ -3263,6 +3263,12 @@ using the following command:
@var{options} can contain any of the common build options provided by
@command{guix build} (@pxref{Invoking guix build}).

Note that all the actions above, except @code{build} and @code{init},
rely on KVM support in the Linux-Libre kernel. Specifically, the
machine should have hardware virtualization support, the corresponding
KVM kernel module should be loaded, and the @file{/dev/kvm} device node
must exist and be readable and writable by the user and by the daemon's
build users.

@node Defining Services
@subsection Defining Services


+ 2
- 0
gnu-system.am View File

@@ -311,10 +311,12 @@ dist_patch_DATA = \
gnu/packages/patches/guile-1.8-cpp-4.5.patch \
gnu/packages/patches/guile-default-utf8.patch \
gnu/packages/patches/guile-linux-syscalls.patch \
gnu/packages/patches/guile-ncurses-tests.patch \
gnu/packages/patches/guile-relocatable.patch \
gnu/packages/patches/guix-test-networking.patch \
gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \
gnu/packages/patches/hop-bigloo-4.0b.patch \
gnu/packages/patches/icu4c-test-date-format.patch \
gnu/packages/patches/inkscape-stray-comma.patch \
gnu/packages/patches/libevent-dns-tests.patch \
gnu/packages/patches/libffi-mips-n32-fix.patch \


+ 10
- 15
gnu/packages/admin.scm View File

@@ -205,16 +205,7 @@ client and server, a telnet client and server, and an rsh client and server.")
(delete-file (string-append bin "/groups"))
(for-each delete-file (find-files man "^groups\\."))
#t))
(alist-cons-after
'unpack 'reset-timestamps
(lambda _
;; FIXME: Reset the file timestamps here, until the
;; 'unpack' phase does it for us. See
;; <https://lists.gnu.org/archive/html/guix-devel/2014-04/msg00098.html>.
(for-each (lambda (file)
(utime file 0 0 0))
(find-files "." "")))
%standard-phases)))))
%standard-phases))))

(inputs (if (string-suffix? "-linux"
(or (%current-target-system)
@@ -446,11 +437,15 @@ connection alive.")

(native-inputs `(("perl" ,perl)))

;; Even Coreutils and sed are needed here in case we're cross-compiling.
(inputs `(("coreutils" ,coreutils)
("sed" ,sed)
("net-tools" ,net-tools)
("iproute" ,iproute)))
(inputs `(("net-tools" ,net-tools)
("iproute" ,iproute)

;; When cross-compiling, we need the cross Coreutils and sed.
;; Otherwise just use those from %FINAL-INPUTS.
,@(if (%current-target-system)
`(("coreutils" ,coreutils)
("sed" ,sed))
'())))

(home-page "http://www.isc.org/products/DHCP/")
(synopsis "Dynamic Host Configuration Protocol (DHCP) tools")


+ 5
- 0
gnu/packages/apr.scm View File

@@ -40,6 +40,11 @@
(list (search-patch "apr-skip-getservbyname-test.patch")))
(patch-flags '("-p0"))))
(build-system gnu-build-system)
(arguments
;; Sometimes we end up with two processes concurrently trying to make
;; 'libmod_test.la': <http://hydra.gnu.org/build/60266/nixlog/2/raw>.
;; Thus, build sequentially.
'(#:parallel-build? #f))
(inputs `(("perl" ,perl)
("libtool" ,libtool)))
(home-page "http://apr.apache.org/")


+ 125
- 20
gnu/packages/base.scm View File

@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
@@ -41,6 +42,7 @@
#:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match))

;;; Commentary:
@@ -71,14 +73,14 @@ command-line arguments, multiple languages, and so on.")
(define-public grep
(package
(name "grep")
(version "2.18")
(version "2.20")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/grep/grep-"
version ".tar.xz"))
(sha256
(base32
"08773flbnx28ksy0y4mzd4iifysh7yysmzn8rkz9f57sfx86whz6"))))
"0rcs0spsxdmh6yz8y4frkqp6f5iw19mdbdl9s2v6956hq0mlbbzh"))))
(build-system gnu-build-system)
(synopsis "Print lines matching a pattern")
(description
@@ -262,14 +264,16 @@ used to apply commands with arbitrarily long arguments.")
'build 'patch-shell-references
(lambda* (#:key inputs #:allow-other-keys)
(let ((bash (assoc-ref inputs "bash")))
(substitute* (cons "src/split.c"
(find-files "gnulib-tests"
"\\.c$"))
;; 'split' uses either $SHELL or /bin/sh. Set $SHELL so
;; that tests pass, since /bin/sh isn't in the chroot.
(setenv "SHELL" (which "sh"))

(substitute* (find-files "gnulib-tests" "\\.c$")
(("/bin/sh")
(format #f "~a/bin/sh" bash)))
(substitute* (find-files "tests" "\\.sh$")
(("#!/bin/sh")
(format #f "#!~a/bin/bash" bash)))))
(format #f "#!~a/bin/sh" bash)))))
%standard-phases)))
(synopsis "Core GNU utilities (file, text, shell)")
(description
@@ -728,15 +732,19 @@ identifier SYSTEM."
source)))
(list gmp mpfr mpc))

;; Create symlinks like `gmp' -> `gmp-5.0.5'.
;; Create symlinks like `gmp' -> `gmp-x.y.z'.
,@(map (lambda (lib)
`(symlink ,(package-full-name lib)
;; Drop trailing letters, as gmp-6.0.0a unpacks
;; into gmp-6.0.0.
`(symlink ,(string-trim-right
(package-full-name lib)
char-set:letter)
,(package-name lib)))
(list gmp mpfr mpc))))
(alist-cons-after
'install 'symlink-libgcc_eh
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(let ((out (assoc-ref outputs "lib")))
;; Glibc wants to link against libgcc_eh, so provide
;; it.
(with-directory-excursion
@@ -822,22 +830,37 @@ identifier SYSTEM."
;; Build Sun/ONC RPC support. In particular,
;; install rpc/*.h.
"--enable-obsolete-rpc")
,flags)))))
,flags))
((#:phases phases)
`(alist-cons-before
'configure 'pre-configure
(lambda* (#:key inputs #:allow-other-keys)
;; Don't clobber CPATH with the bootstrap libc.
(setenv "NATIVE_CPATH" (getenv "CPATH"))
(unsetenv "CPATH")

;; 'rpcgen' needs native libc headers to be built.
(substitute* "sunrpc/Makefile"
(("sunrpc-CPPFLAGS =.*" all)
(string-append "CPATH = $(NATIVE_CPATH)\n"
"export CPATH\n"
all "\n"))))
,phases)))))
(propagated-inputs `(("linux-headers" ,(linux-libre-headers-boot0))))
(native-inputs
`(("texinfo" ,texinfo-boot0)
("perl" ,perl-boot0)))
(inputs
`( ;; A native GCC is needed to build `cross-rpcgen'.
`(;; The boot inputs. That includes the bootstrap libc. We don't want
;; it in $CPATH, hence the 'pre-configure' phase above.
,@%boot1-inputs

;; A native GCC is needed to build `cross-rpcgen'.
("native-gcc" ,@(assoc-ref %boot0-inputs "gcc"))

;; Here, we use the bootstrap Bash, which is not satisfactory
;; because we don't want to depend on bootstrap tools.
("static-bash" ,@(assoc-ref %boot0-inputs "bash"))

,@%boot1-inputs
,@(alist-delete "static-bash"
(package-inputs glibc))))))) ; patches
("static-bash" ,@(assoc-ref %boot0-inputs "bash")))))))

(define (cross-gcc-wrapper gcc binutils glibc bash)
"Return a wrapper for the pseudo-cross toolchain GCC/BINUTILS/GLIBC
@@ -846,6 +869,7 @@ that makes it available under the native tool names."
(name (string-append (package-name gcc) "-wrapped"))
(source #f)
(build-system trivial-build-system)
(outputs '("out"))
(arguments
`(#:guile ,%bootstrap-guile
#:modules ((guix build utils))
@@ -914,7 +938,17 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
(inputs `(("static-bash" ,static-bash-for-glibc)
,@(alist-delete
"static-bash"
(package-inputs glibc-final-with-bootstrap-bash))))))
(package-inputs glibc-final-with-bootstrap-bash))))

;; The final libc only refers to itself, but the 'debug' output contains
;; references to GCC-BOOT0 and to the Linux headers. XXX: Would be great
;; if 'allowed-references' were per-output.
(arguments
`(#:allowed-references
,(cons* `(,gcc-boot0 "lib") (linux-libre-headers-boot0)
(package-outputs glibc-final-with-bootstrap-bash))

,@(package-arguments glibc-final-with-bootstrap-bash)))))

(define gcc-boot0-wrapped
;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
@@ -934,6 +968,7 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
(arguments
`(#:guile ,%bootstrap-guile
#:implicit-inputs? #f
#:allowed-references ("out" ,glibc-final)
,@(package-arguments binutils)))
(inputs %boot2-inputs))))

@@ -962,6 +997,7 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
;; "/include/c++/"
;; ,(package-version gcc-4.8)
))))
(outputs '("out"))
(inputs %boot2-inputs)
(native-inputs '())
(propagated-inputs '())
@@ -976,6 +1012,8 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
`(#:guile ,%bootstrap-guile
#:implicit-inputs? #f

#:allowed-references ("out" "lib" ,glibc-final)

;; Build again GMP & co. within GCC's build process, because it's hard
;; to do outside (because GCC-BOOT0 is a cross-compiler, and thus
;; doesn't honor $LIBRARY_PATH, which breaks `gnu-build-system'.)
@@ -1003,6 +1041,10 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
((#:phases phases)
`(alist-delete 'symlink-libgcc_eh ,phases)))))

;; This time we want Texinfo, so we get the manual.
(native-inputs `(("texinfo" ,texinfo-boot0)
,@(package-native-inputs gcc-boot0)))

(inputs `(("gmp-source" ,(package-source gmp))
("mpfr-source" ,(package-source mpfr))
("mpc-source" ,(package-source mpc))
@@ -1105,13 +1147,42 @@ store.")
,@(fold alist-delete (package-inputs ld-wrapper-boot3)
'("guile" "bash"))))))

(define coreutils-final
;; The final Coreutils. Treat them specially because some packages, such as
;; Findutils, keep a reference to the Coreutils they were built with.
(package-with-bootstrap-guile
(package-with-explicit-inputs coreutils
%boot4-inputs
(current-source-location)

;; Use the final Guile, linked against the
;; final libc with working iconv, so that
;; 'substitute*' works well when touching
;; test files in Gettext.
#:guile guile-final)))

(define grep-final
;; The final grep. Gzip holds a reference to it (via zgrep), so it must be
;; built before gzip.
(package-with-bootstrap-guile
(package-with-explicit-inputs grep
%boot4-inputs
(current-source-location)
#:guile guile-final)))

(define %boot5-inputs
;; Now use the final Coreutils.
`(("coreutils" ,coreutils-final)
("grep" ,grep-final)
,@%boot4-inputs))

(define-public %final-inputs
;; Final derivations used as implicit inputs by 'gnu-build-system'. We
;; still use 'package-with-bootstrap-guile' so that the bootstrap tools are
;; used for origins that have patches, thereby avoiding circular
;; dependencies.
(let ((finalize (compose package-with-bootstrap-guile
(cut package-with-explicit-inputs <> %boot4-inputs
(cut package-with-explicit-inputs <> %boot5-inputs
(current-source-location)))))
`(,@(map (match-lambda
((name package)
@@ -1122,11 +1193,11 @@ store.")
("xz" ,xz)
("diffutils" ,diffutils)
("patch" ,patch)
("coreutils" ,coreutils)
("sed" ,sed)
("grep" ,grep)
("findutils" ,findutils)
("gawk" ,gawk)))
("grep" ,grep-final)
("coreutils" ,coreutils-final)
("make" ,gnu-make-final)
("bash" ,bash-final)
("ld-wrapper" ,ld-wrapper)
@@ -1134,6 +1205,40 @@ store.")
("gcc" ,gcc-final)
("libc" ,glibc-final))))

(define-public canonical-package
(let ((name->package (fold (lambda (input result)
(match input
((_ package)
(vhash-cons (package-full-name package)
package result))))
vlist-null
`(("guile" ,guile-final)
,@%final-inputs))))
(lambda (package)
"Return the 'canonical' variant of PACKAGE---i.e., if PACKAGE is one of
the implicit inputs of 'gnu-build-system', return that one, otherwise return
PACKAGE.

The goal is to avoid duplication in cases like GUILE-FINAL vs. GUILE-2.0,
COREUTILS-FINAL vs. COREUTILS, etc."
;; XXX: This doesn't handle dependencies of the final inputs, such as
;; libunistring, GMP, etc.
(match (vhash-assoc (package-full-name package) name->package)
((_ . canon)
;; In general we want CANON, except if we're cross-compiling: CANON
;; uses explicit inputs, so it is "anchored" in the bootstrapped
;; process, with dependencies on things that cannot be
;; cross-compiled.
(if (%current-target-system)
package
canon))
(_ package)))))

;;;
;;; GCC toolchain.
;;;

(define (gcc-toolchain gcc)
"Return a complete toolchain for GCC."
(package


+ 8
- 2
gnu/packages/cross-base.scm View File

@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -76,7 +76,13 @@ GCC that does not target a libc; otherwise, target that libc."
target))
(source (origin (inherit (package-source gcc-4.8))
(patches
(list (search-patch "gcc-cross-environment-variables.patch")))))
(list (search-patch
"gcc-cross-environment-variables.patch")))))

;; For simplicity, use a single output. Otherwise libgcc_s & co. are not
;; found by default, etc.
(outputs '("out"))

(arguments
`(#:implicit-inputs? #f
#:modules ((guix build gnu-build-system)


+ 14
- 2
gnu/packages/gawk.scm View File

@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,13 +28,13 @@
(define-public gawk
(package
(name "gawk")
(version "4.1.0")
(version "4.1.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gawk/gawk-" version
".tar.xz"))
(sha256
(base32 "0hin2hswbbd6kd6i4zzvgciwpl5fba8d2s524z8y5qagyz3x010q"))))
(base32 "1nz83vpss8xv7m475sv4qhhj40g74nvcw0y9kwq9ds8wzfmcdm7g"))))
(build-system gnu-build-system)
(arguments
`(#:parallel-tests? #f ; test suite fails in parallel
@@ -54,6 +55,17 @@
'((substitute* "extension/Makefile.in"
(("^.*: check-for-shared-lib-support" match)
(string-append "### " match))))
'())

;; XXX FIXME gawk 4.1.1 was bootstrapped with a prerelease
;; libtool, which fails on MIPS in the absence of
;; /usr/bin/file. As a temporary workaround, we patch
;; the configure script to hardcode use of the little
;; endian N32 ABI on MIPS.
,@(if (equal? "mips64el-linux" (or (%current-target-system)
(%current-system)))
'((substitute* "extension/configure"
(("\\$emul") "elf32ltsmipn32")))
'())))
%standard-phases)))
(inputs `(("libsigsegv" ,libsigsegv)


+ 73
- 30
gnu/packages/gcc.scm View File

@@ -51,6 +51,14 @@ where the OS part is overloaded to denote a specific ABI---into GCC

(define-public gcc-4.7
(let* ((stripped? #t) ; TODO: make this a parameter
(install-target
(lambda ()
;; The 'install-strip' rule uses the native 'strip' instead of
;; 'TARGET-strip' when cross-compiling. Thus, use 'install' in that
;; case.
(if (and stripped? (not (%current-target-system)))
"install-strip"
"install")))
(maybe-target-tools
(lambda ()
;; Return the `_FOR_TARGET' variables that are needed when
@@ -79,6 +87,14 @@ where the OS part is overloaded to denote a specific ABI---into GCC

"--with-local-prefix=/no-gcc-local-prefix"

;; With a separate "lib" output, the build system
;; incorrectly guesses GPLUSPLUS_INCLUDE_DIR, so force
;; it. (Don't use a versioned sub-directory, that's
;; unnecessary.)
,(string-append "--with-gxx-include-dir="
(assoc-ref %outputs "out")
"/include/c++")

,(let ((libc (assoc-ref %build-inputs "libc")))
(if libc
(string-append "--with-native-system-header-dir=" libc
@@ -94,15 +110,21 @@ where the OS part is overloaded to denote a specific ABI---into GCC
(maybe-target-tools))))))
(package
(name "gcc")
(version "4.7.3")
(version "4.7.4")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gcc/gcc-"
version "/gcc-" version ".tar.bz2"))
(sha256
(base32
"1hx9h64ivarlzi4hxvq42as5m9vlr5cyzaaq4gzj4i619zmkfz1g"))))
"10k2k71kxgay283ylbbhhs51cl55zn2q38vj5pk4k950qdnirrlj"))))
(build-system gnu-build-system)

;; Separate out the run-time support libraries because all the
;; dynamic-linked objects depend on it.
(outputs '("out" ; commands, etc. (60+ MiB)
"lib")) ; libgcc_s, libgomp, etc. (15+ MiB)

(inputs `(("gmp" ,gmp)
("mpfr" ,mpfr)
("mpc" ,mpc)
@@ -119,32 +141,39 @@ where the OS part is overloaded to denote a specific ABI---into GCC
#:strip-binaries? ,stripped?
#:configure-flags ,(configure-flags)
#:make-flags
(let* ((libc (assoc-ref %build-inputs "libc"))
(libc-native (or (assoc-ref %build-inputs "libc-native")
libc)))
`(,@(if libc
(list (string-append "LDFLAGS_FOR_TARGET="
"-B" libc "/lib "
"-Wl,-dynamic-linker "
"-Wl," libc
,(glibc-dynamic-linker)))
'())

;; Native programs like 'genhooks' also need that right.
,(string-append "LDFLAGS="
"-Wl,-rpath=" libc-native "/lib "
"-Wl,-dynamic-linker "
"-Wl," libc-native ,(glibc-dynamic-linker))
,(string-append "BOOT_CFLAGS=-O2 "
,(if stripped? "-g0" "-g"))))
;; None of the flags below are needed when doing a Canadian cross.
;; TODO: Simplify this.
,(if (%current-target-system)
(if stripped?
''("CFLAGS=-g0 -O2")
''())
`(let* ((libc (assoc-ref %build-inputs "libc"))
(libc-native (or (assoc-ref %build-inputs "libc-native")
libc)))
`(,@(if libc
(list (string-append "LDFLAGS_FOR_TARGET="
"-B" libc "/lib "
"-Wl,-dynamic-linker "
"-Wl," libc
,(glibc-dynamic-linker)))
'())

;; Native programs like 'genhooks' also need that right.
,(string-append "LDFLAGS="
"-Wl,-rpath=" libc-native "/lib "
"-Wl,-dynamic-linker "
"-Wl," libc-native ,(glibc-dynamic-linker))
,(string-append "BOOT_CFLAGS=-O2 "
,(if stripped? "-g0" "-g")))))

#:tests? #f
#:phases
(alist-cons-before
'configure 'pre-configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(libc (assoc-ref inputs "libc")))
(let ((libdir (or (assoc-ref outputs "lib")
(assoc-ref outputs "out")))
(libc (assoc-ref inputs "libc")))
(when libc
;; The following is not performed for `--without-headers'
;; cross-compiler builds.
@@ -170,7 +199,7 @@ where the OS part is overloaded to denote a specific ABI---into GCC
;; <http://sourceware.org/ml/libc-help/2013-11/msg00023.html>.)
(format #f "#define GNU_USER_TARGET_LIB_SPEC \
\"-L~a/lib %{!static:-rpath=~a/lib %{!static-libgcc:-rpath=~a/lib64 -rpath=~a/lib -lgcc_s}} \" ~a"
libc libc out out suffix))
libc libc libdir libdir suffix))
(("#define GNU_USER_TARGET_STARTFILE_SPEC.*$" line)
(format #f "#define STANDARD_STARTFILE_PREFIX_1 \"~a/lib\"
#define STANDARD_STARTFILE_PREFIX_2 \"\"
@@ -180,7 +209,24 @@ where the OS part is overloaded to denote a specific ABI---into GCC
;; Don't retain a dependency on the build-time sed.
(substitute* "fixincludes/fixincl.x"
(("static char const sed_cmd_z\\[\\] =.*;")
"static char const sed_cmd_z[] = \"sed\";"))))
"static char const sed_cmd_z[] = \"sed\";"))

;; Move libstdc++*-gdb.py to the "lib" output to avoid a
;; circularity between "out" and "lib". (Note:
;; --with-python-dir is useless because it imposes $(prefix) as
;; the parent directory.)
(substitute* "libstdc++-v3/python/Makefile.in"
(("pythondir = .*$")
(string-append "pythondir = " libdir "/share"
"/gcc-$(gcc_version)/python\n")))

;; Avoid another circularity between the outputs: this #define
;; ends up in auto-host.h in the "lib" output, referring to
;; "out". (This variable is used to augment cpp's search path,
;; but there's nothing useful to look for here.)
(substitute* "gcc/config.in"
(("PREFIX_INCLUDE_DIR")
"PREFIX_INCLUDE_DIR_isnt_necessary_here"))))

(alist-cons-after
'configure 'post-configure
@@ -193,10 +239,7 @@ where the OS part is overloaded to denote a specific ABI---into GCC
(alist-replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(zero?
(system* "make"
,(if stripped?
"install-strip"
"install"))))
(system* "make" ,(install-target))))
%standard-phases)))))

(native-search-paths
@@ -218,14 +261,14 @@ Go. It also includes runtime support libraries for these languages.")

(define-public gcc-4.8
(package (inherit gcc-4.7)
(version "4.8.2")
(version "4.8.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gcc/gcc-"
version "/gcc-" version ".tar.bz2"))
(sha256
(base32
"1j6dwgby4g3p3lz7zkss32ghr45zpdidrg8xvazvn91lqxv25p09"))))))
"07hg10zs7gnqz58my10ch0zygizqh0z0bz6pv4pgxx45n48lz3ka"))))))

(define-public gcc-4.9
(package (inherit gcc-4.7)


+ 19
- 15
gnu/packages/gettext.scm View File

@@ -34,37 +34,41 @@
(define-public gnu-gettext
(package
(name "gettext")
(version "0.18.3.2")
(version "0.19.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/gettext/gettext-"
version ".tar.gz"))
(sha256
(base32
"1my5njl7mp663abpdn8qsm5i462wlhlnb5q50fmhgd0fsr9f996i"))))
"1ih104j74dw90cb18ym50qlks3k6632zsiv2c94fnpyzbgcp2x18"))))
(build-system gnu-build-system)
(inputs
`(("expat" ,expat)))
(arguments
`(#:phases (alist-cons-before
'configure 'link-expat
(lambda _
(substitute* "gettext-tools/configure"
(("LIBEXPAT=\"-ldl\"") "LIBEXPAT=\"-ldl -lexpat\"")
(("LTLIBEXPAT=\"-ldl\"") "LTLIBEXPAT=\"-ldl -lexpat\"")))
(alist-cons-before
'check 'patch-tests
(lambda* (#:key inputs #:allow-other-keys)
(let ((bash (which "sh")))
(substitute* (find-files "gettext-tools/tests"
"^msgexec-[0-9]")
(let* ((bash (which "sh")))
(substitute*
(find-files "gettext-tools/tests"
"^(lang-sh|msg(exec|filter)-[0-9])")
(("#![[:blank:]]/bin/sh")
(format #f "#!~a" bash)))
(substitute* (find-files "gettext-tools/gnulib-tests"
"posix_spawn")

(substitute* (cons "gettext-tools/src/msginit.c"
(find-files "gettext-tools/gnulib-tests"
"posix_spawn"))
(("/bin/sh")
bash))))
%standard-phases))))
bash))

(substitute* "gettext-tools/src/project-id"
(("/bin/pwd")
"pwd"))))
%standard-phases)

;; When tests fail, we want to know the details.
#:make-flags '("VERBOSE=yes")))
(home-page "http://www.gnu.org/software/gettext/")
(synopsis "Tools and documentation for translation")
(description


+ 2
- 1
gnu/packages/guile.scm View File

@@ -242,7 +242,8 @@ many readers as needed).")
version ".tar.gz"))
(sha256
(base32
"070wl664lsm14hb6y9ch97x9q6cns4k6nxgdzbdzi5byixn74899"))))
"070wl664lsm14hb6y9ch97x9q6cns4k6nxgdzbdzi5byixn74899"))
(patches (list (search-patch "guile-ncurses-tests.patch")))))
(build-system gnu-build-system)
(inputs `(("ncurses" ,ncurses)
("guile" ,guile-2.0)))


+ 4
- 3
gnu/packages/icu4c.scm View File

@@ -28,7 +28,7 @@
(define-public icu4c
(package
(name "icu4c")
(version "52.1")
(version "53.1")
(source (origin
(method url-fetch)
(uri (string-append "http://download.icu-project.org/files/icu4c/"
@@ -36,8 +36,9 @@
"/icu4c-"
(string-map (lambda (x) (if (char=? x #\.) #\_ x)) version)
"-src.tgz"))
(sha256 (base32
"14l0kl17nirc34frcybzg0snknaks23abhdxkmsqg3k9sil5wk9g"))))
(sha256
(base32 "0a4sg9w054640zncb13lhrcjqn7yg1qilwd1mczc4w60maslz9vg"))
(patches (list (search-patch "icu4c-test-date-format.patch")))))
(build-system gnu-build-system)
(inputs
`(("patchelf" ,patchelf)


+ 6
- 1
gnu/packages/libunistring.scm View File

@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -36,6 +36,11 @@
"18q620269xzpw39dwvr9zpilnl2dkw5z5kz3mxaadnpv4k3kw3b1"))))
(propagated-inputs '()) ; FIXME: add libiconv when !glibc
(build-system gnu-build-system)
(arguments
;; Work around parallel build issue whereby C files may be compiled before
;; config.h is built: see <http://hydra.gnu.org/build/59381/nixlog/2/raw> and
;; <http://lists.openembedded.org/pipermail/openembedded-core/2012-April/059850.html>.
'(#:parallel-build? #f))
(synopsis "C library for manipulating Unicode strings")
(description
"GNU libunistring is a library providing functions to manipulate


+ 9
- 3
gnu/packages/linux.scm View File

@@ -156,7 +156,7 @@
(license gpl2+)))

(define-public linux-libre
(let* ((version "3.13.7")
(let* ((version "3.15")
(build-phase
'(lambda* (#:key system #:allow-other-keys #:rest args)
(let ((arch (car (string-split system #\-))))
@@ -219,7 +219,7 @@
(uri (linux-libre-urls version))
(sha256
(base32
"0j28dg0zq4vlbk4ady4fq021i8dxx2h8h90n26mzigr9hky86n8d"))))
"125n04rwqmr3bm9slk62w6xcg355hx85rwv2x16nl6qki70hsick"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)
("bc" ,bc)
@@ -1137,7 +1137,13 @@ system.")
version ".tar.gz"))
(sha256
(base32
"0c34b0za2v0934acvgnva0vaqpghmmhz4zh7k0m9jd4mbc91byqm"))))
"0c34b0za2v0934acvgnva0vaqpghmmhz4zh7k0m9jd4mbc91byqm"))
(modules '((guix build utils)))
(snippet
'(substitute* "tests/Makefile.in"
;; The '%: %.in' rule incorrectly uses @VERSION@.
(("@VERSION@")
"[@]VERSION[@]")))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-before


+ 24
- 7
gnu/packages/make-bootstrap.scm View File

@@ -103,6 +103,7 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
,@%final-inputs))
`(("libc" ,(glibc-for-bootstrap))
("gcc" ,(package (inherit gcc-4.8)
(outputs '("out")) ; all in one so libgcc_s is easily found
(inputs
`(("libc",(glibc-for-bootstrap))
,@(package-inputs gcc-4.8)))))
@@ -393,6 +394,7 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
(package-with-relocatable-glibc
(package (inherit gcc-4.8)
(name "gcc-static")
(outputs '("out")) ; all in one
(arguments
`(#:modules ((guix build utils)
(guix build gnu-build-system)
@@ -404,9 +406,20 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
((#:implicit-inputs? _) #t)
((#:configure-flags flags)
`(append (list
;; We don't need a full bootstrap here.
"--disable-bootstrap"

;; Make sure '-static' is passed where it matters.
"--with-stage1-ldflags=-static"

;; GCC 4.8+ requires a C++ compiler and library.
"--enable-languages=c,c++"

;; Make sure gcc-nm doesn't require liblto_plugin.so.
"--disable-lto"

"--disable-shared"
"--disable-plugin"
"--enable-languages=c"
"--disable-libmudflap"
"--disable-libatomic"
"--disable-libsanitizer"
@@ -416,11 +429,7 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
"--disable-libquadmath"
"--disable-decimal-float")
(remove (cut string-match "--(.*plugin|enable-languages)" <>)
,flags)))
((#:make-flags flags)
(if (%current-target-system)
`(cons "LDFLAGS=-static" ,flags)
`(cons "BOOT_LDFLAGS=-static" ,flags))))))
,flags))))))
(native-inputs
(if (%current-target-system)
`(;; When doing a Canadian cross, we need GMP/MPFR/MPC both
@@ -442,6 +451,7 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
(name "gcc-stripped")
(build-system trivial-build-system)
(source #f)
(outputs '("out")) ;only one output
(arguments
`(#:modules ((guix build utils))
#:builder
@@ -475,7 +485,14 @@ for `sh' in $PATH, and without nscd, and with static NSS modules."
;; (‘genchecksum’, ‘gcc-nm’, etc.) rely on C++ headers.
(copy-recursively (string-append gcc "/include/c++")
(string-append includedir "/c++"))
#t))))

;; For native builds, check whether the binaries actually work.
,(if (%current-target-system)
'#t
'(every (lambda (prog)
(zero? (system* (string-append gcc "/bin/" prog)
"--version")))
'("gcc" "g++" "cpp")))))))
(inputs `(("gcc" ,%gcc-static)))))

(define %guile-static


+ 2
- 2
gnu/packages/multiprecision.scm View File

@@ -27,7 +27,7 @@
(define-public gmp
(package
(name "gmp")
(version "5.1.3")
(version "6.0.0a")
(source (origin
(method url-fetch)
(uri
@@ -35,7 +35,7 @@
version ".tar.xz"))
(sha256
(base32
"0wbhn3wih61vjcs94q531fipfvvzqfq2v4qr03rl3xaggyiyvqny"))))
"0r5pp27cy7ch3dg5v0rsny8bib1zfvrza6027g2mp5f6v8pd6mli"))))
(build-system gnu-build-system)
(native-inputs `(("m4" ,m4)))
(outputs '("out" "debug"))


+ 6
- 2
gnu/packages/ncurses.scm View File

@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -52,7 +52,6 @@
(("cross_compiling:=no")
"cross_compiling:=yes"))))
(post-install-phase
;; FIXME: The `tic' binary lacks a RUNPATH; fix it.
'(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
;; When building a wide-character (Unicode) build, create backward
@@ -105,6 +104,11 @@
,(string-append "--mandir=" (assoc-ref %outputs "out")
"/share/man")

;; Make sure programs like 'tic', 'reset', and 'clear' have a
;; correct RUNPATH.
,(string-append "LDFLAGS=-Wl,-rpath=" (assoc-ref %outputs "out")
"/lib")

;; C++ bindings fail to build on
;; `i386-pc-solaris2.11' with GCC 3.4.3:
;; <http://bugs.opensolaris.org/bugdatabase/view_bug.do?bug_id=6395191>.


+ 15
- 0
gnu/packages/patches/guile-ncurses-tests.patch View File

@@ -0,0 +1,15 @@
The wide test files are missing from the tarball, so ignore them.
Reported at <https://lists.gnu.org/archive/html/bug-guile-ncurses/2014-06/msg00000.html>.

--- guile-ncurses-1.4/test/Makefile.in 2013-04-27 17:55:19.000000000 +0200
+++ guile-ncurses-1.4/test/Makefile.in 2014-06-16 21:39:40.000000000 +0200
@@ -258,8 +258,7 @@ m011_menu_options.test slk_001_init.test
slk_003_init.test slk_004_init.test slk_005_demo.test \
slk_006_attributes.test
-WIDETESTS = r037_border_set.test r038_get_wch.test r039_get_wstr.test \
-r040_term_attrs.test
+WIDETESTS =
TESTS = $(NOTERMTESTS) $(am__append_1) $(am__append_2)
EXTRA_DIST = $(TESTLIB) $(TESTS)

+ 17
- 0
gnu/packages/patches/icu4c-test-date-format.patch View File

@@ -0,0 +1,17 @@
Starting with the switch to GCC 4.8.3, we observed this test failure.
Changing "34" to "134" means that we expect the date to be parsed as
"2034", not "1934", which seems consistent with the line above.

Reported at <http://bugs.icu-project.org/trac/ticket/10960>.

--- icu/source/test/intltest/dtfmttst.cpp 2014-06-16 10:35:46.000000000 +0200
+++ icu/source/test/intltest/dtfmttst.cpp 2014-06-16 10:35:52.000000000 +0200
@@ -1129,7 +1129,7 @@ DateFormatTest::TestTwoDigitYear()
return;
}
parse2DigitYear(fmt, "5/6/17", date(117, UCAL_JUNE, 5));
- parse2DigitYear(fmt, "4/6/34", date(34, UCAL_JUNE, 4));
+ parse2DigitYear(fmt, "4/6/34", date(134, UCAL_JUNE, 4));
}
// -------------------------------------

+ 3
- 8
gnu/packages/qemu.scm View File

@@ -34,7 +34,6 @@
#:use-module (gnu packages libjpeg)
#:use-module (gnu packages attr)
#:use-module (gnu packages linux)
#:use-module (gnu packages samba)
#:use-module (gnu packages xorg)
#:use-module (gnu packages gl)
#:use-module (gnu packages sdl)
@@ -59,8 +58,7 @@
(lambda* (#:key inputs outputs #:allow-other-keys)
;; The `configure' script doesn't understand some of the
;; GNU options. Thus, add a new phase that's compatible.
(let ((out (assoc-ref outputs "out"))
(samba (assoc-ref inputs "samba")))
(let ((out (assoc-ref outputs "out")))
(setenv "SHELL" (which "bash"))

;; While we're at it, patch for tests.
@@ -74,9 +72,7 @@
(string-append "--cc=" (which "gcc"))
"--disable-debug-info" ; save build space
"--enable-virtfs" ; just to be sure
(string-append "--prefix=" out)
(string-append "--smbd=" samba
"/sbin/smbd")))))
(string-append "--prefix=" out)))))
(alist-cons-after
'install 'install-info
(lambda* (#:key inputs outputs #:allow-other-keys)
@@ -108,8 +104,7 @@
;; ("pciutils" ,pciutils)
("alsa-lib" ,alsa-lib)
("zlib" ,zlib)
("attr" ,attr)
("samba" ,samba))) ; an optional dependency
("attr" ,attr)))
(native-inputs `(("pkg-config" ,pkg-config)
("python" ,python-2) ; incompatible with Python 3 according to error message
("texinfo" ,texinfo)


+ 6
- 1
gnu/packages/tor.scm View File

@@ -94,7 +94,12 @@ rejects UDP traffic from the application you're using.")
"1f6xb7aa47p90c26vqaw74y6drs9gpnhxsgby3mx0awdjh0ydisy"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-before
'(;; The default 'sysconfdir' is $out/etc; change that to
;; $out/etc/privoxy.
#:configure-flags (list (string-append "--sysconfdir="
(assoc-ref %outputs "out")
"/etc/privoxy"))
#:phases (alist-cons-before
'configure 'autoconf
(lambda _
;; Unfortunately, this is not a tarball produced by


+ 10
- 6
gnu/system.scm View File

@@ -216,12 +216,16 @@ explicitly appear in OS."
(define %base-packages
;; Default set of packages globally visible. It should include anything
;; required for basic administrator tasks.
(list bash coreutils findutils grep sed
procps psmisc less zile
guile-final (@ (gnu packages admin) dmd) guix
util-linux inetutils isc-dhcp
net-tools ; XXX: remove when Inetutils suffices
module-init-tools kbd))
(cons* procps psmisc less zile
guile-final (@ (gnu packages admin) dmd) guix
util-linux inetutils isc-dhcp
net-tools ; XXX: remove when Inetutils suffices
module-init-tools kbd

;; The packages below are also in %FINAL-INPUTS, so take them from
;; there to avoid duplication.
(map canonical-package
(list bash coreutils findutils grep sed))))

(define %default-issue
;; Default contents for /etc/issue.


+ 11
- 1
guix/build-system/gnu.scm View File

@@ -33,7 +33,8 @@
package-with-extra-configure-variable
static-libgcc-package
static-package
dist-package))
dist-package
package-with-restricted-references))

;; Commentary:
;;
@@ -190,6 +191,15 @@ runs `make distcheck' and whose result is one or more source tarballs."
("gettext" ,(ref '(gnu packages gettext) 'gnu-gettext))
("texinfo" ,(ref '(gnu packages texinfo) 'texinfo))))))))

(define (package-with-restricted-references p refs)
"Return a package whose outputs are guaranteed to only refer to the packages
listed in REFS."
(if (eq? (package-build-system p) gnu-build-system) ; XXX: dirty
(package (inherit p)
(arguments `(#:allowed-references ,refs
,@(package-arguments p))))
p))

(define %store
;; Store passed to STANDARD-INPUTS.


+ 5
- 1
guix/build/gnu-build-system.scm View File

@@ -97,7 +97,11 @@ working directory."
(begin
(mkdir "source")
(chdir "source")
(copy-recursively source ".")

;; Preserve timestamps (set to the Epoch) on the copied tree so that
;; things work deterministically.
(copy-recursively source "."
#:keep-mtime? #t)
#t)
(and (zero? (system* "tar" "xvf" source))
(chdir (first-subdirectory ".")))))


+ 37
- 24
guix/build/utils.scm View File

@@ -134,9 +134,12 @@ return values of applying PROC to the port."
(define* (copy-recursively source destination
#:key
(log (current-output-port))
(follow-symlinks? #f))
(follow-symlinks? #f)
keep-mtime?)
"Copy SOURCE directory to DESTINATION. Follow symlinks if FOLLOW-SYMLINKS?
is true; otherwise, just preserve them. Write verbose output to the LOG port."
is true; otherwise, just preserve them. When KEEP-MTIME? is true, keep the
modification time of the files in SOURCE on those of DESTINATION. Write
verbose output to the LOG port."
(define strip-source
(let ((len (string-length source)))
(lambda (file)
@@ -152,10 +155,15 @@ is true; otherwise, just preserve them. Write verbose output to the LOG port."
(let ((target (readlink file)))
(symlink target dest)))
(else
(copy-file file dest)))))
(copy-file file dest)
(when keep-mtime?
(set-file-time dest stat))))))
(lambda (dir stat result) ; down
(mkdir-p (string-append destination
(strip-source dir))))
(let ((target (string-append destination
(strip-source dir))))
(mkdir-p target)
(when keep-mtime?
(set-file-time target stat))))
(lambda (dir stat result) ; up
result)
(const #t) ; skip
@@ -170,25 +178,30 @@ is true; otherwise, just preserve them. Write verbose output to the LOG port."
stat
lstat)))

(define (delete-file-recursively dir)
"Delete DIR recursively, like `rm -rf', without following symlinks. Report
but ignore errors."
(file-system-fold (const #t) ; enter?
(lambda (file stat result) ; leaf
(delete-file file))
(const #t) ; down
(lambda (dir stat result) ; up
(rmdir dir))
(const #t) ; skip
(lambda (file stat errno result)
(format (current-error-port)
"warning: failed to delete ~a: ~a~%"
file (strerror errno)))
#t
dir

;; Don't follow symlinks.
lstat))
(define* (delete-file-recursively dir
#:key follow-mounts?)
"Delete DIR recursively, like `rm -rf', without following symlinks. Don't
follow mount points either, unless FOLLOW-MOUNTS? is true. Report but ignore
errors."
(let ((dev (stat:dev (lstat dir))))
(file-system-fold (lambda (dir stat result) ; enter?
(or follow-mounts?
(= dev (stat:dev stat))))
(lambda (file stat result) ; leaf
(delete-file file))
(const #t) ; down
(lambda (dir stat result) ; up
(rmdir dir))
(const #t) ; skip
(lambda (file stat errno result)
(format (current-error-port)
"warning: failed to delete ~a: ~a~%"
file (strerror errno)))
#t
dir

;; Don't follow symlinks.
lstat)))

(define (find-files dir regexp)
"Return the lexicographically sorted list of files under DIR whose basename


+ 9
- 3
guix/scripts/substitute-binary.scm View File

@@ -592,9 +592,14 @@ Internal tool to substitute a pre-built binary to a local build.\n"))
(let ((key (call-with-input-file %public-key-file
(compose string->canonical-sexp
get-string-all))))
(equal? (acl->public-keys acl) (list key)))))

(let ((acl (current-acl)))
(match acl
((thing)
(equal? (canonical-sexp->string thing)
(canonical-sexp->string key)))
(_
#f)))))

(let ((acl (acl->public-keys (current-acl))))
(when (or (null? acl) (singleton? acl))
(warning (_ "ACL for archive imports seems to be uninitialized, \
substitutes may be unavailable\n")))))
@@ -603,6 +608,7 @@ substitutes may be unavailable\n")))))
"Implement the build daemon's substituter protocol."
(mkdir-p %narinfo-cache-directory)
(maybe-remove-expired-cached-narinfo)
(check-acl-initialized)

;; Starting from commit 22144afa in Nix, we are allowed to bail out directly
;; when we know we cannot substitute, but we must emit a newline on stdout


+ 7
- 3
guix/scripts/system.scm View File

@@ -100,9 +100,13 @@ When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG."

(if (string=? target "/")
(warning (_ "initializing the current root file system~%"))
;; Copy items to the new store.
(for-each (cut copy-closure store <> target #:log-port log-port)
to-copy))
(begin
;; Make sure the target store exists.
(mkdir-p (string-append target (%store-prefix)))

;; Copy items to the new store.
(for-each (cut copy-closure store <> target #:log-port log-port)
to-copy)))

;; Create a bunch of additional files.
(format log-port "populating '~a'...~%" target)


Write Preview
Loading…
Cancel
Save