1
0
forked from tribes/guix

Compare commits

..

6 Commits

Author SHA1 Message Date
Ludovic Courtès 0602d92bb0 DRAFT gexp: Turn grafting into a build continuation.
TODO: See FIXME in gexp.scm.

* guix/gexp.scm (gexp->derivation): Rename 'graft?' local variable to
'prev-graft?' and call (set-grafting? #f) unconditionally.  When GRAFT?
is true, call 'set-build-continuation' for DRV.
* guix/grafts.scm (graft-derivation*, graft-continuation): New
procedures.
* tests/gexp.scm ("gexp-grafts"): Remove test that is now obsolete.
2017-01-11 10:13:32 +01:00
Ludovic Courtès ca9050d517 ui: Remove 'show-derivation-outputs'.
* guix/ui.scm (show-derivation-outputs): Remove.
2017-01-11 10:13:32 +01:00
Ludovic Courtès 0c8491cbbe Callers of 'build-derivations' & co. now honor its result.
* guix/profiles.scm (link-to-empty-profile): Use the result of
'build-derivations' instead of calling 'derivation->output-path'.
* guix/scripts.scm (build-package): Likewise, and use 'format' directly
instead of 'show-derivation-outputs'.
(build-package-source): Likewise.
* guix/scripts/archive.scm (export-from-store): Use result of
'build-derivations'.
* guix/scripts/build.scm (guix-build): Likewise.  Use 'format' instead
of 'show-derivation-outputs'.
* guix/scripts/copy.scm (send-to-remote-host): Use result of
'build-derivations'.
* guix/scripts/package.scm (build-and-use-profile): Likewise.
* guix/upstream.scm (download-tarball): Likewise.
* guix/scripts/system.scm (reinstall-grub): Likewise.
(perform-action): Use result of 'maybe-build'.
2017-01-11 10:13:32 +01:00
Ludovic Courtès c490a0b037 DRAFT store: Add support for build continuations.
TODO: Add tests; update guix.texi.

* guix/store.scm (<nix-server>)[continuations]: New field.
(open-connection): Adjust accordingly.
(set-build-continuation!, build-continuation): New procedures.
(build-things): Rename to...
(%build-things): ... this.
(build-things, set-build-continuation): New procedures.
* guix/derivations.scm (build-derivations): Add #:continuation?
parameter and pass it to 'built-things'.  Convert the return value to a
list of store items.
2017-01-11 10:13:32 +01:00
Ludovic Courtès ea7b5a8f3d gexp: Compilers can now provide a procedure returning applicable grafts.
* guix/gexp.scm (<gexp-compiler>)[grafts]: New field.
(default-applicable-grafts, lookup-graft-procedure)
(propagated-applicable-grafts): New procedures.
(define-gexp-compiler): Support 'applicable-grafts' form.
(computed-file-compiler, program-file-compiler)
(scheme-file-compiler, file-append-compiler): Add 'applicable-grafts'
form.
(gexp-grafts): New procedure.
* guix/packages.scm (replacement-graft*): New procedure.
(package-compiler): Add 'applicable-grafts' form.
* tests/gexp.scm ("gexp-grafts"): New test.
2017-01-11 10:11:46 +01:00
Ludovic Courtès 2c13d74181 packages: Factorize computation of the replacement graft.
* guix/packages.scm (replacement-graft, replacement-cross-graft): New
procedures.
(input-graft): Use 'replacement-graft'.
(input-cross-graft): Use 'replacement-cross-graft'.
2017-01-11 09:42:18 +01:00
1119 changed files with 43496 additions and 209930 deletions
+1 -12
View File
@@ -17,20 +17,13 @@
(eval . (put 'call-with-prompt 'scheme-indent-function 1))
(eval . (put 'test-assert 'scheme-indent-function 1))
(eval . (put 'test-assertm 'scheme-indent-function 1))
(eval . (put 'test-equalm 'scheme-indent-function 1))
(eval . (put 'test-equal 'scheme-indent-function 1))
(eval . (put 'test-eq 'scheme-indent-function 1))
(eval . (put 'call-with-input-string 'scheme-indent-function 1))
(eval . (put 'guard 'scheme-indent-function 1))
(eval . (put 'lambda* 'scheme-indent-function 1))
(eval . (put 'substitute* 'scheme-indent-function 1))
;; 'modify-phases' and its keywords.
(eval . (put 'modify-phases 'scheme-indent-function 1))
(eval . (put 'replace 'scheme-indent-function 1))
(eval . (put 'add-before 'scheme-indent-function 2))
(eval . (put 'add-after 'scheme-indent-function 2))
(eval . (put 'modify-services 'scheme-indent-function 1))
(eval . (put 'with-directory-excursion 'scheme-indent-function 1))
(eval . (put 'package 'scheme-indent-function 0))
@@ -59,8 +52,6 @@
(eval . (put 'with-derivation-narinfo 'scheme-indent-function 1))
(eval . (put 'with-derivation-substitute 'scheme-indent-function 2))
(eval . (put 'mlambda 'scheme-indent-function 1))
(eval . (put 'mlambdaq 'scheme-indent-function 1))
(eval . (put 'syntax-parameterize 'scheme-indent-function 1))
(eval . (put 'with-monad 'scheme-indent-function 1))
(eval . (put 'mbegin 'scheme-indent-function 1))
@@ -75,10 +66,8 @@
(eval . (put 'call-with-container 'scheme-indent-function 1))
(eval . (put 'container-excursion 'scheme-indent-function 1))
(eval . (put 'eventually 'scheme-indent-function 1))
(eval . (put 'call-with-progress-reporter 'scheme-indent-function 1))
;; Recognize '~', '+', and '$', as used for gexps, as quotation symbols.
;; This notably allows '(' in Paredit to not insert a space when the
;; preceding symbol is one of these.
(eval . (modify-syntax-entry ?~ "'"))
+5 -6
View File
@@ -6,14 +6,11 @@
*.tar.xz
*.tmp
*~
.#*
\#*\#
,*
/ABOUT-NLS
/INSTALL
/aclocal.m4
/autom4te.cache
/build-aux/ar-lib
/build-aux/compile
/build-aux/config.guess
/build-aux/config.rpath
@@ -33,7 +30,6 @@
/doc/guix.cps
/doc/guix.fn
/doc/guix.fns
/doc/guix.html
/doc/guix.info
/doc/guix.info-[0-9]
/doc/guix.ky
@@ -47,6 +43,11 @@
/doc/os-config-desktop.texi
/doc/stamp-vti
/doc/version.texi
/emacs/Makefile
/emacs/Makefile.in
/emacs/guix-autoloads.el
/emacs/guix-config.el
/emacs/guix-helper.scm
/etc/guix-daemon.conf
/etc/guix-daemon.service
/etc/guix-publish.conf
@@ -127,5 +128,3 @@ stamp-h[0-9]
tmp
/doc/os-config-lightweight-desktop.texi
/nix/scripts/download
/etc/indent-code.el
/.version
+6 -15
View File
@@ -1,7 +1,6 @@
# This list is used to avoid multiple name/email instances of the same
# contributors reported by "git log" and "git shortlog" commands.
Adriano Peluso <catonano@gmail.com>
Al McElrath <hello@yrns.org> <hello@atonesir.com>
Alex Sassmannshausen <alex@pompo.co> <alex.sassmannshausen@gmail.com>
Alexander I. Grafov <grafov@gmail.com>
@@ -33,26 +32,19 @@ Joshua Grant <tadni@riseup.net> <gzg@riseup.net>
Joshua Grant <tadni@riseup.net> <jgrant@parenthetical.io>
Joshua Grant <tadni@riseup.net> <tadnimi@gmail.com>
Joshua Grant <tadni@riseup.net> <youlysses@riseup.net>
Kei Kebreau <kei@openmailbox.org> <kkebreau@posteo.net>
Kei Kebreau <kei@openmailbox.org>
Leo Famulari <leo@famulari.name> <lfamular@gmail.com>
Ludovic Courtès <ludo@gnu.org> <ludovic.courtes@inria.fr>
Marek Benc <dusxmt@gmx.com> <merkur32@gmail.com>
Marius Bakke <mbakke@fastmail.com> <m.bakke@warwick.ac.uk>
Mathieu Lirzin <mthl@gnu.org> <mthl@openmailbox.org>
Mathieu Lirzin <mthl@gnu.org> <mathieu.lirzin@openmailbox.org>
Mathieu Othacehe <m.othacehe@gmail.com>
Nikita Karetnikov <nikita@karetnikov.org> <nikita.karetnikov@gmail.com>
ng0 <ng0@n0.is>
ng0 <ng0@n0.is> <ng0@infotropique.org>
ng0 <ng0@n0.is> <ng0@no-reply.infotropique.org>
ng0 <ng0@n0.is> <ng0@no-reply.pragmatique.xyz>
ng0 <ng0@n0.is> <ng0@pragmatique.xyz>
ng0 <ng0@n0.is> <contact.ng0@cryptolab.net>
ng0 <ng0@n0.is> <ng0@we.make.ritual.n0.is>
ng0 <ng0@n0.is> <ngillmann@runbox.com>
ng0 <ng0@n0.is> <niasterisk@grrlz.net>
ng0 <ng0@n0.is> <ng@niasterisk.space>
ng0 <ng0@n0.is> <ng0@libertad.pw>
ng0 <ng0@libertad.pw> <ng0@we.make.ritual.n0.is>
ng0 <ng0@libertad.pw> <ngillmann@runbox.com>
ng0 <ng0@libertad.pw> <niasterisk@grrlz.net>
ng0 <ng0@libertad.pw> <ng@niasterisk.space>
ng0 <ng0@libertad.pw>
Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public01@thebird.nl>
Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public12@thebird.nl>
Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public12@email>
@@ -66,7 +58,6 @@ Sou Bunnbu (宋文武) <iyzsong@gmail.com>
Sou Bunnbu (宋文武) <iyzsong@gmail.com> <iyzsong@member.fsf.org>
Stefan Reichör <stefan@xsteve.at>
Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
Theodoros Foradis <theodoros.for@openmailbox.org> <theodoros@foradis.org>
Thomas Danckaert <thomas.danckaert@gmail.com> <post@thomasdanckaert.be>
Tobias Geerinckx-Rice <me@tobias.gr> <tobias.geerinckx.rice@gmail.com>
Tomáš Čech <sleep_walker@gnu.org> <sleep_walker@suse.cz>
+9 -26
View File
@@ -2,10 +2,9 @@
#+TITLE: Hacking GNU Guix and Its Incredible Distro
Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
Copyright © 2015, 2017 Mathieu Lirzin <mthl@gnu.org>
Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
Copyright © 2017 Leo Famulari <leo@famulari.name>
Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
Copying and distribution of this file, with or without modification,
are permitted in any medium without royalty provided the copyright
@@ -15,7 +14,7 @@ Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
See the manual for useful hacking informations, either by running
info -f doc/guix.info "Contributing"
info -f doc/guix.info "(guix) Contributing"
or by checking the [[http://www.gnu.org/software/guix/manual/guix.html#Contributing][web copy of the manual]].
@@ -26,10 +25,8 @@ convenient. When you deem it necessary, feel free to ask for it on the
mailing list. When you get commit access, please make sure to follow the
policy below (discussions of the policy can take place on guix-devel@gnu.org.)
Non-trivial patches should always be posted to guix-patches@gnu.org (trivial
patches include fixing typos, etc.) This mailing list fills the
patch-tracking database at [[https://bugs.gnu.org/guix-patches]]; see
"Contributing" in the manual for details.
Non-trivial patches should always be posted to guix-devel@gnu.org (trivial
patches include fixing typos, etc.)
For patches that just add a new package, and a simple one, its OK to commit,
if youre confident (which means you successfully built it in a chroot setup,
@@ -47,27 +44,13 @@ configure Git to automatically sign commits, run:
git config commit.gpgsign true
git config user.signingkey CABBA6EA1DC0FF33
You can prevent yourself from accidentally pushing unsigned commits to
Savannah by using the pre-push Git hook called located at etc/git/pre-push:
You can prevent yourself from accidentally pushing unsigned commits to Savannah
by using the pre-push Git hook called 'pre-push'. It's located at
'etc/git/pre-push'.
cp etc/git/pre-push .git/hooks/pre-push
When pushing a commit on behalf of somebody else, please add a Signed-off-by
line at the end of the commit log message (e.g. with git am --signoff).
This improves tracking of who did what.
For anything else, please post to guix-patches@gnu.org and leave time for a
For anything else, please post to guix-devel@gnu.org and leave time for a
review, without committing anything. If you didnt receive any reply
after two weeks, and if youre confident, its OK to commit.
That last part is subject to being adjusted, allowing individuals to commit
directly on non-controversial changes on parts theyre familiar with.
* Using emacs-debbugs
Bug reports and patches are tracked using debbugs. If you are on emacs, you
can use emacs-debbugs.
List all open bug reports on guix-patches with
C-u M-x debbugs-gnu <RET> <RET> guix-patches <RET> n y
+55 -246
View File
@@ -1,14 +1,9 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
# Copyright © 2015, 2017 Alex Kost <alezost@gmail.com>
# Copyright © 2015 Alex Kost <alezost@gmail.com>
# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
# Copyright © 2016, 2017 Mark H Weaver <mhw@netris.org>
# Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
# Copyright © 2017 Leo Famulari <leo@famulari.name>
# Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
# Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
# Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
# Copyright © 2016 Mark H Weaver <mhw@netris.org>
#
# This file is part of GNU Guix.
#
@@ -32,14 +27,9 @@ nodist_noinst_SCRIPTS = \
pre-inst-env \
test-env
# Modules that are not compiled but are installed nonetheless, such as
# build-side modules with unusual dependencies.
MODULES_NOT_COMPILED =
include gnu/local.mk
MODULES = \
guix/base16.scm \
guix/base32.scm \
guix/base64.scm \
guix/cpio.scm \
@@ -48,14 +38,11 @@ MODULES = \
guix/hash.scm \
guix/pk-crypto.scm \
guix/pki.scm \
guix/progress.scm \
guix/combinators.scm \
guix/memoization.scm \
guix/utils.scm \
guix/sets.scm \
guix/modules.scm \
guix/download.scm \
guix/discovery.scm \
guix/git-download.scm \
guix/hg-download.scm \
guix/monads.scm \
@@ -69,22 +56,14 @@ MODULES = \
guix/gnu-maintenance.scm \
guix/upstream.scm \
guix/licenses.scm \
guix/git.scm \
guix/graph.scm \
guix/cache.scm \
guix/cve.scm \
guix/workers.scm \
guix/zlib.scm \
guix/build-system.scm \
guix/build-system/ant.scm \
guix/build-system/cargo.scm \
guix/build-system/cmake.scm \
guix/build-system/dub.scm \
guix/build-system/emacs.scm \
guix/build-system/font.scm \
guix/build-system/go.scm \
guix/build-system/meson.scm \
guix/build-system/minify.scm \
guix/build-system/asdf.scm \
guix/build-system/glib-or-gtk.scm \
guix/build-system/gnu.scm \
@@ -95,8 +74,6 @@ MODULES = \
guix/build-system/waf.scm \
guix/build-system/r.scm \
guix/build-system/ruby.scm \
guix/build-system/scons.scm \
guix/build-system/texlive.scm \
guix/build-system/trivial.scm \
guix/ftp-client.scm \
guix/http-client.scm \
@@ -105,19 +82,12 @@ MODULES = \
guix/store.scm \
guix/cvs-download.scm \
guix/svn-download.scm \
guix/i18n.scm \
guix/ui.scm \
guix/build/ant-build-system.scm \
guix/build/download.scm \
guix/build/download-nar.scm \
guix/build/cargo-build-system.scm \
guix/build/cmake-build-system.scm \
guix/build/dub-build-system.scm \
guix/build/emacs-build-system.scm \
guix/build/meson-build-system.scm \
guix/build/minify-build-system.scm \
guix/build/font-build-system.scm \
guix/build/go-build-system.scm \
guix/build/asdf-build-system.scm \
guix/build/git.scm \
guix/build/hg.scm \
@@ -129,15 +99,12 @@ MODULES = \
guix/build/ocaml-build-system.scm \
guix/build/r-build-system.scm \
guix/build/ruby-build-system.scm \
guix/build/scons-build-system.scm \
guix/build/texlive-build-system.scm \
guix/build/waf-build-system.scm \
guix/build/haskell-build-system.scm \
guix/build/store-copy.scm \
guix/build/utils.scm \
guix/build/union.scm \
guix/build/profiles.scm \
guix/build/compile.scm \
guix/build/pull.scm \
guix/build/rpath.scm \
guix/build/cvs.scm \
@@ -145,7 +112,6 @@ MODULES = \
guix/build/syscalls.scm \
guix/build/gremlin.scm \
guix/build/emacs-utils.scm \
guix/build/java-utils.scm \
guix/build/lisp-utils.scm \
guix/build/graft.scm \
guix/build/bournish.scm \
@@ -153,7 +119,6 @@ MODULES = \
guix/build/make-bootstrap.scm \
guix/search-paths.scm \
guix/packages.scm \
guix/import/print.scm \
guix/import/utils.scm \
guix/import/gnu.scm \
guix/import/snix.scm \
@@ -161,7 +126,6 @@ MODULES = \
guix/import/cran.scm \
guix/import/hackage.scm \
guix/import/elpa.scm \
guix/import/texlive.scm \
guix/scripts.scm \
guix/scripts/download.scm \
guix/scripts/perform-download.scm \
@@ -171,13 +135,11 @@ MODULES = \
guix/scripts/package.scm \
guix/scripts/gc.scm \
guix/scripts/hash.scm \
guix/scripts/pack.scm \
guix/scripts/pull.scm \
guix/scripts/substitute.scm \
guix/scripts/authenticate.scm \
guix/scripts/refresh.scm \
guix/scripts/system.scm \
guix/scripts/system/search.scm \
guix/scripts/lint.scm \
guix/scripts/challenge.scm \
guix/scripts/import/cran.scm \
@@ -185,10 +147,8 @@ MODULES = \
guix/scripts/import/nix.scm \
guix/scripts/import/hackage.scm \
guix/scripts/import/elpa.scm \
guix/scripts/import/texlive.scm \
guix/scripts/environment.scm \
guix/scripts/publish.scm \
guix/scripts/weather.scm \
guix/scripts/edit.scm \
guix/scripts/size.scm \
guix/scripts/graph.scm \
@@ -201,19 +161,15 @@ if HAVE_GUILE_JSON
MODULES += \
guix/docker.scm \
guix/import/cpan.scm \
guix/import/crate.scm \
guix/import/gem.scm \
guix/import/github.scm \
guix/import/gnome.scm \
guix/import/json.scm \
guix/import/pypi.scm \
guix/import/stackage.scm \
guix/import/crate.scm \
guix/scripts/import/crate.scm \
guix/scripts/import/gem.scm \
guix/scripts/import/json.scm \
guix/import/pypi.scm \
guix/scripts/import/pypi.scm \
guix/scripts/import/stackage.scm
guix/import/cpan.scm \
guix/scripts/import/gem.scm \
guix/import/gem.scm
endif
@@ -221,8 +177,7 @@ if HAVE_GUILE_SSH
MODULES += \
guix/ssh.scm \
guix/scripts/copy.scm \
guix/store/ssh.scm
guix/scripts/copy.scm
endif HAVE_GUILE_SSH
@@ -236,33 +191,39 @@ endif BUILD_DAEMON_OFFLOAD
# Internal modules with test suite support.
dist_noinst_DATA = guix/tests.scm guix/tests/http.scm
# Auxiliary files for packages.
AUX_FILES = \
gnu/packages/aux-files/emacs/guix-emacs.el \
gnu/packages/aux-files/linux-libre/4.14-arm.conf \
gnu/packages/aux-files/linux-libre/4.14-i686.conf \
gnu/packages/aux-files/linux-libre/4.14-x86_64.conf \
gnu/packages/aux-files/linux-libre/4.9-i686.conf \
gnu/packages/aux-files/linux-libre/4.9-x86_64.conf \
gnu/packages/aux-files/linux-libre/4.4-i686.conf \
gnu/packages/aux-files/linux-libre/4.4-x86_64.conf \
gnu/packages/aux-files/linux-libre/4.1-i686.conf \
gnu/packages/aux-files/linux-libre/4.1-x86_64.conf
# Linux-Libre configurations.
KCONFIGS = \
gnu/packages/linux-libre-4.9-i686.conf \
gnu/packages/linux-libre-4.9-x86_64.conf \
gnu/packages/linux-libre-4.4-i686.conf \
gnu/packages/linux-libre-4.4-x86_64.conf \
gnu/packages/linux-libre-4.1-i686.conf \
gnu/packages/linux-libre-4.1-x86_64.conf
# Templates, examples.
EXAMPLES = \
gnu/system/examples/bare-bones.tmpl \
gnu/system/examples/desktop.tmpl \
gnu/system/examples/lightweight-desktop.tmpl \
gnu/system/examples/vm-image.tmpl
gnu/system/examples/lightweight-desktop.tmpl
GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go $(dist_noinst_DATA:%.scm=%.go)
nobase_dist_guilemodule_DATA = \
$(MODULES) $(MODULES_NOT_COMPILED) $(AUX_FILES) $(EXAMPLES) \
nobase_dist_guilemodule_DATA = \
$(MODULES) $(KCONFIGS) $(EXAMPLES) \
$(MISC_DISTRO_FILES)
nobase_nodist_guilemodule_DATA = guix/config.scm
nobase_nodist_guileobject_DATA = $(GOBJECTS)
nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm
# Do we need to provide our own non-broken (srfi srfi-37) module?
if INSTALL_SRFI_37
nobase_nodist_guilemodule_DATA += srfi/srfi-37.scm
GOBJECTS += srfi/srfi-37.go
srfi/srfi-37.scm: srfi/srfi-37.scm.in
$(MKDIR_P) srfi
cp "$<" "$@"
endif INSTALL_SRFI_37
# Handy way to remove the .go files without removing all the rest.
clean-go:
@@ -281,14 +242,12 @@ TEST_EXTENSIONS = .scm .sh
if CAN_RUN_TESTS
SCM_TESTS = \
tests/base16.scm \
tests/base32.scm \
tests/base64.scm \
tests/cpio.scm \
tests/hash.scm \
tests/pk-crypto.scm \
tests/pki.scm \
tests/print.scm \
tests/sets.scm \
tests/modules.scm \
tests/gnu-maintenance.scm \
@@ -300,7 +259,6 @@ SCM_TESTS = \
tests/records.scm \
tests/upstream.scm \
tests/combinators.scm \
tests/discovery.scm \
tests/utils.scm \
tests/build-utils.scm \
tests/packages.scm \
@@ -308,14 +266,12 @@ SCM_TESTS = \
tests/hackage.scm \
tests/cran.scm \
tests/elpa.scm \
tests/texlive.scm \
tests/store.scm \
tests/monads.scm \
tests/gexp.scm \
tests/nar.scm \
tests/union.scm \
tests/profiles.scm \
tests/search-paths.scm \
tests/syscalls.scm \
tests/gremlin.scm \
tests/bournish.scm \
@@ -325,17 +281,13 @@ SCM_TESTS = \
tests/size.scm \
tests/graph.scm \
tests/challenge.scm \
tests/cache.scm \
tests/cve.scm \
tests/workers.scm \
tests/zlib.scm \
tests/file-systems.scm \
tests/uuid.scm \
tests/system.scm \
tests/services.scm \
tests/scripts-build.scm \
tests/containers.scm \
tests/pack.scm \
tests/import-utils.scm
if HAVE_GUILE_JSON
@@ -407,16 +359,14 @@ check-local:
endif !CAN_RUN_TESTS
check-system: $(GOBJECTS) $(BOOTSTRAP_GUILE_TARBALLS)
check-system: $(GOBJECTS)
$(AM_V_at)$(top_builddir)/pre-inst-env \
$(GUILE) --no-auto-compile \
-e '(@@ (run-system-tests) run-system-tests)' \
$(top_srcdir)/build-aux/run-system-tests.scm
# Public key used to sign substitutes from hydra.gnu.org & co.
dist_pkgdata_DATA = \
hydra.gnu.org.pub \
berlin.guixsd.org.pub
# Public key used to sign substitutes from hydra.gnu.org.
dist_pkgdata_DATA = hydra.gnu.org.pub
# Bash completion file.
dist_bashcompletion_DATA = etc/completion/bash/guix
@@ -434,18 +384,18 @@ EXTRA_DIST = \
build-aux/compile-all.scm \
build-aux/hydra/evaluate.scm \
build-aux/hydra/gnu-system.scm \
build-aux/hydra/demo-os.scm \
build-aux/hydra/guix.scm \
build-aux/hydra/guix-modular.scm \
build-aux/check-available-binaries.scm \
build-aux/check-final-inputs-self-contained.scm \
build-aux/download.scm \
build-aux/make-binary-tarball.scm \
build-aux/generate-authors.scm \
build-aux/test-driver.scm \
build-aux/update-guix-package.scm \
build-aux/update-NEWS.scm \
build-aux/run-system-tests.scm \
d3.v3.js \
graph.js \
srfi/srfi-37.scm.in \
srfi/srfi-64.scm \
srfi/srfi-64.upstream.scm \
tests/test.drv \
@@ -494,14 +444,14 @@ SUFFIXES = .go
# files. See
# <http://lists.gnu.org/archive/html/guile-devel/2010-07/msg00125.html>
# for details.
guix_install_go_files = install-nobase_nodist_guileobjectDATA
guix_install_go_files = install-nobase_nodist_guilemoduleDATA
$(guix_install_go_files): install-nobase_dist_guilemoduleDATA
# The above trick doesn't work for 'config.go' because both 'config.scm' and
# 'config.go' are listed in $(nobase_nodist_guileobject_DATA). Thus, give it
# 'config.go' are listed in $(nobase_nodist_guilemodule_DATA). Thus, give it
# special treatment.
install-data-hook: set-bootstrap-executable-permissions
touch "$(DESTDIR)$(guileobjectdir)/guix/config.go"
touch "$(DESTDIR)$(guilemoduledir)/guix/config.go"
SUBDIRS = po/guix po/packages
@@ -518,42 +468,31 @@ endif BUILD_DAEMON
ACLOCAL_AMFLAGS = -I m4
# Pass an explicit '--localstatedir' so that configure does not error out if
# it finds an existing installation with a different localstatedir. Inherit
# 'ac_cv_guix_test_root' so that "make check" in $(distdir) does not have to
# repopulate the whole store, and to make sure $(GUIX_TEST_ROOT) is short
# enough for shebangs.
# it finds an existing installation with a different localstatedir.
AM_DISTCHECK_CONFIGURE_FLAGS = \
--localstatedir="$$dc_install_base/var" \
--with-libgcrypt-prefix="$(LIBGCRYPT_PREFIX)" \
--with-libgcrypt-libdir="$(LIBGCRYPT_LIBDIR)" \
--with-nix-prefix="$(NIX_PREFIX)" \
--enable-daemon \
ac_cv_guix_test_root="$(GUIX_TEST_ROOT)"
--enable-daemon
# The self-contained tarball. Add 'glibc-utf8-locales' along with glibc just
# so 'etc/profile' defines 'GUIX_LOCPATH' pointing to a valid set of locales.
# The self-contained tarball.
guix-binary.%.tar.xz:
$(AM_V_GEN)GUIX_PACKAGE_PATH= \
tarball=`$(top_builddir)/pre-inst-env guix pack -K -C xz \
-s "$*" --localstatedir guix glibc-utf8-locales \
-e '(@@ (gnu packages commencement) glibc-final)'` ; \
cp "$$tarball" "$@.tmp" ; mv "$@.tmp" "$@"
$(AM_V_GEN)GUIX_PACKAGE_PATH= \
$(top_builddir)/pre-inst-env "$(GUILE)" \
"$(top_srcdir)/build-aux/make-binary-tarball.scm" "$*" "$@"
dist-hook: $(distdir)/ChangeLog gen-AUTHORS gen-tarball-version
dist-hook: sync-descriptions gen-ChangeLog gen-AUTHORS
dist-hook: assert-no-store-file-names
distcheck-hook: assert-binaries-available assert-final-inputs-self-contained
EXTRA_DIST += $(top_srcdir)/.version
BUILT_SOURCES += $(top_srcdir)/.version
$(top_srcdir)/.version:
echo $(VERSION) > "$@-t" && mv "$@-t" "$@"
sync-descriptions:
$(AM_V_at)GUIX_PACKAGE_PATH= \
$(top_builddir)/pre-inst-env guix lint --checkers=gnu-description
gen-tarball-version:
echo $(VERSION) > "$(distdir)/.tarball-version"
gen-ChangeLog $(distdir)/ChangeLog:
gen-ChangeLog:
$(AM_V_GEN)if test -d .git; then \
$(top_srcdir)/build-aux/gitlog-to-changelog \
> $(distdir)/cl-t; \
@@ -569,127 +508,8 @@ gen-AUTHORS:
"$(top_srcdir)" "$(distdir)/AUTHORS"; \
fi
#
# Release management.
#
releasedir = release-$(PACKAGE_VERSION)
PACKAGE_FULL_TARNAME = $(PACKAGE_TARNAME)-$(PACKAGE_VERSION)
# List of source tarballs produced. This must be kept in sync with the
# 'dist-' options of 'AM_INIT_AUTOMAKE' in 'configure.ac'.
SOURCE_TARBALLS = \
$(foreach ext,tar.gz,$(PACKAGE_FULL_TARNAME).$(ext))
# Systems supported by Guix.
SUPPORTED_SYSTEMS ?= x86_64-linux i686-linux armhf-linux aarch64-linux
# Guix binary tarballs.
BINARY_TARBALLS = \
$(foreach system,$(SUPPORTED_SYSTEMS),guix-binary.$(system).tar.xz)
# Systems supported by GuixSD.
GUIXSD_SUPPORTED_SYSTEMS ?= x86_64-linux i686-linux
# Systems for which we build GuixSD VMs.
GUIXSD_VM_SYSTEMS ?= x86_64-linux
# Prefix of the GuixSD installation image file name.
GUIXSD_IMAGE_BASE = guixsd-install-$(PACKAGE_VERSION)
# Prefix of the GuixSD VM image file name.
GUIXSD_VM_IMAGE_BASE = guixsd-vm-image-$(PACKAGE_VERSION)
# The release process works in several phases:
#
# 0. We assume the developer created a 'vX.Y' tag.
# 1. Build the source tarball.
# 2. Update the 'guix' package so that it corresponds to the 'vX.Y' tag.
# 3. Build the binary tarballs for that 'guix' package.
# 4. Update the 'guix' package again.
# 5. Build the GuixSD installation images. The images will run 'guix'
# corresponding to 'vX.Y' + 1 commit, and they will install 'vX.Y'.
#
# This 'release' target takes care of everything and copies the resulting
# files to $(releasedir).
#
# XXX: Depend on 'dist' rather than 'distcheck' to work around the Gettext
# issue described at <https://savannah.gnu.org/bugs/index.php?51027>.
release: dist
cd po; git checkout .
@if ! git diff-index --quiet HEAD; then \
echo "There are uncommitted changes; stopping." >&2 ; \
exit 1 ; \
fi
$(MKDIR_P) "$(releasedir)"
rm -f "$(releasedir)"/*
mv $(SOURCE_TARBALLS) "$(releasedir)"
$(top_builddir)/pre-inst-env "$(GUILE)" \
$(top_srcdir)/build-aux/update-guix-package.scm \
"`git rev-parse HEAD`" "$(PACKAGE_VERSION)"
git add $(top_srcdir)/gnu/packages/package-management.scm
git commit -m "gnu: guix: Update to $(PACKAGE_VERSION)."
rm -f $(BINARY_TARBALLS)
$(MAKE) $(BINARY_TARBALLS)
for system in $(SUPPORTED_SYSTEMS) ; do \
mv "guix-binary.$$system.tar.xz" \
"$(releasedir)/guix-binary-$(PACKAGE_VERSION).$$system.tar.xz" ; \
done
$(top_builddir)/pre-inst-env "$(GUILE)" \
$(top_srcdir)/build-aux/update-guix-package.scm \
"`git rev-parse HEAD`"
git add $(top_srcdir)/gnu/packages/package-management.scm
git commit -m "gnu: guix: Update to `git rev-parse HEAD | cut -c1-7`."
for system in $(GUIXSD_SUPPORTED_SYSTEMS) ; do \
image=`$(top_builddir)/pre-inst-env \
guix system disk-image \
--file-system-type=iso9660 \
--system=$$system \
gnu/system/install.scm` ; \
if [ ! -f "$$image" ] ; then \
echo "failed to produced GuixSD installation image for $$system" >&2 ; \
exit 1 ; \
fi ; \
xz < "$$image" > "$(releasedir)/$(GUIXSD_IMAGE_BASE).$$system.iso.xz.tmp" ; \
mv "$(releasedir)/$(GUIXSD_IMAGE_BASE).$$system.iso.xz.tmp" \
"$(releasedir)/$(GUIXSD_IMAGE_BASE).$$system.iso.xz" ; \
done
for system in $(GUIXSD_VM_SYSTEMS) ; do \
image=`$(top_builddir)/pre-inst-env \
guix system vm-image \
--system=$$system \
gnu/system/examples/vm-image.tmpl` ; \
if [ ! -f "$$image" ] ; then \
echo "failed to produced GuixSD VM image for $$system" >&2 ; \
exit 1 ; \
fi ; \
xz < "$$image" > "$(releasedir)/$(GUIXSD_VM_IMAGE_BASE).$$system.xz.tmp" ; \
mv "$(releasedir)/$(GUIXSD_VM_IMAGE_BASE).$$system.xz.tmp" \
"$(releasedir)/$(GUIXSD_VM_IMAGE_BASE).$$system.xz" ; \
done
@echo
@echo "Congratulations! All the release files are now in $(releasedir)."
@echo
update-guix-package:
git rev-parse HEAD
$(top_builddir)/pre-inst-env "$(GUILE)" \
$(top_srcdir)/build-aux/update-guix-package.scm \
"`git rev-parse HEAD`"
# Location of a checkout of <git://git.savannah.gnu.org/guix/maintenance.git>.
# Package data from this checkout is used by 'update-NEWS.scm'.
GUIX_MAINTENANCE_DIRECTORY ?= $(top_srcdir)/../guix-maintenance
update-NEWS: $(GOBJECTS)
$(top_builddir)/pre-inst-env "$(GUILE)" \
$(top_srcdir)/build-aux/update-NEWS.scm \
$(top_srcdir)/NEWS "$(GUIX_MAINTENANCE_DIRECTORY)/data"
# Make sure we're not shipping a file that embeds a local /gnu/store file name.
assert-no-store-file-names: $(distdir)/ChangeLog
assert-no-store-file-names:
$(AM_V_at)if grep -r --exclude=*.texi --exclude=*.info \
--exclude=*.info-[0-9] --exclude=*.dot \
--exclude=*.eps --exclude-dir=bootstrap \
@@ -719,20 +539,9 @@ hydra-jobs.scm: $(GOBJECTS)
"$(top_srcdir)/build-aux/hydra/gnu-system.scm" > "$@.tmp"
$(AM_V_at)mv "$@.tmp" "$@"
# Compute the Cuirass jobs and write them in the target file.
cuirass-jobs.scm: $(GOBJECTS)
$(AM_V_at)$(MKDIR_P) "`dirname "$@"`"
$(AM_V_GEN)$(top_builddir)/pre-inst-env "$(GUILE)" \
"$(top_srcdir)/build-aux/hydra/evaluate.scm" \
"$(top_srcdir)/build-aux/cuirass/gnu-system.scm" \
cuirass > "$@.tmp"
$(AM_V_at)mv "$@.tmp" "$@"
.PHONY: gen-ChangeLog gen-AUTHORS gen-tarball-version
.PHONY: sync-descriptions gen-ChangeLog gen-AUTHORS clean-go make-go
.PHONY: assert-no-store-file-names assert-binaries-available
.PHONY: assert-final-inputs-self-contained
.PHONY: clean-go make-go
.PHONY: update-guix-package update-NEWS release
## -------------- ##
## Silent rules. ##
+1 -1411
View File
File diff suppressed because it is too large Load Diff
+20 -20
View File
@@ -1,50 +1,50 @@
-*- mode: org -*-
[[https://www.gnu.org/software/guix/][GNU Guix]] (IPA: /ɡiːks/) is a purely functional package manager, and
associated free software distribution, for the [[https://www.gnu.org/gnu/gnu.html][GNU system]]. In addition
[[http://www.gnu.org/software/guix/][GNU Guix]] (IPA: /ɡiːks/) is a purely functional package manager, and
associated free software distribution, for the [[http://www.gnu.org/gnu/gnu.html][GNU system]]. In addition
to standard package management features, Guix supports transactional
upgrades and roll-backs, unprivileged package management, per-user
profiles, and garbage collection.
It provides [[https://www.gnu.org/software/guile/][Guile]] Scheme APIs, including a high-level embedded
It provides [[http://www.gnu.org/software/guile/][Guile]] Scheme APIs, including a high-level embedded
domain-specific languages (EDSLs) to describe how packages are to be
built and composed.
A user-land free software distribution for GNU/Linux comes as part of
Guix.
Guix is based on the [[https://nixos.org/nix/][Nix]] package manager.
Guix is based on the [[http://nixos.org/nix/][Nix]] package manager.
* Requirements
GNU Guix currently depends on the following packages:
- [[https://gnu.org/software/guile/][GNU Guile 2.2.x or 2.0.x]], version 2.0.9 or later
- [[https://gnupg.org/][GNU libgcrypt]]
- [[https://www.gnu.org/software/make/][GNU Make]]
- optionally [[https://savannah.nongnu.org/projects/guile-json/][Guile-JSON]], for the 'guix import pypi' command
- optionally [[https://www.gnutls.org][GnuTLS]] compiled with guile support enabled, for HTTPS support
- [[http://gnu.org/software/guile/][GNU Guile 2.0.x]], version 2.0.7 or later
- [[http://gnupg.org/][GNU libgcrypt]]
- [[http://www.gnu.org/software/make/][GNU Make]]
- optionally [[http://savannah.nongnu.org/projects/guile-json/][Guile-JSON]], for the 'guix import pypi' command
- optionally [[http://www.gnutls.org][GnuTLS]] compiled with guile support enabled, for HTTPS support
in the 'guix download' command. Note that 'guix import pypi' requires
this functionality.
Unless `--disable-daemon' was passed, the following packages are needed:
- [[https://sqlite.org/][SQLite 3]]
- [[http://sqlite.org/][SQLite 3]]
- [[http://www.bzip.org][libbz2]]
- [[https://gcc.gnu.org][GCC's g++]]
- [[http://gcc.gnu.org][GCC's g++]]
When `--disable-daemon' was passed, you instead need the following:
- [[https://nixos.org/nix/][Nix]]
- [[http://nixos.org/nix/][Nix]]
* Installation
See the manual for the installation instructions, either by running
info -f doc/guix.info "Installation"
info -f doc/guix.info "(guix) Installation"
or by checking the [[https://www.gnu.org/software/guix/manual/guix.html#Installation][web copy of the manual]].
or by checking the [[http://www.gnu.org/software/guix/manual/guix.html#Installation][web copy of the manual]].
For information on installation from a Git checkout, please see the section
"Building from Git" in the manual.
@@ -109,7 +109,7 @@ Join #guix on irc.freenode.net.
* Guix & Nix
GNU Guix is based on [[https://nixos.org/nix/][the Nix package manager]]. It implements the same
GNU Guix is based on [[http://nixos.org/nix/][the Nix package manager]]. It implements the same
package deployment paradigm, and in fact it reuses some of its code.
Yet, different engineering decisions were made for Guix, as described
below.
@@ -132,7 +132,7 @@ the store. Guix produces such derivations, which are then interpreted
by the daemon to perform the build. Thus, Guix derivations can use
derivations produced by Nix (and vice versa).
With Nix and the [[https://nixos.org/nixpkgs][Nixpkgs]] distribution, package composition happens at
With Nix and the [[http://nixos.org/nixpkgs][Nixpkgs]] distribution, package composition happens at
the Nix language level, but builders are usually written in Bash.
Conversely, Guix encourages the use of Scheme for both package
composition and builders. Likewise, the core functionality of Nix is
@@ -141,13 +141,13 @@ but exposes all the API as Scheme.
* Related software
- [[https://nixos.org][Nix, Nixpkgs, and NixOS]], functional package manager and associated
- [[http://nixos.org][Nix, Nixpkgs, and NixOS]], functional package manager and associated
software distribution, are the inspiration of Guix
- [[https://www.gnu.org/software/stow/][GNU Stow]] builds around the idea of one directory per prefix, and a
- [[http://www.gnu.org/software/stow/][GNU Stow]] builds around the idea of one directory per prefix, and a
symlink tree to create user environments
- [[https://www.pvv.ntnu.no/~arnej/store/storedoc_6.html][STORE]] shares the same idea
- [[http://www.pvv.ntnu.no/~arnej/store/storedoc_6.html][STORE]] shares the same idea
- [[https://live.gnome.org/OSTree/][GNOME's OSTree]] allows bootable system images to be built from a
specified set of packages
- The [[https://www.gnu.org/s/gsrc/][GNU Source Release Collection]] (GSRC) is a user-land software
- The [[http://www.gnu.org/s/gsrc/][GNU Source Release Collection]] (GSRC) is a user-land software
distribution; unlike Guix, it relies on core tools available on the
host system
-6
View File
@@ -1,6 +0,0 @@
(public-key
(ecc
(curve Ed25519)
(q #8D156F295D24B0D9A86FA5741A840FF2D24F60F7B6C4134814AD55625971B394#)
)
)
+16 -120
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,7 +22,6 @@
#:use-module (guix config)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (ice-9 match)
#:export (build))
;;; Commentary:
@@ -59,51 +58,12 @@
(define xz
(first (find-best-packages-by-name "xz" #f)))
(define (false-if-wrong-guile package)
"Return #f if PACKAGE depends on the \"wrong\" major version of Guile (e.g.,
2.0 instead of 2.2), otherwise return PACKAGE."
(let ((guile (any (match-lambda
((label (? package? dep) _ ...)
(and (string=? (package-name dep) "guile")
dep)))
(package-direct-inputs package))))
(and (or (not guile)
(string-prefix? (effective-version)
(package-version guile)))
package)))
(define (package-for-current-guile . names)
"Return the package with one of the given NAMES that depends on the current
Guile major version (2.0 or 2.2), or #f if none of the packages matches."
(let loop ((names names))
(match names
(()
#f)
((name rest ...)
(match (find-best-packages-by-name name #f)
(()
(loop rest))
((first _ ...)
(or (false-if-wrong-guile first)
(loop rest))))))))
(define guile-json
(package-for-current-guile "guile-json"
"guile2.2-json"
"guile2.0-json"))
(first (find-best-packages-by-name "guile-json" #f)))
(define guile-ssh
(package-for-current-guile "guile-ssh"
"guile2.2-ssh"
"guile2.0-ssh"))
(first (find-best-packages-by-name "guile-ssh" #f)))
(define guile-git
(package-for-current-guile "guile-git"
"guile2.0-git"))
(define guile-bytestructures
(package-for-current-guile "guile-bytestructures"
"guile2.0-bytestructures"))
;; The actual build procedure.
@@ -120,17 +80,6 @@ person's version identifier."
;; XXX: Replace with a Git commit id.
(date->string (current-date 0) "~Y~m~d.~H"))
(define (guile-for-build)
"Return a derivation for Guile 2.0 or 2.2, whichever matches the currently
running Guile."
(package->derivation (cond-expand
(guile-2.2
(canonical-package
(specification->package "guile@2.2")))
(else
(canonical-package
(specification->package "guile@2.0"))))))
;; The procedure below is our return value.
(define* (build source
#:key verbose? (version (date-version-string))
@@ -155,42 +104,15 @@ files."
#~(begin
(use-modules (guix build pull))
(letrec-syntax ((maybe-load-path
(syntax-rules ()
((_ item rest ...)
(let ((tail (maybe-load-path rest ...)))
(if (string? item)
(cons (string-append item
"/share/guile/site/"
#$(effective-version))
tail)
tail)))
((_)
'()))))
(let ((json (string-append #$guile-json "/share/guile/site/2.0")))
(set! %load-path
(append
(maybe-load-path #$guile-json #$guile-ssh
#$guile-git #$guile-bytestructures)
%load-path)))
(letrec-syntax ((maybe-load-compiled-path
(syntax-rules ()
((_ item rest ...)
(let ((tail (maybe-load-compiled-path rest ...)))
(if (string? item)
(cons (string-append item
"/lib/guile/"
#$(effective-version)
"/site-ccache")
tail)
tail)))
((_)
'()))))
(cons* json
(string-append #$guile-ssh "/share/guile/site/2.0")
%load-path))
(set! %load-compiled-path
(append
(maybe-load-compiled-path #$guile-json #$guile-ssh
#$guile-git #$guile-bytestructures)
%load-compiled-path)))
(cons* json
(string-append #$guile-ssh "/lib/guile/2.0/site-ccache")
%load-compiled-path)))
;; XXX: The 'guile-ssh' package prior to Guix commit 92b7258 was
;; broken: libguile-ssh could not be found. Work around that.
@@ -224,39 +146,13 @@ files."
(current-error-port)
(%make-void-port "w")))))
(unless guile-git
;; XXX: Guix before February 2017 lacks a 'guile-git' package altogether.
;; If we try to upgrade anyway, the logic in (guix scripts pull) will not
;; build (guix git), which will leave us with an unusable 'guix pull'. To
;; avoid that, fail early.
(format (current-error-port)
"\
Your installation is too old and lacks a '~a' package.
Please upgrade to an intermediate version first, for instance with:
(gexp->derivation "guix-latest" builder
#:modules '((guix build pull)
(guix build utils))
guix pull --url=https://git.savannah.gnu.org/cgit/guix.git/snapshot/v0.13.0.tar.gz
\n"
(match (effective-version)
("2.0" "guile2.0-git")
(_ "guile-git")))
(exit 1))
(mlet %store-monad ((guile (guile-for-build)))
(gexp->derivation "guix-latest" builder
#:modules '((guix build pull)
(guix build utils)
(guix build compile)
;; Closure of (guix modules).
(guix modules)
(guix memoization)
(guix sets))
;; Arrange so that our own (guix build …) modules are
;; used.
#:module-path (list (top-source-directory))
#:guile-for-build guile)))
;; Arrange so that our own (guix build …) modules are
;; used.
#:module-path (list (top-source-directory))))
;; This file is loaded by 'guix pull'; return it the build procedure.
build
+3 -6
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -38,13 +38,10 @@
%hydra-supported-systems))
(cross (map (cut package-cross-derivation store
%bootstrap-tarballs <>)
'("mips64el-linux-gnu"
"arm-linux-gnueabihf")))
'("mips64el-linux-gnuabi64")))
(total (append native cross)))
(set-build-options store
#:use-substitutes? #t
#:substitute-urls %default-substitute-urls)
(set-build-options store #:use-substitutes? #t)
(let* ((total (map derivation->output-path total))
(available (substitutable-paths store total))
(missing (lset-difference string=? total available)))
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -57,7 +57,7 @@
if it does."
(let ((references (substitutable-references substitute)))
(when (any (cut string-contains <> "boot") references)
(leave (G_ "'~a' refers to bootstrap inputs: ~s~%")
(leave (_ "'~a' refers to bootstrap inputs: ~s~%")
(substitutable-path substitute) references))))
(define (test-final-inputs store system)
@@ -71,7 +71,7 @@ refer to the bootstrap tools."
(string=? (substitutable-path substitute)
dir))
available)
(leave (G_ "~a (system: ~a) has no substitute~%")
(leave (_ "~a (system: ~a) has no substitute~%")
dir system)))
inputs)
+47 -49
View File
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,13 +17,17 @@
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(use-modules (ice-9 match)
(use-modules (system base target)
(system base message)
(ice-9 match)
(ice-9 threads)
(srfi srfi-1)
(guix build compile)
(guix build utils))
(define warnings
'(unsupported-warning format unbound-variable arity-mismatch))
(define host (getenv "host"))
(define srcdir (getenv "srcdir"))
(define (relative-file file)
@@ -45,38 +49,32 @@
(or (not (file-exists? go))
(file-mtime<? go file))))
(define* (parallel-job-count #:optional (flags (getenv "MAKEFLAGS")))
"Return the number of parallel jobs as determined by FLAGS, the flags passed
to 'make'."
(match flags
(#f (current-processor-count))
(flags
(let ((initial-flags (string-tokenize flags)))
(let loop ((flags initial-flags))
(match flags
(()
;; Note: GNU make prior to version 4.2 would hide "-j" flags from
;; $MAKEFLAGS. Thus, check for a "--jobserver" flag here and
;; assume we're using all cores if specified.
(if (any (lambda (flag)
(string-prefix? "--jobserver" flag))
initial-flags)
(current-processor-count) ;GNU make < 4.2
1)) ;sequential make
(("-j" (= string->number count) _ ...)
(if (integer? count)
count
(current-processor-count)))
((head tail ...)
(if (string-prefix? "-j" head)
(match (string-drop head 2)
(""
(current-processor-count))
((= string->number count)
(if (integer? count)
count
(current-processor-count))))
(loop tail)))))))))
(define (file->module file)
(let* ((relative (relative-file file))
(module-path (string-drop-right relative 4)))
(map string->symbol
(string-split module-path #\/))))
;;; To work around <http://bugs.gnu.org/15602> (FIXME), we want to load all
;;; files to be compiled first. We do this via resolve-interface so that the
;;; top-level of each file (module) is only executed once.
(define (load-module-file file)
(let ((module (file->module file)))
(format #t " LOAD ~a~%" module)
(resolve-interface module)))
(define (compile-file* file output-mutex)
(let ((go (scm->go file)))
(with-mutex output-mutex
(format #t " GUILEC ~a~%" go)
(force-output))
(mkdir-p (dirname go))
(with-fluids ((*current-warning-prefix* ""))
(with-target host
(lambda ()
(compile-file file
#:output-file go
#:opts `(#:warnings ,warnings)))))))
;; Install a SIGINT handler to give unwind handlers in 'compile-file' an
;; opportunity to run upon SIGINT and to remove temporary output files.
@@ -86,16 +84,16 @@ to 'make'."
(match (command-line)
((_ . files)
(compile-files srcdir (getcwd)
(filter file-needs-compilation? files)
#:workers (parallel-job-count)
#:host host
#:report-load (lambda (file total completed)
(when file
(format #t " LOAD ~a~%" file)
(force-output)))
#:report-compilation (lambda (file total completed)
(when file
(format #t " GUILEC ~a~%"
(scm->go file))
(force-output))))))
(let ((files (filter file-needs-compilation? files)))
(for-each load-module-file files)
(let ((mutex (make-mutex)))
;; Make sure compilation related modules are loaded before starting to
;; compile files in parallel.
(compile #f)
(par-for-each (lambda (file)
(compile-file* file mutex))
files)))))
;;; Local Variables:
;;; eval: (put 'with-target 'scheme-indent-function 1)
;;; End:
-47
View File
@@ -1,47 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@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/>.
;;;
;;; This file defines build jobs for the Cuirass continuation integration
;;; tool.
;;;
(include-from-path "build-aux/hydra/gnu-system.scm")
(use-modules ((guix licenses)
#:select (license? license-name license-uri license-comment)))
(define (cuirass-jobs store arguments)
"Return Cuirass jobs."
(map hydra-job->cuirass-job (hydra-jobs store arguments)))
(define (hydra-job->cuirass-job hydra-job)
(let ((name (car hydra-job))
(job ((cdr hydra-job))))
(lambda _ (acons #:job-name (symbol->string name)
(map symbol-alist-entry->keyword-alist-entry job)))))
(define (symbol-alist-entry->keyword-alist-entry entry)
(cons (symbol->keyword (car entry)) (entry->sexp-entry (cdr entry))))
(define (entry->sexp-entry o)
(match o
((? license?) `((name . (license-name o))
(uri . ,(license-uri o))
(comment . ,(license-comment o))))
(_ o)))
+14 -13
View File
@@ -1,7 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,7 +26,7 @@
(web client)
(rnrs io ports)
(srfi srfi-11)
(guix base16)
(guix utils)
(guix hash))
(define %url-base
@@ -37,20 +36,22 @@
;;"http://www.fdn.fr/~lcourtes/software/guix/packages"
)
;; XXX: Work around <http://bugs.gnu.org/13095>, present in Guile
;; up to 2.0.7.
(module-define! (resolve-module '(web client))
'shutdown (const #f))
(define (file-name->uri file)
"Return the URI for FILE."
(match (string-tokenize file (char-set-complement (char-set #\/)))
((_ ... system basename)
(string->uri
(string-append %url-base "/" system
(match system
("aarch64-linux"
"/20170217/")
("armhf-linux"
"/20150101/")
(_
"/20131110/"))
basename)))))
(string->uri (string-append %url-base "/" system
(match system
("armhf-linux"
"/20150101/")
(_
"/20131110/"))
basename)))))
(match (command-line)
((_ file expected-hash)
-226
View File
@@ -1,226 +0,0 @@
#!/bin/sh
# Print a version string.
scriptversion=2017-01-09.19; # UTC
# Copyright (C) 2007-2017 Free Software Foundation, Inc.
#
# This program 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.
#
# This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
# This script is derived from GIT-VERSION-GEN from GIT: http://git.or.cz/.
# It may be run two ways:
# - from a git repository in which the "git describe" command below
# produces useful output (thus requiring at least one signed tag)
# - from a non-git-repo directory containing a .tarball-version file, which
# presumes this script is invoked like "./git-version-gen .tarball-version".
# In order to use intra-version strings in your project, you will need two
# separate generated version string files:
#
# .tarball-version - present only in a distribution tarball, and not in
# a checked-out repository. Created with contents that were learned at
# the last time autoconf was run, and used by git-version-gen. Must not
# be present in either $(srcdir) or $(builddir) for git-version-gen to
# give accurate answers during normal development with a checked out tree,
# but must be present in a tarball when there is no version control system.
# Therefore, it cannot be used in any dependencies. GNUmakefile has
# hooks to force a reconfigure at distribution time to get the value
# correct, without penalizing normal development with extra reconfigures.
#
# .version - present in a checked-out repository and in a distribution
# tarball. Usable in dependencies, particularly for files that don't
# want to depend on config.h but do want to track version changes.
# Delete this file prior to any autoconf run where you want to rebuild
# files to pick up a version string change; and leave it stale to
# minimize rebuild time after unrelated changes to configure sources.
#
# As with any generated file in a VC'd directory, you should add
# /.version to .gitignore, so that you don't accidentally commit it.
# .tarball-version is never generated in a VC'd directory, so needn't
# be listed there.
#
# Use the following line in your configure.ac, so that $(VERSION) will
# automatically be up-to-date each time configure is run (and note that
# since configure.ac no longer includes a version string, Makefile rules
# should not depend on configure.ac for version updates).
#
# AC_INIT([GNU project],
# m4_esyscmd([build-aux/git-version-gen .tarball-version]),
# [bug-project@example])
#
# Then use the following lines in your Makefile.am, so that .version
# will be present for dependencies, and so that .version and
# .tarball-version will exist in distribution tarballs.
#
# EXTRA_DIST = $(top_srcdir)/.version
# BUILT_SOURCES = $(top_srcdir)/.version
# $(top_srcdir)/.version:
# echo $(VERSION) > $@-t && mv $@-t $@
# dist-hook:
# echo $(VERSION) > $(distdir)/.tarball-version
me=$0
version="git-version-gen $scriptversion
Copyright 2011 Free Software Foundation, Inc.
There is NO warranty. You may redistribute this software
under the terms of the GNU General Public License.
For more information about these matters, see the files named COPYING."
usage="\
Usage: $me [OPTION]... \$srcdir/.tarball-version [TAG-NORMALIZATION-SED-SCRIPT]
Print a version string.
Options:
--prefix PREFIX prefix of git tags (default 'v')
--fallback VERSION
fallback version to use if \"git --version\" fails
--help display this help and exit
--version output version information and exit
Running without arguments will suffice in most cases."
prefix=v
fallback=
while test $# -gt 0; do
case $1 in
--help) echo "$usage"; exit 0;;
--version) echo "$version"; exit 0;;
--prefix) shift; prefix=${1?};;
--fallback) shift; fallback=${1?};;
-*)
echo "$0: Unknown option '$1'." >&2
echo "$0: Try '--help' for more information." >&2
exit 1;;
*)
if test "x$tarball_version_file" = x; then
tarball_version_file="$1"
elif test "x$tag_sed_script" = x; then
tag_sed_script="$1"
else
echo "$0: extra non-option argument '$1'." >&2
exit 1
fi;;
esac
shift
done
if test "x$tarball_version_file" = x; then
echo "$usage"
exit 1
fi
tag_sed_script="${tag_sed_script:-s/x/x/}"
nl='
'
# Avoid meddling by environment variable of the same name.
v=
v_from_git=
# First see if there is a tarball-only version file.
# then try "git describe", then default.
if test -f $tarball_version_file
then
v=`cat $tarball_version_file` || v=
case $v in
*$nl*) v= ;; # reject multi-line output
[0-9]*) ;;
*) v= ;;
esac
test "x$v" = x \
&& echo "$0: WARNING: $tarball_version_file is missing or damaged" 1>&2
fi
if test "x$v" != x
then
: # use $v
# Otherwise, if there is at least one git commit involving the working
# directory, and "git describe" output looks sensible, use that to
# derive a version string.
elif test "`git log -1 --pretty=format:x . 2>&1`" = x \
&& v=`git describe --abbrev=4 --match="$prefix*" HEAD 2>/dev/null \
|| git describe --abbrev=4 HEAD 2>/dev/null` \
&& v=`printf '%s\n' "$v" | sed "$tag_sed_script"` \
&& case $v in
$prefix[0-9]*) ;;
*) (exit 1) ;;
esac
then
# Is this a new git that lists number of commits since the last
# tag or the previous older version that did not?
# Newer: v6.10-77-g0f8faeb
# Older: v6.10-g0f8faeb
case $v in
*-*-*) : git describe is okay three part flavor ;;
*-*)
: git describe is older two part flavor
# Recreate the number of commits and rewrite such that the
# result is the same as if we were using the newer version
# of git describe.
vtag=`echo "$v" | sed 's/-.*//'`
commit_list=`git rev-list "$vtag"..HEAD 2>/dev/null` \
|| { commit_list=failed;
echo "$0: WARNING: git rev-list failed" 1>&2; }
numcommits=`echo "$commit_list" | wc -l`
v=`echo "$v" | sed "s/\(.*\)-\(.*\)/\1-$numcommits-\2/"`;
test "$commit_list" = failed && v=UNKNOWN
;;
esac
# Change the first '-' to a '.', so version-comparing tools work properly.
# Remove the "g" in git describe's output string, to save a byte.
v=`echo "$v" | sed 's/-/./;s/\(.*\)-g/\1-/'`;
v_from_git=1
elif test "x$fallback" = x || git --version >/dev/null 2>&1; then
v=UNKNOWN
else
v=$fallback
fi
v=`echo "$v" |sed "s/^$prefix//"`
# Test whether to append the "-dirty" suffix only if the version
# string we're using came from git. I.e., skip the test if it's "UNKNOWN"
# or if it came from .tarball-version.
if test "x$v_from_git" != x; then
# Don't declare a version "dirty" merely because a timestamp has changed.
git update-index --refresh > /dev/null 2>&1
dirty=`exec 2>/dev/null;git diff-index --name-only HEAD` || dirty=
case "$dirty" in
'') ;;
*) # Append the suffix only if there isn't one already.
case $v in
*-dirty) ;;
*) v="$v-dirty" ;;
esac ;;
esac
fi
# Omit the trailing newline, so that m4_esyscmd can use the result directly.
printf %s "$v"
# Local variables:
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC0"
# time-stamp-end: "; # UTC"
# End:
+5 -24
View File
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,25 +26,12 @@
(ice-9 pretty-print)
(ice-9 format))
(define %top-srcdir
(and=> (assq-ref (current-source-location) 'filename)
(lambda (file)
(canonicalize-path
(string-append (dirname file) "/../..")))))
(define %user-module
;; Hydra user module.
(let ((m (make-module)))
(beautify-user-module! m)
m))
(cond-expand
(guile-2.2
;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it.
(define time-monotonic time-tai))
(else #t))
(define (call-with-time thunk kont)
"Call THUNK and pass KONT the elapsed time followed by THUNK's return
values."
@@ -77,7 +63,7 @@ Otherwise return THING."
;; Without further ado...
(match (command-line)
((command file cuirass? ...)
((command file)
;; Load FILE, a Scheme file that defines Hydra jobs.
(let ((port (current-output-port)))
(save-module-excursion
@@ -103,12 +89,7 @@ Otherwise return THING."
;; Call the entry point of FILE and print the resulting job sexp.
(pretty-print
(match ((module-ref %user-module
(if (equal? cuirass? "cuirass")
'cuirass-jobs
'hydra-jobs))
store `((guix
. ((file-name . ,%top-srcdir)))))
(match ((module-ref %user-module 'hydra-jobs) store '())
(((names . thunks) ...)
(map (lambda (job thunk)
(format (current-error-port) "evaluating '~a'... " job)
@@ -119,8 +100,8 @@ Otherwise return THING."
names thunks)))
port))))
((command _ ...)
(format (current-error-port) "Usage: ~a FILE [cuirass]
Evaluate the Hydra or Cuirass jobs defined in FILE.~%"
(format (current-error-port) "Usage: ~a FILE
Evaluate the Hydra jobs defined in FILE.~%"
command)
(exit 1)))
+16 -73
View File
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -40,15 +39,12 @@
(use-modules (guix config)
(guix store)
(guix grafts)
(guix profiles)
(guix packages)
(guix derivations)
(guix monads)
((guix licenses) #:select (gpl3+))
((guix utils) #:select (%current-system))
((guix scripts system) #:select (read-operating-system))
((guix scripts pack)
#:select (lookup-compressor self-contained-tarball))
(gnu packages)
(gnu packages gcc)
(gnu packages base)
@@ -112,7 +108,7 @@ SYSTEM."
;; chain.)
(list gcc-4.8 gcc-4.9 gcc-5 glibc binutils
gmp mpfr mpc coreutils findutils diffutils patch sed grep
gawk gnu-gettext hello guile-2.0 guile-2.2 zlib gzip xz
gawk gnu-gettext hello guile-2.0 zlib gzip xz
%bootstrap-binaries-tarball
%binutils-bootstrap-tarball
(%glibc-bootstrap-tarball)
@@ -127,9 +123,6 @@ SYSTEM."
'("mips64el-linux-gnu"
"mips64el-linux-gnuabi64"
"arm-linux-gnueabihf"
"aarch64-linux-gnu"
"powerpc-linux-gnu"
"i586-pc-gnu" ;aka. GNU/Hurd
"i686-w64-mingw32"))
(define %guixsd-supported-systems
@@ -163,14 +156,7 @@ system.")
(set-guile-for-build (default-guile))
(system-disk-image installation-os
#:disk-image-size
(* 1024 MiB)))))
(->job 'iso9660-image
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(system-disk-image installation-os
#:file-system-type
"iso9660")))))
(* 1024 MiB))))))
'()))
(define (system-test-jobs store system)
@@ -226,12 +212,7 @@ all its dependencies, and ready to be installed on non-GuixSD distributions.")
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(>>= (profile-derivation (packages->manifest (list guix)))
(lambda (profile)
(self-contained-tarball "guix-binary" profile
#:localstatedir? #t
#:compressor
(lookup-compressor "xz")))))
(self-contained-tarball))
#:system system))))
(define job-name
@@ -251,36 +232,12 @@ all its dependencies, and ready to be installed on non-GuixSD distributions.")
"Return a job for PACKAGE on SYSTEM, or #f if this combination is not
valid."
(cond ((member package base-packages)
(package-job store (symbol-append 'base. (job-name package))
package system))
#f)
((supported-package? package system)
(let ((drv (package-derivation store package system
#:graft? #f)))
(and (substitutable-derivation? drv)
(package-job store (job-name package)
package system))))
(package-job store (job-name package) package system))
(else
#f)))))
(define (all-packages)
"Return the list of packages to build."
(define (adjust package result)
(cond ((package-replacement package)
(cons* package ;build both
(package-replacement package)
result))
((package-superseded package)
result) ;don't build it
(else
(cons package result))))
(fold-packages adjust
(fold adjust '() ;include base packages
(match (%final-inputs)
(((labels packages _ ...) ...)
packages)))
#:select? (const #t))) ;include hidden packages
;;;
;;; Hydra entry point.
@@ -291,8 +248,6 @@ valid."
(define subset
(match (assoc-ref arguments 'subset)
("core" 'core) ; only build core packages
("hello" 'hello) ; only build hello
(((? string?) (? string?) ...) 'list) ; only build selected list of packages
(_ 'all))) ; build everything
(define (cross-jobs system)
@@ -301,17 +256,14 @@ valid."
;; prevents known-to-fail cross-builds from i686-linux or armhf-linux to
;; mips64el-linux-gnuabi64.
(and (or (string-prefix? "i686-" system)
(string-prefix? "i586-" system)
(string-prefix? "armhf-" system))
(string-contains target "64"))) ;x86_64, mips64el, aarch64, etc.
(string-suffix? "64" target)))
(define (same? target)
;; Return true if SYSTEM and TARGET are the same thing. This is so we
;; don't try to cross-compile to 'mips64el-linux-gnu' from
;; 'mips64el-linux'.
(or (string-contains target system)
(and (string-prefix? "armhf" system) ;armhf-linux
(string-prefix? "arm" target)))) ;arm-linux-gnueabihf
(string-contains target system))
(define (pointless? target)
;; Return #t if it makes no sense to cross-build to TARGET from SYSTEM.
@@ -337,7 +289,14 @@ valid."
(case subset
((all)
;; Build everything, including replacements.
(let ((all (all-packages))
(let ((all (fold-packages
(lambda (package result)
(if (package-replacement package)
(cons* package
(package-replacement package)
result)
(cons package result)))
'()))
(job (lambda (package)
(package->job store package
system))))
@@ -353,22 +312,6 @@ valid."
package system))
%core-packages)
(cross-jobs system)))
((hello)
;; Build hello package only.
(if (string=? system (%current-system))
(let ((hello (specification->package "hello")))
(list (package-job store (job-name hello) hello system)))
'()))
((list)
;; Build selected list of packages only.
(if (string=? system (%current-system))
(let* ((names (assoc-ref arguments 'subset))
(packages (map specification->package names)))
(map (lambda (package)
(package-job store (job-name package)
package system))
packages))
'()))
(else
(error "unknown subset" subset))))
%hydra-supported-systems)))
-104
View File
@@ -1,104 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 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/>.
;;;
;;; This file defines a continuous integration job to build the same modular
;;; Guix as 'guix pull', which is defined in (guix self).
;;;
;; Attempt to use our very own Guix modules.
(eval-when (compile load eval)
;; Ignore any available .go, and force recompilation. This is because our
;; checkout in the store has mtime set to the epoch, and thus .go files look
;; newer, even though they may not correspond.
(set! %fresh-auto-compile #t)
(and=> (assoc-ref (current-source-location) 'filename)
(lambda (file)
(let ((dir (canonicalize-path
(string-append (dirname file) "/../.."))))
(format (current-error-port) "prepending ~s to the load path~%"
dir)
(set! %load-path (cons dir %load-path))))))
(use-modules (guix store)
(guix config)
(guix utils)
(guix grafts)
((guix packages) #:select (%hydra-supported-systems))
(guix derivations)
(guix monads)
(guix gexp)
(guix self)
((guix licenses) #:prefix license:)
(srfi srfi-1)
(srfi srfi-26)
(ice-9 match))
;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
;; port to the bit bucket, let us write to the error port instead.
(setvbuf (current-error-port) _IOLBF)
(set-current-output-port (current-error-port))
(define* (build-job store source version system)
"Return a Hydra job a list building the modular Guix derivation from SOURCE
for SYSTEM. Use VERSION as the version identifier."
(lambda ()
`((derivation . ,(derivation-file-name
(parameterize ((%graft? #f))
(run-with-store store
(lower-object (compiled-guix source
#:version version))))))
(description . "Modular Guix")
(long-description
. "This is the modular Guix package as produced by 'guix pull'.")
(license . ,license:gpl3+)
(home-page . ,%guix-home-page-url)
(maintainers . (,%guix-bug-report-address)))))
(define (hydra-jobs store arguments)
"Return Hydra jobs."
(define systems
(match (filter-map (match-lambda
(('system . value) value)
(_ #f))
arguments)
((lst ..1)
lst)
(_
(list (%current-system)))))
(define guix-checkout
(assq-ref arguments 'guix))
(define version
(or (assq-ref guix-checkout 'revision)
"0.unknown"))
(let ((file (assq-ref guix-checkout 'file-name)))
(format (current-error-port) "using checkout ~s (~s)~%"
guix-checkout file)
(map (lambda (system)
(let ((name (string->symbol
(string-append "guix." system))))
`(,name
. ,(build-job store file version system))))
%hydra-supported-systems)))
+33 -22
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -43,10 +43,13 @@
(use-modules (guix store)
(guix packages)
(guix utils)
(guix grafts)
(guix derivations)
(guix build-system gnu)
(gnu packages version-control)
(gnu packages package-management)
(gnu packages imagemagick)
(gnu packages graphviz)
(gnu packages man)
(srfi srfi-1)
(srfi srfi-26)
(ice-9 match))
@@ -60,15 +63,36 @@
#:optional (package-derivation package-derivation))
"Convert PACKAGE to an alist suitable for Hydra."
`((derivation . ,(derivation-file-name
(parameterize ((%graft? #f))
(package-derivation store package system
#:graft? #f))))
(package-derivation store package system)))
(description . ,(package-synopsis package))
(long-description . ,(package-description package))
(license . ,(package-license package))
(home-page . ,(package-home-page package))
(maintainers . ("bug-guix@gnu.org"))))
(define (tarball-package checkout)
"Return a package that does `make distcheck' from CHECKOUT, a directory
containing a Git checkout of Guix."
(let ((guix (@@ (gnu packages package-management) guix)))
(dist-package (package
(inherit guix)
(arguments (package-arguments guix))
(native-inputs `(("imagemagick" ,imagemagick)
,@(package-native-inputs guix))))
checkout
#:phases
'(modify-phases %dist-phases
(add-before 'build 'build-daemon
;; Build 'guix-daemon' first so that help2man
;; successfully creates 'guix-daemon.1'.
(lambda _
(let ((n (number->string
(parallel-job-count))))
(zero? (system* "make"
"nix/libstore/schema.sql.hh"
"guix-daemon" "-j" n)))))))))
(define (hydra-jobs store arguments)
"Return Hydra jobs."
(define systems
@@ -85,22 +109,9 @@
(define guix-checkout
(assq-ref arguments 'guix))
(let ((file (assq-ref guix-checkout 'file-name)))
(let ((guix (assq-ref guix-checkout 'file-name)))
(format (current-error-port) "using checkout ~s (~s)~%"
guix-checkout file)
guix-checkout guix)
`((tarball . ,(cute package->alist store
(dist-package guix file)
(%current-system)))
,@(map (lambda (system)
(let ((name (string->symbol
(string-append "guix." system))))
`(,name
. ,(cute package->alist store
(package
(inherit guix)
(version "latest")
(source file))
system))))
%hydra-supported-systems))))
(tarball-package guix)
(%current-system))))))
+47
View File
@@ -0,0 +1,47 @@
;;; 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/>.
;;;
;;; Build a self-contained tarball containing binaries for Guix and its
;;; dependencies.
;;;
(use-modules (guix)
(guix ui)
(gnu system install)
(ice-9 match))
(define copy-file*
(lift2 copy-file %store-monad))
(define rename-file*
(lift2 rename-file %store-monad))
(match (command-line)
((_ system file)
(with-store store
(run-with-store store
(mlet %store-monad ((tarball (self-contained-tarball)))
(mbegin %store-monad
(show-what-to-build* (list tarball))
(built-derivations (list tarball))
(copy-file* (derivation->output-path tarball)
(string-append file ".part"))
(rename-file* (string-append file ".part") file)))
#:system system))))
+4 -8
View File
@@ -1,8 +1,7 @@
#!/bin/sh
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2017 Eric Bavier <bavier@cray.com>
# Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -46,14 +45,11 @@ export PATH
NIX_ROOT_FINDER="$abs_top_builddir/nix/scripts/list-runtime-roots"
NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute"
NIX_BUILD_HOOK="$abs_top_builddir/nix/scripts/offload"
NIX_LIBEXEC_DIR="@abs_top_builddir@/nix/scripts" # for 'guix-authenticate'
export NIX_ROOT_FINDER NIX_SUBSTITUTERS NIX_LIBEXEC_DIR
NIX_BUILD_HOOK="$abs_top_builddir/nix/scripts/offload"
@BUILD_DAEMON_OFFLOAD_TRUE@export NIX_BUILD_HOOK
@BUILD_DAEMON_OFFLOAD_FALSE@# No offloading support.
@BUILD_DAEMON_OFFLOAD_FALSE@unset NIX_BUILD_HOOK
export NIX_ROOT_FINDER NIX_SUBSTITUTERS \
NIX_BUILD_HOOK NIX_LIBEXEC_DIR
# The 'guix-register' program.
GUIX_REGISTER="$abs_top_builddir/guix-register"
+28 -23
View File
@@ -1,6 +1,6 @@
;;;; test-driver.scm - Guile test driver for Automake testsuite harness
(define script-version "2017-03-22.13") ;UTC
(define script-version "2016-04-03.12") ;UTC
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
@@ -59,7 +59,7 @@ The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n"))
(begin
(format port "~A:~%" field)
(pretty-print value port #:per-line-prefix "+ "))
(format port "~A: ~S~%" field value)))
(format port "~A: ~A~%" field value)))
(define* (result->string symbol #:key colorize?)
"Return SYMBOL as an upper case string. Use colors when COLORIZE is #t."
@@ -85,10 +85,10 @@ current output port is supposed to be redirected to a '.log' file."
;; Procedure called at the start of an individual test case, before the
;; test expression (and expected value) are evaluated.
(let ((result (cute assq-ref (test-result-alist runner) <>)))
(format #t "test-name: ~A~%" (result 'test-name))
(format #t "location: ~A~%"
(string-append (result 'source-file) ":"
(number->string (result 'source-line))))
(test-display "test-name" (result 'test-name))
(test-display "location"
(string-append (result 'source-file) ":"
(number->string (result 'source-line))))
(test-display "source" (result 'source-form) #:pretty? #t)))
(define (test-on-test-end-gnu runner)
@@ -99,9 +99,10 @@ current output port is supposed to be redirected to a '.log' file."
(result (cut assq-ref results <>)))
(unless brief?
;; Display the result of each test case on the console.
(format out-port "~A: ~A - ~A~%"
(result->string (test-result-kind runner) #:colorize? color?)
test-name (test-runner-test-name runner)))
(test-display
(result->string (test-result-kind runner) #:colorize? color?)
(string-append test-name " - " (test-runner-test-name runner))
out-port))
(when (result? 'expected-value)
(test-display "expected-value" (result 'expected-value)))
(when (result? 'expected-error)
@@ -110,11 +111,12 @@ current output port is supposed to be redirected to a '.log' file."
(test-display "actual-value" (result 'actual-value)))
(when (result? 'actual-error)
(test-display "actual-error" (result 'actual-error) #:pretty? #t))
(format #t "result: ~a~%" (result->string (result 'result-kind)))
(test-display "result" (result->string (result 'result-kind)))
(newline)
(format trs-port ":test-result: ~A ~A~%"
(result->string (test-result-kind runner))
(test-runner-test-name runner))))
(test-display ":test-result"
(string-append (result->string (test-result-kind runner))
" " (test-runner-test-name runner))
trs-port)))
(define (test-on-group-end-gnu runner)
;; Procedure called by a 'test-end', including at the end of a test-group.
@@ -123,18 +125,21 @@ current output port is supposed to be redirected to a '.log' file."
(skip (or (positive? (test-runner-skip-count runner))
(positive? (test-runner-xfail-count runner)))))
;; XXX: The global results need some refinements for XPASS.
(format trs-port ":global-test-result: ~A~%"
(if fail "FAIL" (if skip "SKIP" "PASS")))
(format trs-port ":recheck: ~A~%"
(if fail "yes" "no"))
(format trs-port ":copy-in-global-log: ~A~%"
(if (or fail skip) "yes" "no"))
(test-display ":global-test-result"
(if fail "FAIL" (if skip "SKIP" "PASS"))
trs-port)
(test-display ":recheck"
(if fail "yes" "no")
trs-port)
(test-display ":copy-in-global-log"
(if (or fail skip) "yes" "no")
trs-port)
(when brief?
;; Display the global test group result on the console.
(format out-port "~A: ~A~%"
(result->string (if fail 'fail (if skip 'skip 'pass))
#:colorize? color?)
test-name))
(test-display (result->string (if fail 'fail (if skip 'skip 'pass))
#:colorize? color?)
test-name
out-port))
#f))
(let ((runner (test-runner-null)))
-161
View File
@@ -1,161 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 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/>.
;;; Commentary:
;;;
;;; This script updates the list of new and updated packages in 'NEWS'.
;;;
;;; Code:
(use-modules (gnu) (guix)
(guix build utils)
((guix ui) #:select (fill-paragraph))
(srfi srfi-1)
(srfi srfi-11)
(ice-9 match)
(ice-9 rdelim)
(ice-9 regex)
(ice-9 pretty-print))
(define %header-rx
(make-regexp "^\\* Changes in (version )?([0-9.]+) \\(since ([0-9.]+)\\)"))
(define (NEWS->versions port)
"Return two values: the previous version and the current version as read
from PORT, which is an input port on the 'NEWS' file."
(let loop ()
(let ((line (read-line port)))
(cond ((eof-object? line)
(error "failed to determine previous and current version"
port))
((regexp-exec %header-rx line)
=>
(lambda (match)
(values (match:substring match 3)
(match:substring match 2))))
(else
(loop))))))
(define (skip-to-org-heading port)
"Read from PORT until an Org heading is found."
(let loop ()
(let ((next (peek-char port)))
(cond ((eqv? next #\*)
#t)
((eof-object? next)
(error "next heading could not be found"))
(else
(read-line port)
(loop))))))
(define (rewrite-org-section input output heading-rx proc)
"Write to OUTPUT the text read from INPUT, but with the first Org section
matching HEADING-RX replaced by NEW-HEADING and CONTENTS."
(let loop ()
(let ((line (read-line input)))
(cond ((eof-object? line)
(error "failed to match heading regexp" heading-rx))
((regexp-exec heading-rx line)
=>
(lambda (match)
(proc match output)
(skip-to-org-heading input)
(dump-port input output)
#t))
(else
(display line output)
(newline output)
(loop))))))
(define (enumeration->paragraph lst)
"Turn LST, a list of strings, into a single string that is a ready-to-print
paragraph."
(fill-paragraph (string-join (sort lst string<?) ", ")
75))
(define (write-packages-added news-file old new)
"Write to NEWS-FILE the list of packages added between OLD and NEW."
(let ((added (lset-difference string=? (map car new) (map car old))))
(with-atomic-file-replacement news-file
(lambda (input output)
(rewrite-org-section input output
(make-regexp "^(\\*+) (.*) new packages")
(lambda (match port)
(let ((stars (match:substring match 1)))
(format port
"~a ~a new packages~%~%~a~%~%"
stars (length added)
(enumeration->paragraph added)))))))))
(define (write-packages-updates news-file old new)
"Write to NEWS-FILE the list of packages upgraded between OLD and NEW."
(let ((upgraded (filter-map (match-lambda
((package . new-version)
(match (assoc package old)
((_ . old-version)
(and (version>? new-version old-version)
(string-append package "@"
new-version)))
(_ #f))))
new)))
(with-atomic-file-replacement news-file
(lambda (input output)
(rewrite-org-section input output
(make-regexp "^(\\*+) (.*) package updates")
(lambda (match port)
(let ((stars (match:substring match 1)))
(format port
"~a ~a package updates~%~%~a~%~%"
stars (length upgraded)
(enumeration->paragraph upgraded)))))))))
(define (main . args)
(match args
((news-file data-directory)
;; Don't browse things listed in the user's $GUIX_PACKAGE_PATH. Here we
;; assume that the last item in (%package-module-path) is the distro
;; directory.
(parameterize ((%package-module-path
(list (last (%package-module-path)))))
(define (package-file version)
(string-append data-directory "/packages-"
version ".txt"))
(let-values (((previous-version new-version)
(call-with-input-file news-file NEWS->versions)))
(let* ((old (call-with-input-file (package-file previous-version)
read))
(new (fold-packages (lambda (p r)
(alist-cons (package-name p) (package-version p)
r))
'())))
(call-with-output-file (package-file new-version)
(lambda (port)
(pretty-print new port)))
(write-packages-added news-file old new)
(write-packages-updates news-file old new)))))
(x
(format (current-error-port) "Usage: update-NEWS NEWS-FILE DATA-DIRECTORY
Update the list of new and updated packages in NEWS-FILE using the
previous-version package list from DATA-DIRECTORY.\n")
(exit 1))))
(apply main (cdr (command-line)))
-144
View File
@@ -1,144 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 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/>.
;;; Commentary:
;;;
;;; This scripts updates the definition of the 'guix' package in Guix for the
;;; current commit. It requires Git to be installed.
;;;
;;; Code:
(use-modules (guix)
(guix git-download)
(guix upstream)
(guix utils)
(guix base32)
(guix build utils)
(gnu packages package-management)
(ice-9 match))
(define %top-srcdir
(string-append (current-source-directory) "/.."))
(define version-controlled?
(git-predicate %top-srcdir))
(define (package-definition-location)
"Return the source properties of the definition of the 'guix' package."
(call-with-input-file (location-file (package-location guix))
(lambda (port)
(let loop ()
(match (read port)
((? eof-object?)
(error "definition of 'guix' package could not be found"
(port-filename port)))
(('define-public 'guix value)
(source-properties value))
(_
(loop)))))))
(define* (update-definition commit hash
#:key version old-hash)
"Return a one-argument procedure that takes a string, the definition of the
'guix' package, and returns a string, the update definition for VERSION,
COMMIT."
(define (linear-offset str line column)
;; Return the offset in characters to reach LINE and COLUMN (both
;; zero-indexed) in STR.
(call-with-input-string str
(lambda (port)
(let loop ((offset 0))
(cond ((and (= (port-column port) column)
(= (port-line port) line))
offset)
((eof-object? (read-char port))
(error "line and column not reached!"
str))
(else
(loop (+ 1 offset))))))))
(define (update-hash str)
;; Replace OLD-HASH with HASH in STR.
(string-replace-substring str
(bytevector->nix-base32-string old-hash)
(bytevector->nix-base32-string hash)))
(lambda (str)
(match (call-with-input-string str read)
(('let (('version old-version)
('commit old-commit)
('revision old-revision))
defn)
(let* ((location (source-properties defn))
(line (assq-ref location 'line))
(column 0)
(offset (linear-offset str line column)))
(string-append (format #f "(let ((version \"~a\")
(commit \"~a\")
(revision ~a))\n"
(or version old-version)
commit
(if (and version
(not (string=? version old-version)))
0
(+ 1 old-revision)))
(string-drop (update-hash str) offset))))
(exp
(error "'guix' package definition is not as expected" exp)))))
(define (main . args)
(match args
((commit version)
(with-store store
(let* ((source (add-to-store store
"guix-checkout" ;dummy name
#t "sha256" %top-srcdir
#:select? version-controlled?))
(hash (query-path-hash store source))
(location (package-definition-location))
(old-hash (origin-sha256 (package-source guix))))
(edit-expression location
(update-definition commit hash
#:old-hash old-hash
#:version version))
;; Re-add SOURCE to the store, but this time under the real name used
;; in the 'origin'. This allows us to build the package without
;; having to make a real checkout; thus, it also works when working
;; on a private branch.
(reload-module
(resolve-module '(gnu packages package-management)))
(let* ((source (add-to-store store
(origin-file-name (package-source guix))
#t "sha256" source))
(root (store-path-package-name source)))
;; Add an indirect GC root for SOURCE in the current directory.
(false-if-exception (delete-file root))
(symlink source root)
(add-indirect-root store root)
(format #t "source code for commit ~a: ~a (GC root: ~a)~%"
commit source root)))))
((commit)
;; Automatically deduce the version and revision numbers.
(main commit #f))))
(apply main (cdr (command-line)))
-1
View File
@@ -5,7 +5,6 @@ AC_MSG_RESULT([$guix_build_daemon])
dnl C++ environment. This macro must be used unconditionnaly.
AC_PROG_CXX
AM_PROG_AR
AC_LANG([C++])
if test "x$guix_build_daemon" = "xyes"; then
+16 -41
View File
@@ -2,13 +2,11 @@
# Process this file with autoconf to produce a configure script.
AC_PREREQ(2.68)
AC_INIT([GNU Guix],
[m4_esyscmd([build-aux/git-version-gen .tarball-version])],
[bug-guix@gnu.org], [guix],
[https://www.gnu.org/software/guix/])
AC_INIT([GNU Guix], [0.12.0], [bug-guix@gnu.org], [guix],
[http://www.gnu.org/software/guix/])
AC_CONFIG_AUX_DIR([build-aux])
AM_INIT_AUTOMAKE([1.14 gnu silent-rules subdir-objects \
AM_INIT_AUTOMAKE([1.12 gnu silent-rules subdir-objects \
color-tests parallel-tests -Woverride -Wno-portability])
# Enable silent rules by default.
@@ -52,7 +50,7 @@ AC_MSG_CHECKING([for the store directory])
AC_MSG_RESULT([$storedir])
AC_ARG_ENABLE([daemon],
[AS_HELP_STRING([--disable-daemon], [do not build the Nix daemon (C++)])],
[AS_HELP_STRING([--disable-daemon], [build the Nix daemon (C++)])],
[guix_build_daemon="$enableval"],
[guix_build_daemon="yes"])
@@ -75,44 +73,35 @@ m4_pattern_forbid([PKG_CHECK_MODULES])
m4_pattern_forbid([GUILE_MODULE_AVAILABLE])
m4_pattern_forbid([^GUILE_P$])
dnl Search for 'guile' and 'guild'. This macro defines
dnl 'GUILE_EFFECTIVE_VERSION'.
GUILE_PKG([2.2 2.0])
dnl Search for 'guile' and 'guild'. Prefer 2.0 until the 2.2 upgrade is
dnl complete. This macro defines 'GUILE_EFFECTIVE_VERSION'.
GUILE_PKG([2.0 2.2])
GUILE_PROGS
if test "x$GUILD" = "x"; then
AC_MSG_ERROR(['guild' binary not found; please check your guile-2.x installation.])
fi
if test "x$GUILE_EFFECTIVE_VERSION" = "x2.0"; then
PKG_CHECK_MODULES([GUILE], [guile-2.0 >= 2.0.9])
PKG_CHECK_MODULES([GUILE], [guile-2.0 >= 2.0.7])
else
AC_MSG_WARN([Guile $GUILE_EFFECTIVE_VERSION is not fully supported!])
fi
dnl Installation directories for .scm and .go files.
dnl Installation directory for .scm and .go files.
guilemoduledir="${datarootdir}/guile/site/$GUILE_EFFECTIVE_VERSION"
guileobjectdir="${libdir}/guile/$GUILE_EFFECTIVE_VERSION/site-ccache"
AC_SUBST([guilemoduledir])
AC_SUBST([guileobjectdir])
dnl The GnuTLS bindings are necessary for substitutes over HTTPS and for 'guix
dnl pull', among other things.
GUILE_MODULE_AVAILABLE([have_gnutls], [(gnutls)])
if test "x$have_gnutls" != "xyes"; then
AC_MSG_ERROR([The Guile bindings of GnuTLS are missing; please install them.])
fi
dnl Check for Guile-Git.
GUILE_MODULE_AVAILABLE([have_guile_git], [(git)])
if test "x$have_guile_git" != "xyes"; then
AC_MSG_ERROR([Guile-Git is missing; please install it.])
fi
dnl Guile-JSON is used in various places.
dnl guile-json is used for the PyPI package importer
GUILE_MODULE_AVAILABLE([have_guile_json], [(json)])
AM_CONDITIONAL([HAVE_GUILE_JSON], [test "x$have_guile_json" = "xyes"])
dnl Make sure we have a full-fledged Guile.
GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads])
dnl Check whether (srfi srfi-37) works, and provide our own if it doesn't.
GUIX_CHECK_SRFI_37
AM_CONDITIONAL([INSTALL_SRFI_37], [test "x$ac_cv_guix_srfi_37_broken" = xyes])
dnl Decompressors, for use by the substituter and other modules.
AC_PATH_PROG([GZIP], [gzip])
AC_PATH_PROG([BZIP2], [bzip2])
@@ -243,19 +232,6 @@ AM_MISSING_PROG([DOT], [dot])
dnl Manual pages.
AM_MISSING_PROG([HELP2MAN], [help2man])
dnl Emacs (optional), for 'etc/indent-package.el'.
AC_PATH_PROG([EMACS], [emacs], [/usr/bin/emacs])
AC_SUBST([EMACS])
case "$storedir" in
/gnu/store)
;;
*)
AC_MSG_WARN([Using a store directory other than '/gnu/store' will prevent you])
AC_MSG_WARN([from downloading substitutes from gnu.org.])
;;
esac
AC_CONFIG_FILES([Makefile
po/guix/Makefile.in
po/packages/Makefile.in
@@ -265,6 +241,5 @@ AC_CONFIG_FILES([scripts/guix], [chmod +x scripts/guix])
AC_CONFIG_FILES([test-env:build-aux/test-env.in], [chmod +x test-env])
AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in],
[chmod +x pre-inst-env])
AC_CONFIG_FILES([etc/indent-code.el], [chmod +x etc/indent-code.el])
AC_OUTPUT
+11 -97
View File
@@ -31,13 +31,7 @@ choice.
@section Building from Git
If you want to hack Guix itself, it is recommended to use the latest
version from the Git repository:
@example
git clone https://git.savannah.gnu.org/git/guix.git
@end example
When building Guix from a checkout,
version from the Git repository. When building Guix from a checkout,
the following packages are required in addition to those mentioned in
the installation instructions (@pxref{Requirements}).
@@ -243,8 +237,6 @@ especially when matching lists.
@node Formatting Code
@subsection Formatting Code
@cindex formatting code
@cindex coding style
When writing Scheme code, we follow common wisdom among Scheme
programmers. In general, we follow the
@url{http://mumble.net/~campbell/scheme/style.txt, Riastradh's Lisp
@@ -254,28 +246,8 @@ please do read it.
Some special forms introduced in Guix, such as the @code{substitute*}
macro, have special indentation rules. These are defined in the
@file{.dir-locals.el} file, which Emacs automatically uses. Also note
that Emacs-Guix provides @code{guix-devel-mode} mode that indents and
highlights Guix code properly (@pxref{Development,,, emacs-guix, The
Emacs-Guix Reference Manual}).
@cindex indentation, of code
@cindex formatting, of code
If you do not use Emacs, please make sure to let your editor knows these
rules. To automatically indent a package definition, you can also run:
@example
./etc/indent-code.el gnu/packages/@var{file}.scm @var{package}
@end example
@noindent
This automatically indents the definition of @var{package} in
@file{gnu/packages/@var{file}.scm} by running Emacs in batch mode. To
indent a whole file, omit the second argument:
@example
./etc/indent-code.el gnu/services/@var{file}.scm
@end example
@file{.dir-locals.el} file, which Emacs automatically uses. If you do
not use Emacs, please make sure to let your editor know the rules.
We require all top-level procedures to carry a docstring. This
requirement can be relaxed for simple private procedures in the
@@ -291,15 +263,7 @@ keyword parameters for procedures that take more than four parameters.
Development is done using the Git distributed version control system.
Thus, access to the repository is not strictly necessary. We welcome
contributions in the form of patches as produced by @code{git
format-patch} sent to the @email{guix-patches@@gnu.org} mailing list.
This mailing list is backed by a Debbugs instance accessible at
@uref{https://bugs.gnu.org/guix-patches}, which allows us to keep track
of submissions. Each message sent to that mailing list gets a new
tracking number assigned; people can then follow up on the submission by
sending email to @code{@var{NNN}@@debbugs.gnu.org}, where @var{NNN} is
the tracking number (@pxref{Sending a Patch Series}).
format-patch} sent to the @email{guix-devel@@gnu.org, mailing list}.
Please write commit logs in the ChangeLog format (@pxref{Change Logs,,,
standards, GNU Coding Standards}); you can check the commit history for
examples.
@@ -308,12 +272,6 @@ Before submitting a patch that adds or modifies a package definition,
please run through this check list:
@enumerate
@item
If the authors of the packaged software provide a cryptographic
signature for the release tarball, make an effort to verify the
authenticity of the archive. For a detached GPG signature file this
would be done with the @code{gpg --verify} command.
@item
Take some time to provide an adequate synopsis and description for the
package. @xref{Synopses and Descriptions}, for some guidelines.
@@ -353,30 +311,9 @@ 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}).
@c See <https://lists.gnu.org/archive/html/guix-devel/2016-10/msg00933.html>.
@cindex branching strategy
@cindex rebuild scheduling strategy
Depending on the number of dependent packages and thus the amount of
rebuilding induced, commits go to different branches, along these lines:
@table @asis
@item 300 dependent packages or less
@code{master} branch (non-disruptive changes).
@item between 300 and 1,200 dependent packages
@code{staging} branch (non-disruptive changes). This branch is intended
to be merged in @code{master} every 3 weeks or so. Topical changes
(e.g., an update of the GNOME stack) can instead go to a specific branch
(say, @code{gnome-updates}).
@item more than 1,200 dependent packages
@code{core-updates} branch (may include major and potentially disruptive
changes). This branch is intended to be merged in @code{master} every
2.5 months or so.
@end table
All these branches are tracked by our build farm
and merged into @code{master} once
Packages with roughly 100 dependents or more usually have to be
committed to a separate branch. That branch can then be built
separately by our build farm, and later merged into @code{master} once
everything has been successfully built. This allows us to fix issues
before they hit users, and to reduce the window during which pre-built
binaries are not available.
@@ -421,34 +358,11 @@ Bundling unrelated changes together makes reviewing harder and slower.
Examples of unrelated changes include the addition of several packages,
or a package update along with fixes to that package.
@item
Please follow our code formatting rules, possibly running the
@command{etc/indent-code.el} script to do that automatically for you
(@pxref{Formatting Code}).
@end enumerate
When posting a patch to the mailing list, use @samp{[PATCH] @dots{}} as
a subject. You may use your email client or the @command{git
send-email} command (@pxref{Sending a Patch Series}). We prefer to get
patches in plain text messages, either inline or as MIME attachments.
You are advised to pay attention if your email client changes anything
like line breaks or indentation which could potentially break the
patches.
When a bug is resolved, please close the thread by sending an email to
@email{@var{NNN}-done@@debbugs.gnu.org}.
@unnumberedsubsec Sending a Patch Series
@anchor{Sending a Patch Series}
@cindex patch series
@cindex @code{git send-email}
@cindex @code{git-send-email}
When sending a patch series (e.g., using @code{git send-email}), please
first send one message to @email{guix-patches@@gnu.org}, and then send
subsequent patches to @email{@var{NNN}@@debbugs.gnu.org} to make sure
they are kept together. See
@uref{https://debbugs.gnu.org/Advanced.html, the Debbugs documentation}
for more information.
@c Debbugs bug: https://debbugs.gnu.org/db/15/15361.html
send-email} command. We prefer to get patches in plain text messages,
either inline or as MIME attachments. You are advised to pay attention if
your email client changes anything like line breaks or indentation which
could potentially break the patches.
+527 -5935
View File
File diff suppressed because it is too large Load Diff
+1 -3
View File
@@ -219,9 +219,7 @@ emacs node ${EMACS}/html_node/emacs/
easejs mono ${GS}/easejs/manual/easejs.html
easejs node ${GS}/easejs/manual/
EMACS_GUIX = https://alezost.github.io/guix.el/manual/latest
emacs-guix mono ${EMACS_GUIX}/emacs-guix.html
emacs-guix node ${EMACS_GUIX}/html_node/
emacs-guix mono https://notabug.org/alezost/emacs-guix
emacs-muse node ${GS}/emacs-muse/manual/muse.html
emacs-muse node ${GS}/emacs-muse/manual/html_node/
+2 -1
View File
@@ -1,6 +1,6 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
# Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
@@ -37,6 +37,7 @@ DOT_VECTOR_GRAPHICS = \
EXTRA_DIST += \
%D%/htmlxref.cnf \
%D%/contributing.texi \
%D%/emacs.texi \
%D%/fdl-1.3.texi \
$(DOT_FILES) \
$(DOT_VECTOR_GRAPHICS) \
@@ -1,7 +1,6 @@
;;; guix-emacs.el --- Emacs packages installed with Guix
;; Copyright © 2014, 2015, 2016, 2017 Alex Kost <alezost@gmail.com>
;; Copyright © 2017 Kyle Meyer <kyle@kyleam.com>
;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com>
;; This file is part of GNU Guix.
@@ -20,14 +19,22 @@
;;; Commentary:
;; This file provides auxiliary code to autoload Emacs packages
;; This file provides auxiliary code for working with Emacs packages
;; installed with Guix.
;;; Code:
(require 'cl-lib)
(unless (require 'guix-profiles nil t)
(defvar guix-user-profile (expand-file-name "~/.guix-profile")))
(defvar guix-user-profile (expand-file-name "~/.guix-profile"))
(defcustom guix-package-enable-at-startup t
"If non-nil, activate Emacs packages installed in a user profile.
Set this variable to nil before requiring `guix-emacs' file to
avoid loading autoloads of Emacs packages installed in
`guix-user-profile'."
:type 'boolean
:group 'guix)
(defvar guix-emacs-autoloads nil
"List of the last loaded Emacs autoloads.")
@@ -85,14 +92,12 @@ profiles.
'Autoload' means add directories with Emacs packages to
`load-path' and load 'autoloads' files matching
`guix-emacs-autoloads-regexp'."
(interactive (list (if (fboundp 'guix-read-package-profile)
(funcall 'guix-read-package-profile)
(interactive (list (if (fboundp 'guix-profile-prompt)
(funcall 'guix-profile-prompt)
guix-user-profile)))
(let* ((env (getenv "GUIX_ENVIRONMENT"))
(profiles (or profiles
(append (list "/run/current-system/profile"
guix-user-profile)
(and env (list env))))))
(let ((profiles (or profiles
(list "/run/current-system/profile"
guix-user-profile))))
(dolist (profile profiles)
(let ((dirs (guix-emacs-directories profile)))
(when dirs
@@ -110,6 +115,9 @@ profiles.
(setq guix-emacs-autoloads
(append new-autoloads guix-emacs-autoloads))))))))
(when guix-package-enable-at-startup
(guix-emacs-autoload-packages))
(provide 'guix-emacs)
;;; guix-emacs.el ends here
+4 -23
View File
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -26,7 +26,7 @@ _guix_complete_subcommand ()
local subcommands="$(${COMP_WORDS[0]} $command --help 2> /dev/null \
| grep '^ [a-z]' \
| sed -e's/^ \+\([a-z-]\+\).*$/\1/g')"
COMPREPLY=($(compgen -W "$subcommands" -- "${COMP_WORDS[$COMP_CWORD]}"))
COMPREPLY=($(compgen -W "$subcommands" -- "${COMP_WORDS[${#COMP_WORDS[*]} - 1]}"))
}
_guix_complete_available_package ()
@@ -113,12 +113,6 @@ _guix_complete_file ()
COMPREPLY=()
}
_guix_complete_pid ()
{
local pids="$(cd /proc; echo [0-9]*)"
COMPREPLY=($(compgen -W "$pids" -- "$1"))
}
declare _guix_subcommands
_guix_complete ()
@@ -158,26 +152,13 @@ _guix_complete ()
else
_guix_complete_available_package "$word_at_point"
fi
elif _guix_is_command "download"
then
_guix_complete_file
elif _guix_is_command "system"
then
case $COMP_CWORD in
2) _guix_complete_subcommand;;
*) _guix_complete_file;; # TODO: restrict to *.scm
esac
elif _guix_is_command "container"
then
case $COMP_CWORD in
2) _guix_complete_subcommand;;
3) _guix_complete_pid "$word_at_point";;
*) _guix_complete_file;;
esac
_guix_complete_subcommand
elif _guix_is_command "import"
then
_guix_complete_subcommand
elif _guix_is_command "hash" || _guix_is_command "gc"
elif _guix_is_command "hash"
then
_guix_complete_file
else
+5 -17
View File
@@ -40,29 +40,17 @@ do
else
if [ "$remote_sha" = $z40 ]
then
# We are pushing a new branch. To prevent wasting too
# much time for this relatively rare case, we examine
# all commits since the first signed commit, rather than
# the full history. This check *will* fail, and the user
# will need to temporarily disable the hook to push the
# new branch.
range="e3d0fcbf7e55e8cbe8d0a1c5a24d73f341d7243b..$local_sha"
# New branch, examine all commits
range="$local_sha"
else
# Update to existing branch, examine new commits
range="$remote_sha..$local_sha"
fi
# Verify the signatures of all commits being pushed.
ret=0
for commit in $(git rev-list $range)
do
if ! git verify-commit $commit >/dev/null 2>&1
then
printf "%s failed signature check\n" $commit
ret=1
fi
done
exit $ret
git verify-commit $(git rev-list $range) >/dev/null 2>&1
exit $?
fi
done
+3 -1
View File
@@ -7,4 +7,6 @@ start on runlevel [2345]
stop on runlevel [016]
exec @localstatedir@/guix/profiles/per-user/root/guix-profile/bin/guix-daemon --build-users-group=guixbuild
task
exec @bindir@/guix-daemon --build-users-group=guixbuild
+2 -4
View File
@@ -6,16 +6,14 @@
Description=Build daemon for GNU Guix
[Service]
ExecStart=@localstatedir@/guix/profiles/per-user/root/guix-profile/bin/guix-daemon --build-users-group=guixbuild
ExecStart=@bindir@/guix-daemon --build-users-group=guixbuild
Environment=GUIX_LOCPATH=/root/.guix-profile/lib/locale
RemainAfterExit=yes
StandardOutput=syslog
StandardError=syslog
# See <https://lists.gnu.org/archive/html/guix-devel/2016-04/msg00608.html>.
# Some package builds (for example, go@1.8.1) may require even more than
# 1024 tasks.
TasksMax=8192
TasksMax=1024
[Install]
WantedBy=multi-user.target
+1 -1
View File
@@ -9,4 +9,4 @@ stop on runlevel [016]
task
exec @localstatedir@/guix/profiles/per-user/root/guix-profile/bin/guix publish --user=nobody --port=8181
exec @bindir@/guix publish --user=nobody --port=8181
+1 -1
View File
@@ -6,7 +6,7 @@
Description=Publish the GNU Guix store
[Service]
ExecStart=@localstatedir@/guix/profiles/per-user/root/guix-profile/bin/guix publish --user=nobody --port=8181
ExecStart=@bindir@/guix publish --user=nobody --port=8181
Environment=GUIX_LOCPATH=/root/.guix-profile/lib/locale
RemainAfterExit=yes
StandardOutput=syslog
-114
View File
@@ -1,114 +0,0 @@
#!@EMACS@ --script
;;; indent-code.el --- Run Emacs to indent a package definition.
;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;; Copyright © 2017 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This scripts indents the given file or package definition in the specified
;; file using Emacs.
;;; Code:
;; Load Scheme indentation rules from ".dir-locals.el".
(with-temp-buffer
(scheme-mode)
(let ((default-directory (file-name-as-directory load-file-name))
(enable-local-variables :all))
(hack-dir-local-variables)
(hack-local-variables-apply)))
;; Add indentation info for Scheme constructs that are not Guix-specific.
;; This is normally provided by Geiser but this file is for people who may not
;; be running Geiser, so we just copy it here (from 'geiser-syntax.el').
(defmacro guix-syntax--scheme-indent (&rest pairs)
`(progn ,@(mapcar (lambda (p)
`(put ',(car p) 'scheme-indent-function ',(cadr p)))
pairs)))
(guix-syntax--scheme-indent
(and-let* 1)
(case-lambda 0)
(catch defun)
(class defun)
(dynamic-wind 0)
(guard 1)
(let*-values 1)
(let-values 1)
(let/ec 1)
(letrec* 1)
(match 1)
(match-lambda 0)
(match-lambda* 0)
(match-let scheme-let-indent)
(match-let* 1)
(match-letrec 1)
(opt-lambda 1)
(parameterize 1)
(parameterize* 1)
(receive 2)
(require-extension 0)
(syntax-case 2)
(test-approximate 1)
(test-assert 1)
(test-eq 1)
(test-equal 1)
(test-eqv 1)
(test-group-with-cleanup 1)
(test-runner-on-bad-count! 1)
(test-runner-on-bad-end-name! 1)
(test-runner-on-final! 1)
(test-runner-on-group-begin! 1)
(test-runner-on-group-end! 1)
(test-runner-on-test-begin! 1)
(test-runner-on-test-end! 1)
(test-with-runner 1)
(unless 1)
(when 1)
(while 1)
(with-exception-handler 1)
(with-syntax 1))
(pcase command-line-args-left
(`(,file-name ,package-name)
;; Indent the definition of PACKAGE-NAME in FILE-NAME.
(find-file file-name)
(goto-char (point-min))
(if (re-search-forward (concat "^(define\\(-public\\) +"
package-name)
nil t)
(let ((indent-tabs-mode nil))
(beginning-of-defun)
(indent-sexp)
(save-buffer)
(message "Done!"))
(error "Package '%s' not found in '%s'"
package-name file-name)))
(`(,file-name)
;; Indent all of FILE-NAME.
(find-file file-name)
(let ((indent-tabs-mode nil))
(indent-region (point-min) (point-max))
(save-buffer)
(message "Done!")))
(x
(error "Usage: indent-code.el FILE [PACKAGE]")))
;;; indent-code.el ends here
+5 -99
View File
@@ -1,7 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,14 +18,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu)
#:use-module (guix i18n)
#:use-module (guix utils)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
#:use-module (guix packages)
#:use-module (gnu packages)
#:use-module (gnu services)
#:export (use-package-modules
use-service-modules
use-system-modules))
@@ -43,8 +34,7 @@
'((gnu system)
(gnu system mapped-devices)
(gnu system file-systems)
(gnu bootloader)
(gnu bootloader grub)
(gnu system grub) ; 'grub-configuration'
(gnu system pam)
(gnu system shadow) ; 'user-account'
(gnu system linux-initrd)
@@ -60,97 +50,13 @@
(module-use! i (resolve-interface m))))
%public-modules)))
(define (%try-use-modules modules location make-hint)
"Attempt to load all of MODULES. Report errors as coming from LOCATION, a
<location> record, and use MAKE-HINT to produce a fix hint."
(define (location->string loc)
(match loc
(#f "")
(($ <location> file line column)
(format #f "~a:~a:~a: " file line column))))
(for-each (lambda (module)
(catch 'misc-error
(lambda ()
(process-use-modules `((,module))))
(lambda _
(raise
(apply
make-compound-condition
(condition
(&message
(message (format #f (G_ "module ~a not found")
module))))
(condition
(&error-location (location location)))
(or (and=> (make-hint module) list)
'()))))))
modules))
(define (package-module-hint module)
(define last-name
(match module
((_ ... last)
(symbol->string last))))
(match (find-packages-by-name last-name)
(()
(condition
(&fix-hint
(hint (G_ "\
You may use @command{guix package --show=foo | grep location} to search
for the location of package @code{foo}.
If you get the line @code{location: gnu/packages/bar.scm:174:2},
add @code{bar} to the @code{use-package-modules} form.")))))
((package _ ...)
(condition
(&fix-hint
(hint (format #f (G_ "\
Try adding @code{(use-package-modules ~a)}.")
(basename (location-file (package-location package))
".scm"))))))))
(define (service-module-hint module)
(define last-name
(match module
((_ ... last)
last)))
(match (lookup-service-types last-name)
(()
(condition
(&fix-hint
(hint (format #f (G_ "\
You may use @command{guix system search ~a} to search for a service
matching @code{~a}.
If you get the line @code{location: gnu/services/foo.scm:188:2},
add @code{foo} to the @code{use-service-modules} form.")
last-name last-name)))))
((package _ ...)
(condition
(&fix-hint
(hint (format #f (G_ "\
Try adding @code{(use-service-modules ~a)}.")
(basename (location-file (service-type-location package))
".scm"))))))))
(define-syntax-rule (try-use-modules hint modules ...)
(eval-when (expand load eval)
(%try-use-modules '(modules ...)
(source-properties->location
(current-source-location))
hint)))
(define-syntax-rule (use-package-modules module ...)
(try-use-modules package-module-hint
(gnu packages module) ...))
(use-modules (gnu packages module) ...))
(define-syntax-rule (use-service-modules module ...)
(try-use-modules service-module-hint
(gnu services module) ...))
(use-modules (gnu services module) ...))
(define-syntax-rule (use-system-modules module ...)
(try-use-modules (const #f) ;no hint
(gnu system module) ...))
(use-modules (gnu system module) ...))
;;; gnu.scm ends here
+8 -12
View File
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,16 +28,13 @@
;;; Code:
(define %artwork-repository
(let ((commit "6998d30425289b087c64f63e7415df2241e591db"))
(origin
(method git-fetch)
(uri (git-reference
(url "git://git.savannah.gnu.org/guix/guix-artwork.git")
(commit commit)))
(file-name (string-append "guix-artwork-" (string-take commit 7)
"-checkout"))
(sha256
(base32
"0k7j3pj9s3zqiqmfkapypssvzx3f12yr0cc2rbzxqfii0b4clp1j")))))
(origin
(method git-fetch)
(uri (git-reference
(url "git://git.savannah.gnu.org/guix/guix-artwork.git")
(commit "6998d30")))
(sha256
(base32
"0k7j3pj9s3zqiqmfkapypssvzx3f12yr0cc2rbzxqfii0b4clp1j"))))
;;; artwork.scm ends here
-165
View File
@@ -1,165 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;;
;;; 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 (gnu bootloader)
#:use-module (guix discovery)
#:use-module (guix records)
#:use-module (guix ui)
#:use-module (srfi srfi-1)
#:export (menu-entry
menu-entry?
menu-entry-label
menu-entry-device
menu-entry-linux
menu-entry-linux-arguments
menu-entry-initrd
menu-entry-device-mount-point
bootloader
bootloader?
bootloader-name
bootloader-package
bootloader-installer
bootloader-configuration-file
bootloader-configuration-file-generator
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
bootloader-configuration-target
bootloader-configuration-menu-entries
bootloader-configuration-default-entry
bootloader-configuration-timeout
bootloader-configuration-theme
bootloader-configuration-terminal-outputs
bootloader-configuration-terminal-inputs
bootloader-configuration-serial-unit
bootloader-configuration-serial-speed
bootloader-configuration-additional-configuration
%bootloaders
lookup-bootloader-by-name))
;;;
;;; Menu-entry record.
;;;
(define-record-type* <menu-entry>
menu-entry make-menu-entry
menu-entry?
(label menu-entry-label)
(device menu-entry-device ; file system uuid, label, or #f
(default #f))
(device-mount-point menu-entry-device-mount-point
(default #f))
(linux menu-entry-linux)
(linux-arguments menu-entry-linux-arguments
(default '())) ; list of string-valued gexps
(initrd menu-entry-initrd)) ; file name of the initrd as a gexp
;;;
;;; Bootloader record.
;;;
;; The <bootloader> record contains fields expressing how the bootloader
;; should be installed. Every bootloader in gnu/bootloader/ directory
;; has to be described by this record.
(define-record-type* <bootloader>
bootloader make-bootloader
bootloader?
(name bootloader-name)
(package bootloader-package)
(installer bootloader-installer)
(configuration-file bootloader-configuration-file)
(configuration-file-generator bootloader-configuration-file-generator))
;;;
;;; Bootloader configuration record.
;;;
;; The <bootloader-configuration> record contains bootloader independant
;; configuration used to fill bootloader configuration file.
(define-record-type* <bootloader-configuration>
bootloader-configuration make-bootloader-configuration
bootloader-configuration?
(bootloader bootloader-configuration-bootloader) ; <bootloader>
(device bootloader-configuration-device ; string
(default #f))
(target %bootloader-configuration-target ; string
(default #f))
(menu-entries bootloader-configuration-menu-entries ; list of <boot-parameters>
(default '()))
(default-entry bootloader-configuration-default-entry ; integer
(default 0))
(timeout bootloader-configuration-timeout ; seconds as integer
(default 5))
(theme bootloader-configuration-theme ; bootloader-specific theme
(default #f))
(terminal-outputs bootloader-configuration-terminal-outputs ; list of symbols
(default '(gfxterm)))
(terminal-inputs bootloader-configuration-terminal-inputs ; list of symbols
(default '()))
(serial-unit bootloader-configuration-serial-unit ; integer | #f
(default #f))
(serial-speed bootloader-configuration-serial-speed ; integer | #f
(default #f))
(additional-configuration bootloader-configuration-additional-configuration ; record
(default #f)))
(define (bootloader-configuration-target config)
(or (%bootloader-configuration-target config)
(let ((device (bootloader-configuration-device config)))
(when device
(warning
(G_ "The 'device' field of bootloader configurations is deprecated.~%"))
(warning (G_ "Use 'target' instead.~%")))
device)))
;;;
;;; Bootloaders.
;;;
(define (bootloader-modules)
"Return the list of bootloader modules."
(all-modules (map (lambda (entry)
`(,entry . "gnu/bootloader"))
%load-path)))
(define %bootloaders
;; The list of publically-known bootloaders.
(delay (fold-module-public-variables (lambda (obj result)
(if (bootloader? obj)
(cons obj result)
result))
'()
(bootloader-modules))))
(define (lookup-bootloader-by-name name)
"Return the bootloader called NAME."
(or (find (lambda (bootloader)
(eq? name (bootloader-name bootloader)))
(force %bootloaders))
(leave (G_ "~a: no such bootloader~%") name)))
-132
View File
@@ -1,132 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; 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 (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu system)
#:use-module (gnu packages bootloaders)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix utils)
#:export (extlinux-bootloader
extlinux-bootloader-gpt))
(define* (extlinux-configuration-file config entries
#:key
(system (%current-system))
(old-entries '()))
"Return the U-Boot configuration file corresponding to CONFIG, a
<u-boot-configuration> object, and where the store is available at STORE-FS, a
<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
corresponding to old generations of the system."
(define all-entries
(append entries (bootloader-configuration-menu-entries config)))
(define (menu-entry->gexp entry)
(let ((label (menu-entry-label entry))
(kernel (menu-entry-linux entry))
(kernel-arguments (menu-entry-linux-arguments entry))
(initrd (menu-entry-initrd entry)))
#~(format port "LABEL ~a
MENU LABEL ~a
KERNEL ~a
FDTDIR ~a/lib/dtbs
INITRD ~a
APPEND ~a
~%"
#$label #$label
#$kernel (dirname #$kernel) #$initrd
(string-join (list #$@kernel-arguments)))))
(define builder
#~(call-with-output-file #$output
(lambda (port)
(let ((timeout #$(bootloader-configuration-timeout config)))
(format port "# This file was generated from your GuixSD configuration. Any changes
# will be lost upon reconfiguration.
UI menu.c32
PROMPT ~a
TIMEOUT ~a~%"
(if (> timeout 0) 1 0)
;; timeout is expressed in 1/10s of seconds.
(* 10 timeout))
#$@(map menu-entry->gexp all-entries)
#$@(if (pair? old-entries)
#~((format port "~%")
#$@(map menu-entry->gexp old-entries)
(format port "~%"))
#~())))))
(gexp->derivation "extlinux.conf" builder))
;;;
;;; Install procedures.
;;;
(define dd
#~(lambda (bs count if of)
(zero? (system* "dd"
(string-append "bs=" (number->string bs))
(string-append "count=" (number->string count))
(string-append "if=" if)
(string-append "of=" of)))))
(define (install-extlinux mbr)
#~(lambda (bootloader device mount-point)
(let ((extlinux (string-append bootloader "/sbin/extlinux"))
(install-dir (string-append mount-point "/boot/extlinux"))
(syslinux-dir (string-append bootloader "/share/syslinux")))
(for-each (lambda (file)
(install-file file install-dir))
(find-files syslinux-dir "\\.c32$"))
(unless (and (zero? (system* extlinux "--install" install-dir))
(#$dd 440 1 (string-append syslinux-dir "/" #$mbr) device))
(error "failed to install SYSLINUX")))))
(define install-extlinux-mbr
(install-extlinux "mbr.bin"))
(define install-extlinux-gpt
(install-extlinux "gptmbr.bin"))
;;;
;;; Bootloader definitions.
;;;
(define extlinux-bootloader
(bootloader
(name 'extlinux)
(package syslinux)
(installer install-extlinux-mbr)
(configuration-file "/boot/extlinux/extlinux.conf")
(configuration-file-generator extlinux-configuration-file)))
(define extlinux-bootloader-gpt
(bootloader
(inherit extlinux-bootloader)
(installer install-extlinux-gpt)))
-453
View File
@@ -1,453 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; 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 (gnu bootloader grub)
#:use-module (guix store)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix records)
#:use-module (guix monads)
#:use-module (guix gexp)
#:use-module (guix download)
#:use-module (gnu artwork)
#:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system uuid)
#:autoload (gnu packages bootloaders) (grub)
#:autoload (gnu packages compression) (gzip)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
#:autoload (gnu packages guile) (guile-2.2)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (rnrs bytevectors)
#:export (grub-image
grub-image?
grub-image-aspect-ratio
grub-image-file
grub-theme
grub-theme?
grub-theme-images
grub-theme-color-normal
grub-theme-color-highlight
%background-image
%default-theme
grub-bootloader
grub-efi-bootloader
grub-mkrescue-bootloader
grub-configuration))
;;; Commentary:
;;;
;;; Configuration of GNU GRUB.
;;;
;;; Code:
(define (strip-mount-point mount-point file)
"Strip MOUNT-POINT from FILE, which is a gexp or other lowerable object
denoting a file name."
(match mount-point
((? string? mount-point)
(if (string=? mount-point "/")
file
#~(let ((file #$file))
(if (string-prefix? #$mount-point file)
(substring #$file #$(string-length mount-point))
file))))
(#f file)))
(define-record-type* <grub-image>
grub-image make-grub-image
grub-image?
(aspect-ratio grub-image-aspect-ratio ;rational number
(default 4/3))
(file grub-image-file)) ;file-valued gexp (SVG)
(define-record-type* <grub-theme>
grub-theme make-grub-theme
grub-theme?
(images grub-theme-images
(default '())) ;list of <grub-image>
(color-normal grub-theme-color-normal
(default '((fg . cyan) (bg . blue))))
(color-highlight grub-theme-color-highlight
(default '((fg . white) (bg . blue)))))
(define %background-image
(grub-image
(aspect-ratio 4/3)
(file (file-append %artwork-repository
"/grub/GuixSD-fully-black-4-3.svg"))))
(define %default-theme
;; Default theme contributed by Felipe López.
(grub-theme
(images (list %background-image))
(color-highlight '((fg . yellow) (bg . black)))
(color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030
;;;
;;; Background image & themes.
;;;
(define (bootloader-theme config)
"Return user defined theme in CONFIG if defined or %default-theme
otherwise."
(or (bootloader-configuration-theme config) %default-theme))
(define* (svg->png svg #:key width height)
"Build a PNG of HEIGHT x WIDTH from SVG."
;; Note: Guile-RSVG & co. are now built for Guile 2.2, so we use 2.2 here.
;; TODO: Remove #:guile-for-build when 2.2 has become the default.
(mlet %store-monad ((guile (package->derivation guile-2.2 #:graft? #f)))
(gexp->derivation "grub-image.png"
(with-imported-modules '((gnu build svg))
#~(begin
;; We need these two libraries.
(add-to-load-path (string-append #+guile-rsvg
"/share/guile/site/"
(effective-version)))
(add-to-load-path (string-append #+guile-cairo
"/share/guile/site/"
(effective-version)))
(use-modules (gnu build svg))
(svg->png #+svg #$output
#:width #$width
#:height #$height)))
#:guile-for-build guile)))
(define* (grub-background-image config #:key (width 1024) (height 768))
"Return the GRUB background image defined in CONFIG with a ratio of
WIDTH/HEIGHT, or #f if none was found."
(let* ((ratio (/ width height))
(image (find (lambda (image)
(= (grub-image-aspect-ratio image) ratio))
(grub-theme-images
(bootloader-theme config)))))
(if image
(svg->png (grub-image-file image)
#:width width #:height height)
(with-monad %store-monad
(return #f)))))
(define* (eye-candy config store-device store-mount-point
#:key system port)
"Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the
'grub.cfg' part concerned with graphics mode, background images, colors, and
all that. STORE-DEVICE designates the device holding the store, and
STORE-MOUNT-POINT is its mount point; these are used to determine where the
background image and fonts must be searched for. SYSTEM must be the target
system string---e.g., \"x86_64-linux\"."
(define setup-gfxterm-body
;; Intel and EFI systems need to be switched into graphics mode, whereas
;; most other modern architectures have no other mode and therefore don't
;; need to be switched.
(if (string-match "^(x86_64|i[3-6]86)-" system)
"
# Leave 'gfxmode' to 'auto'.
insmod video_bochs
insmod video_cirrus
insmod gfxterm
if [ \"${grub_platform}\" == efi ]; then
# This is for (U)EFI systems (these modules are unavailable in the
# non-EFI GRUB.) If we don't load them, GRUB boots in \"blind mode\",
# which isn't convenient.
insmod efi_gop
insmod efi_uga
else
# These are specific to non-EFI Intel machines.
insmod vbe
insmod vga
fi
"
""))
(define (setup-gfxterm config font-file)
(if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
#~(format #f "if loadfont ~a; then
setup_gfxterm
fi~%" #$font-file)
""))
(define (theme-colors type)
(let* ((theme (bootloader-theme config))
(colors (type theme)))
(string-append (symbol->string (assoc-ref colors 'fg)) "/"
(symbol->string (assoc-ref colors 'bg)))))
(define font-file
(strip-mount-point store-mount-point
(file-append grub "/share/grub/unicode.pf2")))
(mlet* %store-monad ((image (grub-background-image config)))
(return (and image
#~(format #$port "
function setup_gfxterm {~a}
# Set 'root' to the partition that contains /gnu/store.
~a
~a
~a
insmod png
if background_image ~a; then
set color_normal=~a
set color_highlight=~a
else
set menu_color_normal=cyan/blue
set menu_color_highlight=white/blue
fi~%"
#$setup-gfxterm-body
#$(grub-root-search store-device font-file)
#$(setup-gfxterm config font-file)
#$(grub-setup-io config)
#$(strip-mount-point store-mount-point image)
#$(theme-colors grub-theme-color-normal)
#$(theme-colors grub-theme-color-highlight))))))
;;;
;;; Configuration file.
;;;
(define (grub-setup-io config)
"Return GRUB commands to configure the input / output interfaces. The result
is a string that can be inserted in grub.cfg."
(let* ((symbols->string (lambda (list)
(string-join (map symbol->string list) " ")))
(outputs (bootloader-configuration-terminal-outputs config))
(inputs (bootloader-configuration-terminal-inputs config))
(unit (bootloader-configuration-serial-unit config))
(speed (bootloader-configuration-serial-speed config))
;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
;; as documented in GRUB manual section "Simple Configuration
;; Handling".
(valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
gfxterm vga_text mda_text morse spkmodem))
(valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
at_keyboard usb_keyboard))
(io (string-append
"terminal_output "
(symbols->string
(map
(lambda (output)
(if (memq output valid-outputs) output #f)) outputs)) "\n"
(if (null? inputs)
""
(string-append
"terminal_input "
(symbols->string
(map
(lambda (input)
(if (memq input valid-inputs) input #f)) inputs)) "\n"))
;; UNIT and SPEED are arguments to the same GRUB command
;; ("serial"), so we process them together.
(if (or unit speed)
(string-append
"serial"
(if unit
;; COM ports 1 through 4
(if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
(string-append " --unit=" (number->string unit))
#f)
"")
(if speed
(if (exact-integer? speed)
(string-append " --speed=" (number->string speed))
#f)
""))
""))))
(format #f "~a" io)))
(define (grub-root-search device file)
"Return the GRUB 'search' command to look for DEVICE, which contains FILE,
a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
code."
;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
;; custom menu entries. In the latter case, don't emit a 'search' command.
(if (and (string? file) (not (string-prefix? "/" file)))
""
(match device
;; Preferably refer to DEVICE by its UUID or label. This is more
;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
((? uuid? uuid)
(format #f "search --fs-uuid --set ~a"
(uuid->string device)))
((? string? label)
(format #f "search --label --set ~a" label))
(#f
#~(format #f "search --file --set ~a" #$file)))))
(define* (grub-configuration-file config entries
#:key
(system (%current-system))
(old-entries '()))
"Return the GRUB configuration file corresponding to CONFIG, a
<bootloader-configuration> object, and where the store is available at
STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
entries corresponding to old generations of the system."
(define all-entries
(append entries (bootloader-configuration-menu-entries config)))
(define (menu-entry->gexp entry)
(let ((device (menu-entry-device entry))
(device-mount-point (menu-entry-device-mount-point entry))
(label (menu-entry-label entry))
(kernel (menu-entry-linux entry))
(arguments (menu-entry-linux-arguments entry))
(initrd (menu-entry-initrd entry)))
;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
;; Use the right file names for KERNEL and INITRD in case
;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
;; separate partition.
(let ((kernel (strip-mount-point device-mount-point kernel))
(initrd (strip-mount-point device-mount-point initrd)))
#~(format port "menuentry ~s {
~a
linux ~a ~a
initrd ~a
}~%"
#$label
#$(grub-root-search device kernel)
#$kernel (string-join (list #$@arguments))
#$initrd))))
(mlet %store-monad ((sugar (eye-candy config
(menu-entry-device
(first all-entries))
(menu-entry-device-mount-point
(first all-entries))
#:system system
#:port #~port)))
(define builder
#~(call-with-output-file #$output
(lambda (port)
(format port
"# This file was generated from your GuixSD configuration. Any changes
# will be lost upon reconfiguration.
")
#$sugar
(format port "
set default=~a
set timeout=~a~%"
#$(bootloader-configuration-default-entry config)
#$(bootloader-configuration-timeout config))
#$@(map menu-entry->gexp all-entries)
#$@(if (pair? old-entries)
#~((format port "
submenu \"GNU system, old configurations...\" {~%")
#$@(map menu-entry->gexp old-entries)
(format port "}~%"))
#~()))))
(gexp->derivation "grub.cfg" builder)))
;;;
;;; Install procedures.
;;;
(define install-grub
#~(lambda (bootloader device mount-point)
;; Install GRUB on DEVICE which is mounted at MOUNT-POINT.
(let ((grub (string-append bootloader "/sbin/grub-install"))
(install-dir (string-append mount-point "/boot")))
;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
;; root partition.
(setenv "GRUB_ENABLE_CRYPTODISK" "y")
(unless (zero? (system* grub "--no-floppy"
"--boot-directory" install-dir
device))
(error "failed to install GRUB (BIOS)")))))
(define install-grub-efi
#~(lambda (bootloader efi-dir mount-point)
;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
;; system whose root is mounted at MOUNT-POINT.
(let ((grub-install (string-append bootloader "/sbin/grub-install"))
(install-dir (string-append mount-point "/boot")))
;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
;; root partition.
(setenv "GRUB_ENABLE_CRYPTODISK" "y")
(unless (zero? (system* grub-install "--boot-directory" install-dir
"--efi-directory" efi-dir))
(error "failed to install GRUB (EFI)")))))
;;;
;;; Bootloader definitions.
;;;
(define grub-bootloader
(bootloader
(name 'grub)
(package grub)
(installer install-grub)
(configuration-file "/boot/grub/grub.cfg")
(configuration-file-generator grub-configuration-file)))
(define* grub-efi-bootloader
(bootloader
(inherit grub-bootloader)
(installer install-grub-efi)
(name 'grub-efi)
(package grub-efi)))
(define* grub-mkrescue-bootloader
(bootloader
(inherit grub-efi-bootloader)
(package grub-hybrid)))
;;;
;;; Compatibility macros.
;;;
(define-syntax grub-configuration
(syntax-rules (grub)
((_ (grub package) fields ...)
(if (eq? package grub)
(bootloader-configuration
(bootloader grub-bootloader)
fields ...)
(bootloader-configuration
(bootloader grub-efi-bootloader)
fields ...)))
((_ fields ...)
(bootloader-configuration
(bootloader grub-bootloader)
fields ...))))
;;; grub.scm ends here
-47
View File
@@ -1,47 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; 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 (gnu bootloader u-boot)
#:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu system)
#:use-module (gnu packages bootloaders)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix utils)
#:export (u-boot-bootloader))
(define install-u-boot
#~(lambda (bootloader device mount-point)
(if bootloader
(error "Failed to install U-Boot"))))
;;;
;;; Bootloader definitions.
;;;
(define u-boot-bootloader
(bootloader
(inherit extlinux-bootloader)
(name 'u-boot)
(package #f)
(installer install-u-boot)))
+28 -65
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -25,10 +25,9 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (activate-users+groups
activate-user-home
activate-etc
activate-setuid-programs
activate-special-files
activate-/bin/sh
activate-modprobe
activate-firmware
activate-ptrace-attach
@@ -79,28 +78,22 @@
(define (dot-or-dot-dot? file)
(member file '("." "..")))
(define* (copy-account-skeletons home
#:key
(directory %skeleton-directory)
uid gid)
"Copy the account skeletons from DIRECTORY to HOME. When UID is an integer,
make it the owner of all the files created; likewise for GID."
(define (set-owner file)
(when (or uid gid)
(chown file (or uid -1) (or gid -1))))
(define (make-file-writable file)
"Make FILE writable for its owner.."
(let ((stat (lstat file))) ;XXX: symlinks
(chmod file (logior #o600 (stat:perms stat)))))
(define* (copy-account-skeletons home
#:optional (directory %skeleton-directory))
"Copy the account skeletons from DIRECTORY to HOME."
(let ((files (scandir directory (negate dot-or-dot-dot?)
string<?)))
(mkdir-p home)
(set-owner home)
(for-each (lambda (file)
(let ((target (string-append home "/" file)))
(copy-recursively (string-append directory "/" file)
target
#:log (%make-void-port "w"))
(for-each set-owner
(find-files target (const #t)
#:directories? #t))
(make-file-writable target)))
files)))
@@ -130,15 +123,14 @@ properties. Return #t on success."
;; 'useradd' fails with "Cannot determine your user name" if the root
;; account doesn't exist. Thus, for bootstrapping purposes, create that
;; one manually.
(let ((home (or home "/root")))
(begin
(call-with-output-file "/etc/shadow"
(cut format <> "~a::::::::~%" name))
(call-with-output-file "/etc/passwd"
(cut format <> "~a:x:~a:~a:~a:~a:~a~%"
name "0" "0" comment home shell))
(chmod "/etc/shadow" #o600)
(copy-account-skeletons home)
(chmod home #o700)
(copy-account-skeletons (or home "/root"))
#t)
;; Use 'useradd' from the Shadow package.
@@ -228,11 +220,7 @@ numeric gid or #f."
#:supplementary-groups supplementary-groups
#:comment comment
#:home home
;; Home directories of non-system accounts are created by
;; 'activate-user-home'.
#:create-home? (and create-home? system?)
#:create-home? create-home?
#:shell shell
#:password password)
@@ -280,28 +268,6 @@ numeric gid or #f."
(((names . _) ...)
names)))))
(define (activate-user-home users)
"Create and populate the home directory of USERS, a list of tuples, unless
they already exist."
(define ensure-user-home
(match-lambda
((name uid group supplementary-groups comment home create-home?
shell password system?)
;; The home directories of system accounts are created during
;; activation, not here.
(unless (or (not home) (not create-home?) system?
(directory-exists? home))
(let* ((pw (getpwnam name))
(uid (passwd:uid pw))
(gid (passwd:gid pw)))
(mkdir-p home)
(chown home uid gid)
(unless system?
(copy-account-skeletons home
#:uid uid #:gid gid)))))))
(for-each ensure-user-home users))
(define (activate-etc etc)
"Install ETC, a directory in the store, as the source of static files for
/etc."
@@ -313,7 +279,6 @@ they already exist."
(false-if-exception (delete-file file)))
(format #t "populating /etc from ~a...~%" etc)
(mkdir-p "/etc")
;; Create the /etc/ssl -> /run/current-system/profile/etc/ssl symlink. This
;; symlink, to a target outside of the store, probably doesn't belong in the
@@ -353,13 +318,24 @@ they already exist."
;; Place where setuid programs are stored.
"/run/setuid-programs")
(define (link-or-copy source target)
"Attempt to make TARGET a hard link to SOURCE; if it fails, fall back to
copy SOURCE to TARGET."
(catch 'system-error
(lambda ()
(link source target))
(lambda args
;; Perhaps SOURCE and TARGET live in a different file system, so copy
;; SOURCE.
(copy-file source target))))
(define (activate-setuid-programs programs)
"Turn PROGRAMS, a list of file names, into setuid programs stored under
%SETUID-DIRECTORY."
(define (make-setuid-program prog)
(let ((target (string-append %setuid-directory
"/" (basename prog))))
(copy-file prog target)
(link-or-copy prog target)
(chown target 0 0)
(chmod target #o6555)))
@@ -376,23 +352,10 @@ they already exist."
(for-each make-setuid-program programs))
(define (activate-special-files special-files)
"Install the files listed in SPECIAL-FILES. Each element of SPECIAL-FILES
is a pair where the first element is the name of the special file and the
second element is the name it should appear at, such as:
((\"/bin/sh\" \"/gnu/store/…-bash/bin/sh\")
(\"/usr/bin/env\" \"/gnu/store/…-coreutils/bin/env\"))
"
(define install-special-file
(match-lambda
((target file)
(let ((pivot (string-append target ".new")))
(mkdir-p (dirname target))
(symlink file pivot)
(rename-file pivot target)))))
(for-each install-special-file special-files))
(define (activate-/bin/sh shell)
"Change /bin/sh to point to SHELL."
(symlink shell "/bin/sh.new")
(rename-file "/bin/sh.new" "/bin/sh"))
(define (activate-modprobe modprobe)
"Tell the kernel to use MODPROBE to load modules."
+152 -220
View File
@@ -1,7 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,16 +18,15 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build file-systems)
#:use-module (gnu system uuid)
#:use-module (gnu system file-systems)
#:use-module (guix build utils)
#:use-module (guix build bournish)
#:use-module ((guix build syscalls)
#:hide (file-system-type))
#:use-module (guix build syscalls)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 format)
#:use-module (ice-9 regex)
#:use-module (system foreign)
#:autoload (system repl repl) (start-repl)
#:use-module (srfi srfi-1)
@@ -42,11 +40,19 @@
find-partition-by-luks-uuid
canonicalize-device-spec
uuid->string
string->uuid
bind-mount
mount-flags->bit-mask
check-file-system
mount-file-system))
mount-file-system)
#:re-export (mount
umount
MS_BIND
MS_MOVE
MS_RDONLY))
;;; Commentary:
;;;
@@ -55,40 +61,48 @@
;;;
;;; Code:
;; 'mount' is already defined in the statically linked Guile used for initial
;; RAM disks, in which case the bindings in (guix build syscalls) do not work
;; (the FFI bindings do not work there). Override them in that case.
(when (module-defined? the-scm-module 'mount)
(set! mount (@ (guile) mount))
(set! umount (@ (guile) umount)))
(define (bind-mount source target)
"Bind-mount SOURCE at TARGET."
(mount source target "" MS_BIND))
(define (seek* fd/port offset whence)
"Like 'seek' but return -1 instead of throwing to 'system-error' upon
EINVAL. This makes it easier to catch cases like OFFSET being too large for
FD/PORT."
(catch 'system-error
(lambda ()
(seek fd/port offset whence))
(lambda args
(if (= EINVAL (system-error-errno args))
-1
(apply throw args)))))
(define (read-superblock device offset size magic?)
"Read a superblock of SIZE from OFFSET and DEVICE. Return the raw
superblock on success, and #f if no valid superblock was found. MAGIC?
takes a bytevector and returns #t when it's a valid superblock."
(call-with-input-file device
(lambda (port)
(and (= offset (seek* port offset SEEK_SET))
(let ((block (make-bytevector size)))
(match (get-bytevector-n! port block 0 (bytevector-length block))
((? eof-object?)
#f)
((? number? len)
(and (= len (bytevector-length block))
(and (magic? block)
block)))))))))
(seek port offset SEEK_SET)
(define null-terminated-latin1->string
(cut latin1->string <> zero?))
(let ((block (make-bytevector size)))
(match (get-bytevector-n! port block 0 (bytevector-length block))
((? eof-object?)
#f)
((? number? len)
(and (= len (bytevector-length block))
(and (magic? block)
block))))))))
(define (sub-bytevector bv start size)
"Return a copy of the SIZE bytes of BV starting from offset START."
(let ((result (make-bytevector size)))
(bytevector-copy! bv start result 0 size)
result))
(define (null-terminated-latin1->string bv)
"Return the volume name of SBLOCK as a string of at most 256 characters, or
#f if SBLOCK has no volume name."
;; This is a Latin-1, nul-terminated string.
(let ((bytes (take-while (negate zero?) (bytevector->u8-list bv))))
(if (null? bytes)
#f
(list->string (map integer->char bytes)))))
;;;
@@ -167,128 +181,6 @@ if DEVICE does not contain a btrfs file system."
(0 'pass)
(_ 'fatal-error)))
;;;
;;; FAT32 file systems.
;;;
;; <http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-107.pdf>.
(define (fat32-superblock? sblock)
"Return #t when SBLOCK is a fat32 superblock."
(bytevector=? (sub-bytevector sblock 82 8)
(string->utf8 "FAT32 ")))
(define (read-fat32-superblock device)
"Return the raw contents of DEVICE's fat32 superblock as a bytevector, or
#f if DEVICE does not contain a fat32 file system."
(read-superblock device 0 90 fat32-superblock?))
(define (fat32-superblock-uuid sblock)
"Return the Volume ID of a fat superblock SBLOCK as a 4-byte bytevector."
(sub-bytevector sblock 67 4))
(define (fat32-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string of at most 11 characters, or
#f if SBLOCK has no volume name. The volume name is a latin1 string.
Trailing spaces are trimmed."
(string-trim-right (latin1->string (sub-bytevector sblock 71 11) (lambda (c) #f)) #\space))
(define (check-fat-file-system device)
"Return the health of a fat file system on DEVICE."
(match (status:exit-val
(system* "fsck.vfat" "-v" "-a" device))
(0 'pass)
(1 'errors-corrected)
(_ 'fatal-error)))
;;;
;;; FAT16 file systems.
;;;
(define (fat16-superblock? sblock)
"Return #t when SBLOCK is a fat16 boot record."
(bytevector=? (sub-bytevector sblock 54 8)
(string->utf8 "FAT16 ")))
(define (read-fat16-superblock device)
"Return the raw contents of DEVICE's fat16 superblock as a bytevector, or
#f if DEVICE does not contain a fat16 file system."
(read-superblock device 0 62 fat16-superblock?))
(define (fat16-superblock-uuid sblock)
"Return the Volume ID of a fat superblock SBLOCK as a 4-byte bytevector."
(sub-bytevector sblock 39 4))
(define (fat16-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string of at most 11 characters, or
#f if SBLOCK has no volume name. The volume name is a latin1 string.
Trailing spaces are trimmed."
(string-trim-right (latin1->string (sub-bytevector sblock 43 11)
(lambda (c) #f))
#\space))
;;;
;;; ISO9660 file systems.
;;;
;; <http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-119.pdf>.
(define (iso9660-superblock? sblock)
"Return #t when SBLOCK is an iso9660 volume descriptor."
(bytevector=? (sub-bytevector sblock 1 6)
;; Note: "\x01" is the volume descriptor format version
(string->utf8 "CD001\x01")))
(define (read-iso9660-primary-volume-descriptor device offset)
"Find and read the first primary volume descriptor, starting at OFFSET.
Return #f if not found."
(let* ((sblock (read-superblock device offset 2048 iso9660-superblock?))
(type-code (if sblock
(bytevector-u8-ref sblock 0)
(error (format #f
"Could not read ISO9660 primary
volume descriptor from ~s"
device)))))
(match type-code
(255 #f) ; Volume Descriptor Set Terminator.
(1 sblock) ; Primary Volume Descriptor
(_ (read-iso9660-primary-volume-descriptor device (+ offset 2048))))))
(define (read-iso9660-superblock device)
"Return the raw contents of DEVICE's iso9660 primary volume descriptor
as a bytevector, or #f if DEVICE does not contain an iso9660 file system."
;; Start reading at sector 16.
;; Since we are not sure that the device contains an ISO9660 filesystem,
;; we have to find that out first.
(if (read-superblock device (* 2048 16) 2048 iso9660-superblock?)
(read-iso9660-primary-volume-descriptor device (* 2048 16))
#f)) ; Device does not contain an iso9660 filesystem.
(define (iso9660-superblock-uuid sblock)
"Return the modification time of an iso9660 primary volume descriptor
SBLOCK as a bytevector. If that's not set, returns the creation time."
;; Drops GMT offset for compatibility with Grub, blkid and /dev/disk/by-uuid.
;; Compare Grub: "2014-12-02-19-30-23-00".
;; Compare blkid result: "2014-12-02-19-30-23-00".
;; Compare /dev/disk/by-uuid entry: "2014-12-02-19-30-23-00".
(let* ((creation-time (sub-bytevector sblock 813 17))
(modification-time (sub-bytevector sblock 830 17))
(unset-time (make-bytevector 17 0))
(time (if (bytevector=? unset-time modification-time)
creation-time
modification-time)))
(sub-bytevector time 0 16))) ; strips GMT offset.
(define (iso9660-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string. The volume name is an ASCII
string. Trailing spaces are trimmed."
;; Note: Valid characters are of the set "[0-9][A-Z]_" (ECMA-119 Appendix A)
(string-trim-right (latin1->string (sub-bytevector sblock 40 32)
(lambda (c) #f)) #\space))
;;;
;;; LUKS encrypted devices.
@@ -333,16 +225,15 @@ not valid header was found."
(define (disk-partitions)
"Return the list of device names corresponding to valid disk partitions."
(define (last-character str)
(string-ref str (- (string-length str) 1)))
(define (partition? name major minor)
;; grub-mkrescue does some funny things for EFI support which
;; makes it a lot more difficult than one would expect to support
;; booting an ISO-9660 image from an USB flash drive.
;; For example there's a buggy (too small) hidden partition in it
;; which Linux mounts and then proceeds to fail while trying to
;; fall off the edge.
;; In any case, partition tables are supposed to be optional so
;; here we allow checking entire disks for file systems, too.
(> major 2)) ;ignore RAM disks and floppy disks
;; Select device names that end in a digit, like libblkid's 'probe_all'
;; function does. Checking for "/sys/dev/block/MAJOR:MINOR/partition"
;; doesn't work for partitions coming from mapped devices.
(and (char-set-contains? char-set:digit (last-character name))
(> major 2))) ;ignore RAM disks and floppy disks
(call-with-input-file "/proc/partitions"
(lambda (port)
@@ -381,10 +272,6 @@ warning and #f as the result."
#f)
((= ENOMEDIUM errno) ;for removable media
#f)
((= EIO errno) ;unreadable hardware like audio CDs
(format (current-error-port)
"warning: failed to read from device '~a'~%" device)
#f)
(else
(apply throw args))))))))
@@ -406,28 +293,16 @@ partition field reader that returned a value."
(_ #f)))
(define %partition-label-readers
(list (partition-field-reader read-iso9660-superblock
iso9660-superblock-volume-name)
(partition-field-reader read-ext2-superblock
(list (partition-field-reader read-ext2-superblock
ext2-superblock-volume-name)
(partition-field-reader read-btrfs-superblock
btrfs-superblock-volume-name)
(partition-field-reader read-fat32-superblock
fat32-superblock-volume-name)
(partition-field-reader read-fat16-superblock
fat16-superblock-volume-name)))
btrfs-superblock-volume-name)))
(define %partition-uuid-readers
(list (partition-field-reader read-iso9660-superblock
iso9660-superblock-uuid)
(partition-field-reader read-ext2-superblock
(list (partition-field-reader read-ext2-superblock
ext2-superblock-uuid)
(partition-field-reader read-btrfs-superblock
btrfs-superblock-uuid)
(partition-field-reader read-fat32-superblock
fat32-superblock-uuid)
(partition-field-reader read-fat16-superblock
fat16-superblock-uuid)))
btrfs-superblock-uuid)))
(define read-partition-label
(cut read-partition-field <> %partition-label-readers))
@@ -448,12 +323,12 @@ was READ is = to the given value."
(partition-predicate read-partition-label string=?))
(define partition-uuid-predicate
(partition-predicate read-partition-uuid uuid=?))
(partition-predicate read-partition-uuid bytevector=?))
(define luks-partition-uuid-predicate
(partition-predicate
(partition-field-reader read-luks-header luks-header-uuid)
uuid=?))
bytevector=?))
(define (find-partition predicate)
"Return the first partition found that matches PREDICATE, or #f if none
@@ -472,6 +347,60 @@ were found."
(define find-partition-by-luks-uuid
(find-partition luks-partition-uuid-predicate))
;;;
;;; UUIDs.
;;;
(define-syntax %network-byte-order
(identifier-syntax (endianness big)))
(define (uuid->string uuid)
"Convert UUID, a 16-byte bytevector, to its string representation, something
like \"6b700d61-5550-48a1-874c-a3d86998990e\"."
;; See <https://tools.ietf.org/html/rfc4122>.
(let ((time-low (bytevector-uint-ref uuid 0 %network-byte-order 4))
(time-mid (bytevector-uint-ref uuid 4 %network-byte-order 2))
(time-hi (bytevector-uint-ref uuid 6 %network-byte-order 2))
(clock-seq (bytevector-uint-ref uuid 8 %network-byte-order 2))
(node (bytevector-uint-ref uuid 10 %network-byte-order 6)))
(format #f "~8,'0x-~4,'0x-~4,'0x-~4,'0x-~12,'0x"
time-low time-mid time-hi clock-seq node)))
(define %uuid-rx
;; The regexp of a UUID.
(make-regexp "^([[:xdigit:]]{8})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{12})$"))
(define (string->uuid str)
"Parse STR as a DCE UUID (see <https://tools.ietf.org/html/rfc4122>) and
return its contents as a 16-byte bytevector. Return #f if STR is not a valid
UUID representation."
(and=> (regexp-exec %uuid-rx str)
(lambda (match)
(letrec-syntax ((hex->number
(syntax-rules ()
((_ index)
(string->number (match:substring match index)
16))))
(put!
(syntax-rules ()
((_ bv index (number len) rest ...)
(begin
(bytevector-uint-set! bv index number
(endianness big) len)
(put! bv (+ index len) rest ...)))
((_ bv index)
bv))))
(let ((time-low (hex->number 1))
(time-mid (hex->number 2))
(time-hi (hex->number 3))
(clock-seq (hex->number 4))
(node (hex->number 5))
(uuid (make-bytevector 16)))
(put! uuid 0
(time-low 4) (time-mid 2) (time-hi 2)
(clock-seq 2) (node 6)))))))
(define* (canonicalize-device-spec spec #:optional (title 'any))
"Return the device name corresponding to SPEC. TITLE is a symbol, one of
@@ -481,7 +410,8 @@ the following:
\"/dev/sda1\";
• 'label', in which case SPEC is known to designate a partition label--e.g.,
\"my-root-part\";
• 'uuid', in which case SPEC must be a UUID designating a partition;
• 'uuid', in which case SPEC must be a UUID (a 16-byte bytevector)
designating a partition;
• 'any', in which case SPEC can be anything.
"
(define max-trials
@@ -527,11 +457,9 @@ the following:
(resolve find-partition-by-label spec identity))
((uuid)
(resolve find-partition-by-uuid
(cond ((string? spec)
(string->uuid spec))
((uuid? spec)
(uuid-bytevector spec))
(else spec))
(if (string? spec)
(string->uuid spec)
spec)
uuid->string))
(else
(error "unknown device title" title))))
@@ -542,7 +470,6 @@ the following:
(cond
((string-prefix? "ext" type) check-ext2-file-system)
((string-prefix? "btrfs" type) check-btrfs-file-system)
((string-suffix? "fat" type) check-fat-file-system)
(else #f)))
(if check-procedure
@@ -586,8 +513,15 @@ corresponds to the symbols listed in FLAGS."
(()
0))))
(define* (mount-file-system fs #:key (root "/root"))
"Mount the file system described by FS, a <file-system> object, under ROOT.
(define (regular-file? file-name)
"Return #t if FILE-NAME is a regular file."
(eq? (stat:type (stat file-name)) 'regular))
(define* (mount-file-system spec #:key (root "/root"))
"Mount the file system described by SPEC under ROOT. SPEC must have the
form:
(DEVICE TITLE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?)
DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
FLAGS must be a list of symbols. CHECK? is a Boolean indicating whether to
@@ -613,36 +547,34 @@ run a file system check."
(if options
(string-append "," options)
"")))))
(let ((type (file-system-type fs))
(options (file-system-options fs))
(source (canonicalize-device-spec (file-system-device fs)
(file-system-title fs)))
(mount-point (string-append root "/"
(file-system-mount-point fs)))
(flags (mount-flags->bit-mask (file-system-flags fs))))
(when (file-system-check? fs)
(check-file-system source type))
(match spec
((source title mount-point type (flags ...) options check?)
(let ((source (canonicalize-device-spec source title))
(mount-point (string-append root "/" mount-point))
(flags (mount-flags->bit-mask flags)))
(when check?
(check-file-system source type))
;; Create the mount point. Most of the time this is a directory, but
;; in the case of a bind mount, a regular file or socket may be needed.
(if (and (= MS_BIND (logand flags MS_BIND))
(not (file-is-directory? source)))
(unless (file-exists? mount-point)
(mkdir-p (dirname mount-point))
(call-with-output-file mount-point (const #t)))
(mkdir-p mount-point))
;; Create the mount point. Most of the time this is a directory, but
;; in the case of a bind mount, a regular file may be needed.
(if (and (= MS_BIND (logand flags MS_BIND))
(regular-file? source))
(unless (file-exists? mount-point)
(mkdir-p (dirname mount-point))
(call-with-output-file mount-point (const #t)))
(mkdir-p mount-point))
(cond
((string-prefix? "nfs" type)
(mount-nfs source mount-point type flags options))
(else
(mount source mount-point type flags options)))
(cond
((string-prefix? "nfs" type)
(mount-nfs source mount-point type flags options))
(else
(mount source mount-point type flags options)))
;; For read-only bind mounts, an extra remount is needed, as per
;; <http://lwn.net/Articles/281157/>, which still applies to Linux 4.0.
(when (and (= MS_BIND (logand flags MS_BIND))
(= MS_RDONLY (logand flags MS_RDONLY)))
(let ((flags (logior MS_BIND MS_REMOUNT MS_RDONLY)))
(mount source mount-point type flags #f)))))
;; For read-only bind mounts, an extra remount is needed, as per
;; <http://lwn.net/Articles/281157/>, which still applies to Linux 4.0.
(when (and (= MS_BIND (logand flags MS_BIND))
(= MS_RDONLY (logand flags MS_RDONLY)))
(let ((flags (logior MS_BIND MS_REMOUNT MS_RDONLY)))
(mount source mount-point type flags #f)))))))
;;; file-systems.scm ends here
+39 -25
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -22,8 +22,8 @@
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (install-boot-config
evaluate-populate-directive
#:export (install-grub
install-grub-config
populate-root-file-system
reset-timestamps
register-closure
@@ -38,17 +38,36 @@
;;;
;;; Code:
(define (install-boot-config bootcfg bootcfg-location mount-point)
"Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT. Note
that the caller must make sure that BOOTCFG is registered as a GC root so
that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
(let* ((target (string-append mount-point bootcfg-location))
(define (install-grub grub.cfg device mount-point)
"Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
MOUNT-POINT.
Note that the caller must make sure that GRUB.CFG is registered as a GC root
so that the fonts, background images, etc. referred to by GRUB.CFG are not
GC'd."
(install-grub-config grub.cfg mount-point)
;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or root
;; partition.
(setenv "GRUB_ENABLE_CRYPTODISK" "y")
(unless (zero? (system* "grub-install" "--no-floppy"
"--boot-directory"
(string-append mount-point "/boot")
device))
(error "failed to install GRUB")))
(define (install-grub-config grub.cfg mount-point)
"Atomically copy GRUB.CFG into boot/grub/grub.cfg on the MOUNT-POINT. Note
that the caller must make sure that GRUB.CFG is registered as a GC root so
that the fonts, background images, etc. referred to by GRUB.CFG are not GC'd."
(let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
(pivot (string-append target ".new")))
(mkdir-p (dirname target))
;; Copy BOOTCFG instead of just symlinking it, because symlinks won't
;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
;; work when /boot is on a separate partition. Do that atomically.
(copy-file bootcfg pivot)
(copy-file grub.cfg pivot)
(rename-file pivot target)))
(define (evaluate-populate-directive directive target)
@@ -173,16 +192,13 @@ rest of STORE."
(define* (populate-single-profile-directory directory
#:key profile closure
deduplicate?
register?)
deduplicate?)
"Populate DIRECTORY with a store containing PROFILE, whose closure is given
in the file called CLOSURE (as generated by #:references-graphs.) DIRECTORY
is initialized to contain a single profile under /root pointing to PROFILE.
When REGISTER? is true, initialize DIRECTORY/var/guix/db to reflect the
contents of the store; DEDUPLICATE? determines whether to deduplicate files in
the store.
DEDUPLICATE? determines whether to deduplicate files in the store.
This is used to create the self-contained tarballs with 'guix pack'."
This is used to create the self-contained Guix tarball."
(define (scope file)
(string-append directory "/" file))
@@ -197,16 +213,14 @@ This is used to create the self-contained tarballs with 'guix pack'."
;; Populate the store.
(populate-store (list closure) directory)
(register-closure (canonicalize-path directory) closure
#:deduplicate? deduplicate?)
(when register?
(register-closure (canonicalize-path directory) closure
#:deduplicate? deduplicate?)
;; XXX: 'guix-register' registers profiles as GC roots but the symlink
;; target uses $TMPDIR. Fix that.
(delete-file (scope "/var/guix/gcroots/profiles"))
(symlink* "/var/guix/profiles"
"/var/guix/gcroots/profiles"))
;; XXX: 'guix-register' registers profiles as GC roots but the symlink
;; target uses $TMPDIR. Fix that.
(delete-file (scope "/var/guix/gcroots/profiles"))
(symlink* "/var/guix/profiles"
"/var/guix/gcroots/profiles")
;; Make root's profile, which makes it a GC root.
(mkdir-p* %root-profile)
+39 -24
View File
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,16 +20,14 @@
#:use-module (rnrs io ports)
#:use-module (system repl error-handling)
#:autoload (system repl repl) (start-repl)
#:autoload (system base compile) (compile-file)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 ftw)
#:use-module (guix build utils)
#:use-module ((guix build syscalls)
#:hide (file-system-type))
#:use-module (gnu build linux-modules)
#:use-module (gnu build file-systems)
#:use-module (gnu system file-systems)
#:export (mount-essential-file-systems
linux-command-line
find-long-option
@@ -240,10 +237,20 @@ the last argument of `mknod'."
(filter-map string->number (scandir "/proc")))))
(define* (mount-root-file-system root type
#:key volatile-root?)
#:key volatile-root? (unionfs "unionfs"))
"Mount the root file system of type TYPE at device ROOT. If VOLATILE-ROOT?
is true, mount ROOT read-only and make it a overlay with a writable tmpfs
using the kernel build-in overlayfs."
is true, mount ROOT read-only and make it a union with a writable tmpfs using
UNIONFS."
(define (mark-as-not-killable pid)
;; Tell the 'user-processes' shepherd service that PID must be kept alive
;; when shutting down.
(mkdir-p "/root/etc/shepherd")
(let ((port (open-file "/root/etc/shepherd/do-not-kill" "a")))
(chmod port #o600)
(write pid port)
(newline port)
(close-port port)))
(if volatile-root?
(begin
(mkdir-p "/real-root")
@@ -251,17 +258,24 @@ using the kernel build-in overlayfs."
(mkdir-p "/rw-root")
(mount "none" "/rw-root" "tmpfs")
;; Create the upperdir and the workdir of the overlayfs
(mkdir-p "/rw-root/upper")
(mkdir-p "/rw-root/work")
;; We want read-write /dev nodes.
(mkdir-p "/rw-root/upper/dev")
(mount "none" "/rw-root/upper/dev" "devtmpfs")
(mkdir-p "/rw-root/dev")
(mount "none" "/rw-root/dev" "devtmpfs")
;; Make /root an overlay of the tmpfs and the actual root.
(mount "none" "/root" "overlay" 0
"lowerdir=/real-root,upperdir=/rw-root/upper,workdir=/rw-root/work"))
;; Make /root a union of the tmpfs and the actual root. Use
;; 'max_files' to set a high RLIMIT_NOFILE for the unionfs process
;; itself. Failing to do that, we quickly run out of file
;; descriptors; see <http://bugs.gnu.org/17827>.
(unless (zero? (system* unionfs "-o"
"cow,allow_other,use_ino,suid,dev,max_files=65536"
"/rw-root=RW:/real-root=RO"
"/root"))
(error "unionfs failed"))
;; Make sure unionfs remains alive till the end. Because
;; 'fuse_daemonize' doesn't tell the PID of the forked daemon, we
;; have to resort to 'pidof' here.
(mark-as-not-killable (pidof unionfs)))
(begin
(check-file-system root type)
(mount root "/root" type)))
@@ -269,7 +283,6 @@ using the kernel build-in overlayfs."
;; Make sure /root/etc/mtab is a symlink to /proc/self/mounts.
(false-if-exception
(delete-file "/root/etc/mtab"))
(mkdir-p "/root/etc")
(symlink "/proc/self/mounts" "/root/etc/mtab"))
(define (switch-root root)
@@ -334,17 +347,19 @@ supports kernel command-line options '--load', '--root', and '--repl'.
Mount the root file system, specified by the '--root' command-line argument,
if any.
MOUNTS must be a list of <file-system> objects.
MOUNTS must be a list suitable for 'mount-file-system'.
When VOLATILE-ROOT? is true, the root file system is writable but any changes
to it are lost."
(define (root-mount-point? fs)
(string=? (file-system-mount-point fs) "/"))
(define root-mount-point?
(match-lambda
((device _ "/" _ ...) #t)
(_ #f)))
(define root-fs-type
(or (any (lambda (fs)
(and (root-mount-point? fs)
(file-system-type fs)))
(or (any (match-lambda
((device _ "/" type _ ...) type)
(_ #f))
mounts)
"ext4"))
+8 -35
View File
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -33,8 +32,7 @@
%namespaces
run-container
call-with-container
container-excursion
container-excursion*))
container-excursion))
(define (user-namespace-supported?)
"Return #t if user namespaces are supported on this system."
@@ -130,19 +128,13 @@ for the process."
"/dev/fuse"))
;; Setup the container's /dev/console by bind mounting the pseudo-terminal
;; associated with standard input when there is one.
(let* ((in (current-input-port))
(tty (catch 'system-error
(lambda ()
;; This call throws if IN does not correspond to a tty.
;; This is more reliable than 'isatty?'.
(ttyname in))
(const #f)))
(console (scope "/dev/console")))
(when tty
;; associated with standard input.
(let ((in (current-input-port))
(console (scope "/dev/console")))
(when (isatty? in)
(touch console)
(chmod console #o600)
(bind-mount tty console)))
(bind-mount (ttyname in) console)))
;; Setup standard input/output/error.
(symlink "/proc/self/fd" (scope "/dev/fd"))
@@ -152,7 +144,8 @@ for the process."
;; Mount user-specified file systems.
(for-each (lambda (file-system)
(mount-file-system file-system #:root root))
(mount-file-system (file-system->spec file-system)
#:root root))
mounts)
;; Jail the process inside the container's root file system.
@@ -236,8 +229,6 @@ host user identifiers to map into the user namespace."
namespaces)))
(lambda args
;; Forward the exception to the parent process.
;; FIXME: SRFI-35 conditions and non-trivial objects
;; cannot be 'read' so they shouldn't be written as is.
(write args child)
(primitive-exit 3))))
;; TODO: Manage capabilities.
@@ -327,21 +318,3 @@ return the exit status."
(match (waitpid pid)
((_ . status)
(status:exit-val status))))))
(define (container-excursion* pid thunk)
"Like 'container-excursion', but return the return value of THUNK."
(match (pipe)
((in . out)
(match (container-excursion pid
(lambda ()
(close-port in)
(write (thunk) out)))
(0
(close-port out)
(let ((result (read in)))
(close-port in)
result))
(_ ;maybe PID died already
(close-port out)
(close-port in)
#f)))))
-2
View File
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,7 +18,6 @@
(define-module (gnu build linux-modules)
#:use-module (guix elf)
#:use-module (guix build syscalls)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
+4 -35
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,7 +25,6 @@
#:export (marionette?
make-marionette
marionette-eval
wait-for-file
marionette-control
marionette-screen-text
wait-for-screen-text
@@ -165,25 +164,6 @@ QEMU monitor and to the guest's backdoor REPL."
(newline repl)
(read repl))))
(define* (wait-for-file file marionette
#:key (timeout 10) (read 'read))
"Wait until FILE exists in MARIONETTE; READ its content and return it. If
FILE has not shown up after TIMEOUT seconds, raise an error."
(match (marionette-eval
`(let loop ((i ,timeout))
(cond ((file-exists? ,file)
(cons 'success (call-with-input-file ,file ,read)))
((> i 0)
(sleep 1)
(loop (- i 1)))
(else
'failure)))
marionette)
(('success . result)
result)
('failure
(error "file didn't show up" file))))
(define (marionette-control command marionette)
"Run COMMAND in the QEMU monitor of MARIONETTE. COMMAND is a string such as
\"sendkey ctrl-alt-f1\" or \"screendump foo.ppm\" (info \"(qemu-doc)
@@ -262,20 +242,9 @@ PREDICATE, whichever comes first. Raise an error when TIMEOUT is exceeded."
(#\. . "dot")
(#\, . "comma")
(#\; . "semicolon")
(#\' . "apostrophe")
(#\" . "shift-apostrophe")
(#\` . "grave_accent")
(#\bs . "backspace")
(#\tab . "tab")))
(define (character->keystroke chr keystrokes)
"Return the keystroke for CHR according to the keyboard layout defined by
KEYSTROKES."
(if (char-set-contains? char-set:upper-case chr)
(string-append "shift-" (string (char-downcase chr)))
(or (assoc-ref keystrokes chr)
(string chr))))
(define* (string->keystroke-commands str
#:optional
(keystrokes
@@ -284,9 +253,9 @@ KEYSTROKES."
to STR. KEYSTROKES is an alist specifying a mapping from characters to
keystrokes."
(string-fold-right (lambda (chr result)
(cons (string-append
"sendkey "
(character->keystroke chr keystrokes))
(cons (string-append "sendkey "
(or (assoc-ref keystrokes chr)
(string chr)))
result))
'()
str))
-179
View File
@@ -1,179 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 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 (gnu build shepherd)
#:use-module (gnu system file-systems)
#:use-module (gnu build linux-container)
#:use-module (guix build utils)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (make-forkexec-constructor/container))
;;; Commentary:
;;;
;;; This module provides extensions to the GNU Shepherd. In particular, it
;;; provides a helper to start services in a container.
;;;
;;; Code:
(define (clean-up file)
(when file
(catch 'system-error
(lambda ()
(delete-file file))
(lambda args
(unless (= ENOENT (system-error-errno args))
(apply throw args))))))
(define-syntax-rule (catch-system-error exp)
(catch 'system-error
(lambda ()
exp)
(const #f)))
(define (default-namespaces args)
;; Most daemons are here to talk to the network, and most of them expect to
;; run under a non-zero UID.
(fold delq %namespaces '(net user)))
(define* (default-mounts #:key (namespaces (default-namespaces '())))
(define (tmpfs directory)
(file-system
(device "none")
(title 'device)
(mount-point directory)
(type "tmpfs")
(check? #f)))
(define accounts
;; This is for processes in the default user namespace but living in a
;; different mount namespace, so that they can lookup users.
(list (file-system-mapping
(source "/etc/passwd") (target source))
(file-system-mapping
(source "/etc/group") (target source))))
(define nscd-socket
(file-system-mapping
(source "/var/run/nscd") (target source)
(writable? #t)))
(append (cons (tmpfs "/tmp") %container-file-systems)
(let ((mappings `(,@(if (memq 'net namespaces)
'()
(cons nscd-socket
%network-file-mappings))
,@(if (and (memq 'mnt namespaces)
(not (memq 'user namespaces)))
accounts
'())
,%store-mapping))) ;XXX: coarse-grain
(map file-system-mapping->bind-mount
(filter (lambda (mapping)
(file-exists? (file-system-mapping-source mapping)))
mappings)))))
;; XXX: Lazy-bind the Shepherd to avoid a compile-time dependency.
(module-autoload! (current-module)
'(shepherd service) '(read-pid-file exec-command))
(define* (read-pid-file/container pid pid-file #:key (max-delay 5))
"Read PID-FILE in the container namespaces of PID, which exists in a
separate mount and PID name space. Return the \"outer\" PID. "
(match (container-excursion* pid
(lambda ()
(read-pid-file pid-file
#:max-delay max-delay)))
(#f
(catch-system-error (kill pid SIGTERM))
#f)
((? integer? container-pid)
;; XXX: When COMMAND is started in a separate PID namespace, its
;; PID is always 1, but that's not what Shepherd needs to know.
pid)))
(define* (make-forkexec-constructor/container command
#:key
(namespaces
(default-namespaces args))
(mappings '())
(user #f)
(group #f)
(log-file #f)
pid-file
(pid-file-timeout 5)
(directory "/")
(environment-variables
(environ))
#:rest args)
"This is a variant of 'make-forkexec-constructor' that starts COMMAND in
NAMESPACES, a list of Linux namespaces such as '(mnt ipc). MAPPINGS is the
list of <file-system-mapping> to make in the case of a separate mount
namespace, in addition to essential bind-mounts such /proc."
(define container-directory
(match command
((program _ ...)
(string-append "/var/run/containers/" (basename program)))))
(define auto-mappings
`(,@(if log-file
(list (file-system-mapping
(source log-file)
(target source)
(writable? #t)))
'())))
(define mounts
(append (map file-system-mapping->bind-mount
(append auto-mappings mappings))
(default-mounts #:namespaces namespaces)))
(lambda args
(mkdir-p container-directory)
(when log-file
;; Create LOG-FILE so we can map it in the container.
(unless (file-exists? log-file)
(call-with-output-file log-file (const #t))))
(let ((pid (run-container container-directory
mounts namespaces 1
(lambda ()
(mkdir-p "/var/run")
(clean-up pid-file)
(clean-up log-file)
(exec-command command
#:user user
#:group group
#:log-file log-file
#:directory directory
#:environment-variables
environment-variables)))))
(if pid-file
(if (or (memq 'mnt namespaces) (memq 'pid namespaces))
(read-pid-file/container pid pid-file
#:max-delay pid-file-timeout)
(read-pid-file pid-file #:max-delay pid-file-timeout))
pid))))
;; Local Variables:
;; eval: (put 'container-excursion* 'scheme-indent-function 1)
;; End:
;;; shepherd.scm ends here
+2 -2
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;;
;;; This file is part of GNU Guix.
@@ -50,7 +50,7 @@ dimensions of IN-SVG."
(define svg
(rsvg-handle-new-from-file in-svg))
(let-values (((origin-width origin-height em ex)
(let-values (((origin-width origin-height)
(rsvg-handle-get-dimensions svg)))
(let* ((surf (cairo-image-surface-create 'argb32
origin-width origin-height))
+41 -211
View File
@@ -1,9 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,13 +21,9 @@
(define-module (gnu build vm)
#:use-module (guix build utils)
#:use-module (guix build store-copy)
#:use-module (guix build syscalls)
#:use-module (gnu build linux-boot)
#:use-module (gnu build install)
#:use-module (gnu system uuid)
#:use-module (guix records)
#:use-module ((guix combinators) #:select (fold2))
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
@@ -45,14 +39,12 @@
partition-size
partition-file-system
partition-label
partition-flags
partition-bootable?
partition-initializer
estimated-partition-size
root-partition-initializer
initialize-partition-table
initialize-hard-disk
make-iso9660-image))
initialize-hard-disk))
;;; Commentary:
;;;
@@ -75,26 +67,19 @@
output
(qemu (qemu-command)) (memory-size 512)
linux initrd
make-disk-image?
single-file-output?
(disk-image-size (* 100 (expt 2 20)))
make-disk-image? (disk-image-size 100)
(disk-image-format "qcow2")
(references-graphs '()))
"Run BUILDER, a Scheme file, into a VM running LINUX with INITRD, and copy
the result to OUTPUT. If SINGLE-FILE-OUTPUT? is true, copy a single file from
/xchg to OUTPUT. Otherwise, copy the contents of /xchg to a new directory
OUTPUT.
the result to OUTPUT.
When MAKE-DISK-IMAGE? is true, OUTPUT will contain a VM image of
DISK-IMAGE-SIZE bytes resulting from the execution of BUILDER, which may
access it via /dev/hda.
DISK-IMAGE-SIZE MiB resulting from the execution of BUILDER, which may access
it via /dev/hda.
REFERENCES-GRAPHS can specify a list of reference-graph files as produced by
the #:references-graphs parameter of 'derivation'."
(when make-disk-image?
(format #t "creating ~a image of ~,2f MiB...~%"
disk-image-format (/ disk-image-size (expt 2 20)))
(force-output)
(unless (zero? (system* "qemu-img" "create" "-f" disk-image-format
output
(number->string disk-image-size)))
@@ -140,17 +125,8 @@ the #:references-graphs parameter of 'derivation'."
;; When MAKE-DISK-IMAGE? is true, the image is in OUTPUT already.
(unless make-disk-image?
(if single-file-output?
(let ((graph? (lambda (name stat)
(member (basename name) references-graphs))))
(match (find-files "xchg" (negate graph?))
((result)
(copy-file result output))
(x
(error "did not find a single result file" x))))
(begin
(mkdir output)
(copy-recursively "xchg" output)))))
(mkdir output)
(copy-recursively "xchg" output)))
;;;
@@ -163,15 +139,20 @@ the #:references-graphs parameter of 'derivation'."
(size partition-size)
(file-system partition-file-system (default "ext4"))
(label partition-label (default #f))
(uuid partition-uuid (default #f))
(flags partition-flags (default '()))
(bootable? partition-bootable? (default #f))
(initializer partition-initializer (default (const #t))))
(define (estimated-partition-size graphs)
"Return the estimated size of a partition that can store the store items
given by GRAPHS, a list of file names produced by #:references-graphs."
;; Simply add a 25% overhead.
(round (* 1.25 (closure-size graphs))))
(define (fold2 proc seed1 seed2 lst) ;TODO: factorize
"Like `fold', but with a single list and two seeds."
(let loop ((result1 seed1)
(result2 seed2)
(lst lst))
(if (null? lst)
(values result1 result2)
(call-with-values
(lambda () (proc (car lst) result1 result2))
(lambda (result1 result2)
(loop result1 result2 (cdr lst)))))))
(define* (initialize-partition-table device partitions
#:key
@@ -185,10 +166,9 @@ actual /dev name based on DEVICE."
(cons* "mkpart" "primary" "ext2"
(format #f "~aB" offset)
(format #f "~aB" (+ offset (partition-size part)))
(append-map (lambda (flag)
(list "set" (number->string index)
(symbol->string flag) "on"))
(partition-flags part))))
(if (partition-bootable? part)
`("set" ,(number->string index) "boot" "on")
'())))
(define (options partitions offset)
(let loop ((partitions partitions)
@@ -207,15 +187,8 @@ actual /dev name based on DEVICE."
(cons (partition-options head offset index)
result))))))
(format #t "creating partition table with ~a partitions (~a)...\n"
(length partitions)
(string-join (map (compose (cut string-append <> " MiB")
number->string
(lambda (size)
(round (/ size (expt 2. 20))))
partition-size)
partitions)
", "))
(format #t "creating partition table with ~a partitions...\n"
(length partitions))
(unless (zero? (apply system* "parted" "--script"
device "mklabel" label-type
(options partitions offset)))
@@ -236,43 +209,17 @@ actual /dev name based on DEVICE."
(define MS_BIND 4096) ; <sys/mounts.h> again!
(define* (create-ext-file-system partition type
#:key label uuid)
"Create an ext-family filesystem of TYPE on PARTITION. If LABEL is true,
use that as the volume name. If UUID is true, use it as the partition UUID."
(define* (format-partition partition type
#:key label)
"Create a file system TYPE on PARTITION. If LABEL is true, use that as the
volume name."
(format #t "creating ~a partition...\n" type)
(unless (zero? (apply system* (string-append "mkfs." type)
"-F" partition
`(,@(if label
`("-L" ,label)
'())
,@(if uuid
`("-U" ,(uuid->string uuid))
'()))))
(error "failed to create partition")))
(define* (create-fat-file-system partition
#:key label uuid)
"Create a FAT filesystem on PARTITION. The number of File Allocation Tables
will be determined based on filesystem size. If LABEL is true, use that as the
volume name."
;; FIXME: UUID is ignored!
(format #t "creating FAT partition...\n")
(unless (zero? (apply system* "mkfs.fat" partition
(if label
`("-n" ,label)
`("-L" ,label)
'())))
(error "failed to create FAT partition")))
(define* (format-partition partition type
#:key label uuid)
"Create a file system TYPE on PARTITION. If LABEL is true, use that as the
volume name."
(cond ((string-prefix? "ext" type)
(create-ext-file-system partition type #:label label #:uuid uuid))
((or (string-prefix? "fat" type) (string= "vfat" type))
(create-fat-file-system partition #:label label #:uuid uuid))
(else (error "Unsupported file system."))))
(error "failed to create partition")))
(define (initialize-partition partition)
"Format PARTITION, a <partition> object with a non-#f 'device' field, mount
@@ -280,8 +227,7 @@ it, run its initializer, and unmount it."
(let ((target "/fs"))
(format-partition (partition-device partition)
(partition-file-system partition)
#:label (partition-label partition)
#:uuid (partition-uuid partition))
#:label (partition-label partition))
(mkdir-p target)
(mount (partition-device partition) target
(partition-file-system partition))
@@ -337,108 +283,23 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
(unless register-closures?
(reset-timestamps target))))
(define (register-bootcfg-root target bootcfg)
"On file system TARGET, register BOOTCFG as a GC root."
(define (register-grub.cfg-root target grub.cfg)
"On file system TARGET, register GRUB.CFG as a GC root."
(let ((directory (string-append target "/var/guix/gcroots")))
(mkdir-p directory)
(symlink bootcfg (string-append directory "/bootcfg"))))
(define (install-efi grub esp config-file)
"Write a self-contained GRUB EFI loader to the mounted ESP using CONFIG-FILE."
(let* ((system %host-type)
;; Hard code the output location to a well-known path recognized by
;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
(grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
(efi-directory (string-append esp "/EFI/BOOT"))
;; Map grub target names to boot file names.
(efi-targets (cond ((string-prefix? "x86_64" system)
'("x86_64-efi" . "BOOTX64.EFI"))
((string-prefix? "i686" system)
'("i386-efi" . "BOOTIA32.EFI"))
((string-prefix? "armhf" system)
'("arm-efi" . "BOOTARM.EFI"))
((string-prefix? "aarch64" system)
'("arm64-efi" . "BOOTAA64.EFI")))))
;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
(setenv "TMPDIR" esp)
(mkdir-p efi-directory)
(unless (zero? (system* grub-mkstandalone "-O" (car efi-targets)
"-o" (string-append efi-directory "/"
(cdr efi-targets))
;; Graft the configuration file onto the image.
(string-append "boot/grub/grub.cfg=" config-file)))
(error "failed to create GRUB EFI image"))))
(define* (make-iso9660-image grub config-file os-drv target
#:key (volume-id "GuixSD_image") (volume-uuid #f)
register-closures? (closures '()))
"Given a GRUB package, creates an iso image as TARGET, using CONFIG-FILE as
GRUB configuration and OS-DRV as the stuff in it."
(let ((grub-mkrescue (string-append grub "/bin/grub-mkrescue"))
(target-store (string-append "/tmp/root" (%store-directory))))
(populate-root-file-system os-drv "/tmp/root")
(mount (%store-directory) target-store "" MS_BIND)
(when register-closures?
(display "registering closures...\n")
(for-each (lambda (closure)
(register-closure
"/tmp/root"
(string-append "/xchg/" closure)
;; XXX: Using deduplication causes cross device link errors.
#:deduplicate? #f))
closures))
(unless (zero? (apply system*
`(,grub-mkrescue "-o" ,target
,(string-append "boot/grub/grub.cfg=" config-file)
,(string-append "gnu/store=" os-drv "/..")
"etc=/tmp/root/etc"
"var=/tmp/root/var"
"run=/tmp/root/run"
;; /mnt is used as part of the installation
;; process, as the mount point for the target
;; filesystem, so create it.
"mnt=/tmp/root/mnt"
"--"
"-volid" ,(string-upcase volume-id)
,@(if volume-uuid
`("-volume_date" "uuid"
,(string-filter (lambda (value)
(not (char=? #\- value)))
(iso9660-uuid->string
volume-uuid)))
`()))))
(error "failed to create ISO9660 image"))))
(symlink grub.cfg (string-append directory "/grub.cfg"))))
(define* (initialize-hard-disk device
#:key
bootloader-package
bootcfg
bootcfg-location
bootloader-installer
(grub-efi #f)
grub.cfg
(partitions '()))
"Initialize DEVICE as a disk containing all the <partition> objects listed
in PARTITIONS, and using BOOTCFG as its bootloader configuration file.
in PARTITIONS, and using GRUB.CFG as its bootloader configuration file.
Each partition is initialized by calling its 'initializer' procedure,
passing it a directory name where it is mounted."
(define (partition-bootable? partition)
"Return the first partition found with the boot flag set."
(member 'boot (partition-flags partition)))
(define (partition-esp? partition)
"Return the first EFI System Partition."
(member 'esp (partition-flags partition)))
(let* ((partitions (initialize-partition-table device partitions))
(root (find partition-bootable? partitions))
(esp (find partition-esp? partitions))
(target "/fs"))
(unless root
(error "no bootable partition specified" partitions))
@@ -448,41 +309,10 @@ passing it a directory name where it is mounted."
(display "mounting root partition...\n")
(mkdir-p target)
(mount (partition-device root) target (partition-file-system root))
(install-boot-config bootcfg bootcfg-location target)
(when bootloader-installer
(display "installing bootloader...\n")
(bootloader-installer bootloader-package device target))
(install-grub grub.cfg device target)
(when esp
;; Mount the ESP somewhere and install GRUB UEFI image.
(let ((mount-point (string-append target "/boot/efi"))
(grub-config (string-append target "/tmp/grub-standalone.cfg")))
(display "mounting EFI system partition...\n")
(mkdir-p mount-point)
(mount (partition-device esp) mount-point
(partition-file-system esp))
;; Create a tiny configuration file telling the embedded grub
;; where to load the real thing.
;; XXX This is quite fragile, and can prevent the image from booting
;; when there's more than one volume with this label present.
;; Reproducible almost-UUIDs could reduce the risk (not eliminate it).
(call-with-output-file grub-config
(lambda (port)
(format port
"insmod part_msdos~@
search --set=root --label GuixSD_image~@
configfile /boot/grub/grub.cfg~%")))
(display "creating EFI firmware image...")
(install-efi grub-efi mount-point grub-config)
(display "done.\n")
(delete-file grub-config)
(umount mount-point)))
;; Register BOOTCFG as a GC root.
(register-bootcfg-root target bootcfg)
;; Register GRUB.CFG as a GC root.
(register-grub.cfg-root target grub.cfg)
(umount target)))
+127 -378
View File
File diff suppressed because it is too large Load Diff
+136 -70
View File
@@ -1,8 +1,8 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -24,12 +24,11 @@
#:use-module (guix packages)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix discovery)
#:use-module (guix memoization)
#:use-module (guix combinators)
#:use-module ((guix build utils)
#:select ((package-name->name+version
. hyphen-separated-name->name+version)))
#:autoload (guix profiles) (packages->manifest)
#:use-module (ice-9 ftw)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -40,22 +39,20 @@
#:use-module (srfi srfi-39)
#:export (search-patch
search-patches
search-auxiliary-file
search-bootstrap-binary
%patch-path
%auxiliary-files-path
%bootstrap-binaries-path
%package-module-path
fold-packages
scheme-modules ;XXX: for lack of a better place
find-packages-by-name
find-best-packages-by-name
find-newest-available-packages
specification->package
specification->package+output
specifications->manifest))
specification->package+output))
;;; Commentary:
;;;
@@ -64,32 +61,22 @@
;;;
;;; Code:
;; By default, we store patches, auxiliary files and bootstrap binaries
;; alongside Guile modules. This is so that these extra files can be
;; found without requiring a special setup, such as a specific
;; installation directory and an extra environment variable. One
;; advantage of this setup is that everything just works in an
;; auto-compilation setting.
;; By default, we store patches and bootstrap binaries alongside Guile
;; modules. This is so that these extra files can be found without
;; requiring a special setup, such as a specific installation directory
;; and an extra environment variable. One advantage of this setup is
;; that everything just works in an auto-compilation setting.
(define %bootstrap-binaries-path
(make-parameter
(map (cut string-append <> "/gnu/packages/bootstrap")
%load-path)))
(define %auxiliary-files-path
(make-parameter
(map (cut string-append <> "/gnu/packages/aux-files")
%load-path)))
(define (search-auxiliary-file file-name)
"Search the auxiliary FILE-NAME. Return #f if not found."
(search-path (%auxiliary-files-path) file-name))
(define (search-patch file-name)
"Search the patch FILE-NAME. Raise an error if not found."
(or (search-path (%patch-path) file-name)
(raise (condition
(&message (message (format #f (G_ "~a: patch not found")
(&message (message (format #f (_ "~a: patch not found")
file-name)))))))
(define-syntax-rule (search-patches file-name ...)
@@ -105,7 +92,7 @@ found."
(raise (condition
(&message
(message
(format #f (G_ "could not find bootstrap binary '~a' \
(format #f (_ "could not find bootstrap binary '~a' \
for system '~a'")
file-name system)))))))
@@ -140,19 +127,92 @@ for system '~a'")
directory))
%load-path)))
(define* (fold-packages proc init
#:optional
(modules (all-modules (%package-module-path)))
#:key (select? (negate hidden-package?)))
"Call (PROC PACKAGE RESULT) for each available package defined in one of
MODULES that matches SELECT?, using INIT as the initial value of RESULT. It
is guaranteed to never traverse the same package twice."
(fold-module-public-variables (lambda (object result)
(if (and (package? object) (select? object))
(proc object result)
result))
init
modules))
(define* (scheme-files directory)
"Return the list of Scheme files found under DIRECTORY, recursively. The
returned list is sorted in alphabetical order."
;; Sort entries so that 'fold-packages' works in a deterministic fashion
;; regardless of details of the underlying file system.
(sort (file-system-fold (const #t) ; enter?
(lambda (path stat result) ; leaf
(if (string-suffix? ".scm" path)
(cons path result)
result))
(lambda (path stat result) ; down
result)
(lambda (path stat result) ; up
result)
(const #f) ; skip
(lambda (path stat errno result)
(warning (_ "cannot access `~a': ~a~%")
path (strerror errno))
result)
'()
directory
stat)
string<?))
(define file-name->module-name
(let ((not-slash (char-set-complement (char-set #\/))))
(lambda (file)
"Return the module name (a list of symbols) corresponding to FILE."
(map string->symbol
(string-tokenize (string-drop-right file 4) not-slash)))))
(define* (scheme-modules directory #:optional sub-directory)
"Return the list of Scheme modules available under DIRECTORY.
Optionally, narrow the search to SUB-DIRECTORY."
(define prefix-len
(string-length directory))
(filter-map (lambda (file)
(let* ((file (substring file prefix-len))
(module (file-name->module-name file)))
(catch #t
(lambda ()
(resolve-interface module))
(lambda args
;; Report the error, but keep going.
(warn-about-load-error module args)
#f))))
(scheme-files (if sub-directory
(string-append directory "/" sub-directory)
directory))))
(define* (all-package-modules #:optional (path (%package-module-path)))
"Return the list of package modules found in PATH, a list of directories to
search."
(fold-right (lambda (spec result)
(match spec
((? string? directory)
(append (scheme-modules directory) result))
((directory . sub-directory)
(append (scheme-modules directory sub-directory)
result))))
'()
path))
(define (fold-packages proc init)
"Call (PROC PACKAGE RESULT) for each available package, using INIT as
the initial value of RESULT. It is guaranteed to never traverse the
same package twice."
(identity ; discard second return value
(fold2 (lambda (module result seen)
(fold2 (lambda (var result seen)
(if (and (package? var)
(not (vhash-assq var seen))
(not (hidden-package? var)))
(values (proc var result)
(vhash-consq var #t seen))
(values result seen)))
result
seen
(module-map (lambda (sym var)
(false-if-exception (variable-ref var)))
module)))
init
vlist-null
(all-package-modules))))
(define find-packages-by-name
(let ((packages (delay
@@ -174,27 +234,28 @@ decreasing version order."
matching)))))
(define find-newest-available-packages
(mlambda ()
"Return a vhash keyed by package names, and with
(memoize
(lambda ()
"Return a vhash keyed by package names, and with
associated values of the form
(newest-version newest-package ...)
where the preferred package is listed first."
;; FIXME: Currently, the preferred package is whichever one
;; was found last by 'fold-packages'. Find a better solution.
(fold-packages (lambda (p r)
(let ((name (package-name p))
(version (package-version p)))
(match (vhash-assoc name r)
((_ newest-so-far . pkgs)
(case (version-compare version newest-so-far)
((>) (vhash-cons name `(,version ,p) r))
((=) (vhash-cons name `(,version ,p ,@pkgs) r))
((<) r)))
(#f (vhash-cons name `(,version ,p) r)))))
vlist-null)))
;; FIXME: Currently, the preferred package is whichever one
;; was found last by 'fold-packages'. Find a better solution.
(fold-packages (lambda (p r)
(let ((name (package-name p))
(version (package-version p)))
(match (vhash-assoc name r)
((_ newest-so-far . pkgs)
(case (version-compare version newest-so-far)
((>) (vhash-cons name `(,version ,p) r))
((=) (vhash-cons name `(,version ,p ,@pkgs) r))
((<) r)))
(#f (vhash-cons name `(,version ,p) r)))))
vlist-null))))
(define (find-best-packages-by-name name version)
"If version is #f, return the list of packages named NAME with the highest
@@ -233,25 +294,38 @@ return its return value."
;;; Package specification.
;;;
(define* (%find-package spec name version)
(define* (%find-package spec name version #:key fallback?)
(match (find-best-packages-by-name name version)
((pkg . pkg*)
(unless (null? pkg*)
(warning (G_ "ambiguous package specification `~a'~%") spec)
(warning (G_ "choosing ~a@~a from ~a~%")
(package-name pkg) (package-version pkg)
(warning (_ "ambiguous package specification `~a'~%") spec)
(warning (_ "choosing ~a from ~a~%")
(package-full-name pkg)
(location->string (package-location pkg))))
(when fallback?
(warning (_ "deprecated NAME-VERSION syntax; \
use NAME@VERSION instead~%")))
(match (package-superseded pkg)
((? package? new)
(info (G_ "package '~a' has been superseded by '~a'~%")
(info (_ "package '~a' has been superseded by '~a'~%")
(package-name pkg) (package-name new))
new)
(#f
pkg)))
(x
(if version
(leave (G_ "~A: package not found for version ~a~%") name version)
(leave (G_ "~A: unknown package~%") name)))))
(leave (_ "~A: package not found for version ~a~%") name version)
(if (not fallback?)
;; XXX: Fallback to the older specification style with an hyphen
;; between NAME and VERSION, for backward compatibility.
(call-with-values
(lambda ()
(hyphen-separated-name->name+version name))
(cut %find-package spec <> <> #:fallback? #t))
;; The fallback case didn't find anything either, so bail out.
(leave (_ "~A: unknown package~%") name))))))
(define (specification->package spec)
"Return a package matching SPEC. SPEC may be a package name, or a package
@@ -279,14 +353,6 @@ version; if SPEC does not specify an output, return OUTPUT."
(package
(if (member sub-drv (package-outputs package))
(values package sub-drv)
(leave (G_ "package `~a' lacks output `~a'~%")
(leave (_ "package `~a' lacks output `~a'~%")
(package-full-name package)
sub-drv))))))
(define (specifications->manifest specs)
"Given SPECS, a list of specifications such as \"emacs@25.2\" or
\"guile:debug\", return a profile manifest."
;; This procedure exists mostly so users of 'guix package -m' don't have to
;; fiddle with multiple-value returns.
(packages->manifest
(map (compose list specification->package+output) specs)))
+9 -13
View File
@@ -1,8 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Marek Benc <merkur32@gmail.com>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,7 +22,6 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system glib-or-gtk)
#:use-module (gnu packages)
#:use-module (gnu packages autotools)
#:use-module (gnu packages boost)
@@ -46,20 +43,20 @@
(define-public abiword
(package
(name "abiword")
(version "3.0.2")
(version "3.0.1")
(source
(origin
(method url-fetch)
(uri
(string-append "https://www.abisource.com/downloads/" name "/" version
(string-append "http://abisource.org/downloads/" name "/" version
"/source/" name "-" version ".tar.gz"))
(sha256
(base32 "08imry821g81apdwym3gcs4nss0l9j5blqk31j5rv602zmcd9gxg"))
(base32 "1ik591rx15nn3n1297cwykl8wvrlgj78i528id9wbidgy3xzd570"))
(patches
(search-patches "abiword-explictly-cast-bools.patch"
"abiword-black-drawing-with-gtk322.patch"))))
(search-patches "abiword-wmf-version-lookup-fix.patch"
"abiword-explictly-cast-bools.patch"))))
(build-system glib-or-gtk-build-system)
(build-system gnu-build-system)
(arguments ;; NOTE: rsvg is disabled, since Abiword
`(#:configure-flags ;; supports it directly, and its BS is broken.
(list
@@ -80,9 +77,7 @@
;; assertion 'G_IS_OBJECT (object)' failed
;; Manually starting the X server before the test phase did not help
;; the tests to pass.
#:tests? #f
#:make-flags
(list "CXXFLAGS=-std=c++11")))
#:tests? #f))
(inputs
`(("boost" ,boost)
("enchant" ,enchant)
@@ -97,6 +92,7 @@
("libjpeg" ,libjpeg)
("libpng" ,libpng)
("librsvg" ,librsvg)
("libwmf" ,libwmf)
("libxml2" ,libxml2)
("libxslt" ,libxslt)
("ots" ,ots)
@@ -110,7 +106,7 @@
("glib:bin" ,glib "bin")
("libtool" ,libtool)
("pkg-config" ,pkg-config)))
(home-page "https://www.abisource.com/")
(home-page "http://abisource.org/")
(synopsis "Word processing program")
;; HACKERS: The comment below is here so that it shows up early in the
-121
View File
@@ -1,121 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 ng0 <ng0@infotropique.org>
;;; Copyright © 2017 Stefan Reichör <stefan@xsteve.at>
;;;
;;; 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 (gnu packages accessibility)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system glib-or-gtk)
#:use-module (gnu packages)
#:use-module (gnu packages xml)
#:use-module (gnu packages gnome)
#:use-module (gnu packages gstreamer)
#:use-module (gnu packages gtk)
#:use-module (gnu packages xorg)
#:use-module (gnu packages gettext)
#:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages libusb))
(define-public florence
(package
(name "florence")
(version "0.6.3")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/florence/florence/" version
"/" name "-" version ".tar.bz2"))
(sha256
(base32
"07h9qm22krlwayhzvc391lr23vicw81s48g7rirvx1fj0zyr4aa2"))))
(build-system glib-or-gtk-build-system)
(arguments
`(#:configure-flags (list "--with-xtst"
"--without-docs"
"--with-notification")))
(inputs
`(("libxml2" ,libxml2)
("libglade" ,libglade)
("librsvg" ,librsvg)
("gstreamer" ,gstreamer)
("cairo" ,cairo)
("gtk+" ,gtk+)
("libxtst" ,libxtst)
("libxcomposite" ,libxcomposite)
("libnotify" ,libnotify)))
(native-inputs
`(("gettext-minimal" ,gettext-minimal)
("intltool" ,intltool)
("pkg-config" ,pkg-config)))
(home-page "http://florence.sourceforge.net/")
(synopsis "Extensible, scalable virtual keyboard for X11")
(description
"Florence is an extensible scalable virtual keyboard for X11.
It is useful for people who can't use a real hardware keyboard (for
example for people with disabilities), but you must be able to use
a pointing device (as a mouse, a trackball, a touchscreen or opengazer).
Florence stays out of your way when you don't need it: it appears on the
screen only when you need it. A timer-based auto-click input method is
available to help to click.")
;; The documentation is under FDL1.2, but we do not install the
;; documentation.
(license license:gpl2+)))
(define-public footswitch
(let ((commit "7cb0a9333a150c27c7e4746ee827765d244e567a"))
(package
(name "footswitch")
(version (git-version "0.1" "1" commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/rgerganov/footswitch")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32 "0mg1vr4a9vls5y435w7wdnr1vb5059gy60lvrdfjgzhd2wwf47iw"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("hidapi" ,hidapi)))
(arguments
`(#:tests? #f ; no tests
#:make-flags (list "CC=gcc")
#:phases (modify-phases %standard-phases
(delete 'configure)
;; Install target in the Makefile does not work for Guix
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((bin (string-append (assoc-ref outputs "out")
"/bin")))
(mkdir-p bin)
(install-file "footswitch" bin)
#t))))))
(home-page "https://github.com/rgerganov/footswitch")
(synopsis "Command line utility for PCsensor foot switch")
(description
"Command line utility for programming foot switches sold by PCsensor.
It works for both single pedal devices and three pedal devices. All supported
devices have vendorId:productId = 0c45:7403 or 0c45:7404.")
(license license:expat))))
+2 -2
View File
@@ -25,7 +25,7 @@
(define-public acct
(package
(name "acct")
(version "6.6.4")
(version "6.6.2")
(source
(origin
(method url-fetch)
@@ -33,7 +33,7 @@
version ".tar.gz"))
(sha256
(base32
"0gv6m8giazshvgpvwbng98chpas09myyfw1zr2y7hqxib0mvy5ac"))))
"0081hzkcxw9aslpsakridj15m0wbnkdhm210fzbg021vi4pppm4f"))))
(build-system gnu-build-system)
(home-page "https://gnu.org/software/acct/")
(synopsis "Standard login and process accounting utilities")
+240 -656
View File
File diff suppressed because it is too large Load Diff
+3 -3
View File
@@ -47,7 +47,7 @@
;; XXX: Tests expect real name resolution to work.
#:tests? #f))
(home-page "https://www.gnu.org/software/adns/")
(home-page "http://www.gnu.org/software/adns/")
(synopsis "Asynchronous DNS client library and utilities")
(description
"GNU adns is a C library that provides easy-to-use DNS resolution
@@ -59,7 +59,7 @@ scripts.")
(define-public c-ares
(package
(name "c-ares")
(version "1.13.0")
(version "1.12.0")
(source (origin
(method url-fetch)
(uri (string-append
@@ -67,7 +67,7 @@ scripts.")
".tar.gz"))
(sha256
(base32
"19qxhv9aiw903fr808y77r6l9js0fq9m3gcaqckan9jan7qhixq3"))))
"1yv5ygkd813glz8hbagykgp1hlb6450chig061hr7pyw7i0gk4l6"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
+1 -24
View File
@@ -1,7 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 John Darringon <jmd@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -46,7 +45,7 @@ from text strings. It supports a variety of encoding standards and sizing
measurements. Barcodes can be output in PostScript or Encapsulated PostScript
formats.")
(license license:gpl3+)
(home-page "https://www.gnu.org/software/barcode/")))
(home-page "http://www.gnu.org/software/barcode/")))
(define-public qrencode
(package
@@ -70,25 +69,3 @@ a mobile phone with CCD. The capacity of QR Code is up to 7000 digits or 4000
characters, and is highly robust.")
(license license:lgpl2.1+)
(home-page "https://fukuchi.org/works/qrencode")))
(define-public libdmtx
(package
(name "libdmtx")
(version "0.7.4")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://sourceforge/libdmtx/" name "/" version "/"
name "-" version ".tar.bz2"))
(sha256
(base32 "0xnxx075ycy58n92yfda2z9zgd41h3d4ik5d9l197lzsqim5hb5n"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "http://libdmtx.sourceforge.net/")
(synopsis "Library for reading and writing Data Matrix 2D barcodes")
(description "libdmtx is software for reading and writing Data Matrix 2D
barcodes on Linux and Unix. At its core libdmtx is a shared library, allowing
C/C++ programs to use its capabilities without restrictions or overhead.")
(license license:bsd-3)))
+81 -47
View File
@@ -1,12 +1,9 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2016 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,28 +25,26 @@
#:use-module (gnu packages autotools)
#:use-module (gnu packages compression)
#:use-module (gnu packages documentation)
#:use-module (gnu packages ed)
#:use-module (gnu packages flex)
#:use-module (gnu packages fltk)
#:use-module (gnu packages gl)
#:use-module (gnu packages graphviz)
#:use-module (gnu packages image)
#:use-module (gnu packages multiprecision)
#:use-module (gnu packages maths)
#:use-module (gnu packages mpi)
#:use-module (gnu packages multiprecision)
#:use-module (gnu packages perl)
#:use-module (gnu packages python)
#:use-module (gnu packages readline)
#:use-module (gnu packages flex)
#:use-module (gnu packages python)
#:use-module (gnu packages shells)
#:use-module (gnu packages tex)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages xiph)
#:use-module (gnu packages xorg)
#:use-module (guix build-system gnu)
#:use-module (guix build-system cmake)
#:use-module (guix download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system cmake)
#:use-module (guix utils))
@@ -133,7 +128,7 @@ solve the shortest vector problem.")
(define-public pari-gp
(package
(name "pari-gp")
(version "2.9.3")
(version "2.7.6")
(source (origin
(method url-fetch)
(uri (string-append
@@ -141,9 +136,9 @@ solve the shortest vector problem.")
version ".tar.gz"))
(sha256
(base32
"0qqal1lpggd6dvs19svnz0dil86xk0xkcj5s3b7104ibkmvjfsp7"))))
"04dqi697czd8mmw8aiwzrkgbvkjassqagg6lfy3lkf1k5qi9g9rr"))))
(build-system gnu-build-system)
(native-inputs `(("texlive" ,texlive-tiny)))
(native-inputs `(("texlive" ,texlive-minimal)))
(inputs `(("gmp" ,gmp)
("libx11" ,libx11)
("perl" ,perl)
@@ -173,7 +168,7 @@ PARI is also available as a C library to allow for faster computations.")
(define-public gp2c
(package
(name "gp2c")
(version "0.0.10")
(version "0.0.9pl5")
(source (origin
(method url-fetch)
(uri (string-append
@@ -181,7 +176,7 @@ PARI is also available as a C library to allow for faster computations.")
version ".tar.gz"))
(sha256
(base32
"1xhpz5p81iw261ay1kip283ggr0ir8ydz8qx3v24z8jfms1r3y70"))))
"1q003mkagc5ib6lqb2xfay7j4ffkwv7xlnznp6wdrq2sbqq4vyak"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)))
(inputs `(("pari-gp" ,pari-gp)))
@@ -207,7 +202,7 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
(define-public giac-xcas
(package
(name "giac-xcas")
(version "1.4.9-33")
(version "1.2.2-103")
(source (origin
(method url-fetch)
;; "~parisse/giac" is not used because the maintainer regularly
@@ -219,7 +214,7 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
"source/giac_" version ".tar.gz"))
(sha256
(base32
"1f071j4l9ayri2cxka6bfdb6c0fsdl7q7wk345r7hxjfga69g9mv"))))
"1qrhjw2sdvyv2x8fqs9isqv8rgldn448gfxbi7zbva8m5va5b3z1"))))
(build-system gnu-build-system)
(arguments
`(#:phases
@@ -229,6 +224,13 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
;; Some Makefiles contain hard-coded "/bin/cp".
(substitute* (find-files "doc" "^Makefile")
(("/bin/cp") (which "cp")))
#t))
(add-after 'unpack 'disable-broken-test
(lambda _
;; Disable failing test. Actually, the results are correct but
;; a sorting discrepancy prevents the test from being validated.
(substitute* "check/Makefile.in"
(("chk_fhan16") ""))
#t)))))
(inputs
`(("fltk" ,fltk)
@@ -249,7 +251,7 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
("perl" ,perl)
("pari-gp" ,pari-gp)
("tcsh" ,tcsh)
("texlive" ,texlive-tiny)))
("texlive" ,texlive-minimal)))
(native-inputs `(("readline" ,readline)))
(home-page "https://www-fourier.ujf-grenoble.fr/~parisse/giac.html")
(synopsis "Computer algebra system")
@@ -309,7 +311,7 @@ fast arithmetic.")
(define-public arb
(package
(name "arb")
(version "2.10.0")
(version "2.8.1")
(source (origin
(method url-fetch)
(uri (string-append
@@ -318,7 +320,8 @@ fast arithmetic.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0jwcv9ssvi8axb1y7m2h4ykgyl015cl6g28gfl92l4dgnag585ak"))))
"04hhcpshfkcq9fr4hixbhpps50yf9drk62xgkvlcaj5kb4nyrx7l"))
(patches (search-patches "arb-ldconfig.patch"))))
(build-system gnu-build-system)
(propagated-inputs
`(("flint" ,flint))) ; flint.h is included by arf.h
@@ -327,21 +330,22 @@ fast arithmetic.")
("mpfr" ,mpfr)))
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(flint (assoc-ref inputs "flint"))
(gmp (assoc-ref inputs "gmp"))
(mpfr (assoc-ref inputs "mpfr")))
;; do not pass "--enable-fast-install", which makes the
;; homebrew configure process fail
(zero? (system*
"./configure"
(string-append "--prefix=" out)
(string-append "--with-flint=" flint)
(string-append "--with-gmp=" gmp)
(string-append "--with-mpfr=" mpfr)))))))))
(alist-replace
'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(flint (assoc-ref inputs "flint"))
(gmp (assoc-ref inputs "gmp"))
(mpfr (assoc-ref inputs "mpfr")))
;; do not pass "--enable-fast-install", which makes the
;; homebrew configure process fail
(zero? (system*
"./configure"
(string-append "--prefix=" out)
(string-append "--with-flint=" flint)
(string-append "--with-gmp=" gmp)
(string-append "--with-mpfr=" mpfr)))))
%standard-phases)))
(synopsis "Arbitrary precision floating-point ball arithmetic")
(description
"Arb is a C library for arbitrary-precision floating-point ball
@@ -464,22 +468,35 @@ binary.")
(define-public bc
(package
(name "bc")
(version "1.07.1")
(version "1.06")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/bc/bc-" version ".tar.gz"))
(sha256
(base32
"0amh9ik44jfg66csyvf4zz1l878c4755kjndq9j0270akflgrbb2"))))
"0cqf5jkwx6awgd2xc2a0mkpxilzcfmhncdcfg7c9439wgkqxkxjf"))))
(build-system gnu-build-system)
(native-inputs
`(("ed" ,ed)
("flex" ,flex)
("texinfo" ,texinfo)))
(inputs `(("readline" ,readline)))
(native-inputs `(("flex" ,flex)))
(arguments
'(#:configure-flags
(list "--with-readline")))
(home-page "https://www.gnu.org/software/bc/")
'(#:phases
(alist-replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
;; This old `configure' script doesn't support
;; variables passed as arguments.
(let ((out (assoc-ref outputs "out")))
(setenv "CONFIG_SHELL" (which "bash"))
(zero?
(system*
"./configure"
(string-append "--prefix=" out)
;; By default, man and info pages are put in
;; PREFIX/{man,info}, but we want them in
;; PREFIX/share/{man,info}.
(string-append "--mandir=" out "/share/man")
(string-append "--infodir=" out "/share/info")))))
%standard-phases)))
(home-page "http://www.gnu.org/software/bc/")
(synopsis "Arbitrary precision numeric processing language")
(description
"bc is an arbitrary precision numeric processing language. It includes
@@ -560,6 +577,23 @@ cosine/ sine transforms or DCT/DST).")
(string-append (package-description fftw)
" Single-precision version."))))
(define (pthread-variant p)
(package
(inherit p)
(name (string-append (package-name p) "-pthreads"))
(arguments
(substitute-keyword-arguments (package-arguments fftw)
((#:configure-flags flags)
`(cons "--enable-threads" ,flags))))))
;; FIXME: These packages are used temporarily by packages like Ardour until
;; "--enable-flags" is added to the fftw and fftwf packages.
(define-public fftw-with-threads
(pthread-variant fftw))
(define-public fftwf-with-threads
(pthread-variant fftwf))
(define-public fftw-openmpi
(package (inherit fftw)
(name "fftw-openmpi")
-440
View File
@@ -1,440 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Stefan Handschuh <handschuh.stefan@googlemail.com>
;;; Copyright © 2015 Kai-Chung Yan <seamlikok@gmail.com>
;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; 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 (gnu packages android)
#:use-module (guix packages)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system python)
#:use-module (guix build-system trivial)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (gnu packages)
#:use-module (gnu packages check)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages python)
#:use-module (gnu packages ssh)
#:use-module (gnu packages version-control)
#:use-module (gnu packages tls))
;; The Makefiles that we add are largely based on the Debian
;; packages. They are licensed under GPL-2 and have copyright:
;; 2012, Stefan Handschuh <handschuh.stefan@googlemail.com>
;; 2015, Kai-Chung Yan <seamlikok@gmail.com>
;; Big thanks to them for laying the groundwork.
;; The version tag is consistent between all repositories.
(define (android-platform-version) "7.1.2_r6")
(define (android-platform-system-core version)
(origin
(method git-fetch)
(uri (git-reference
(url "https://android.googlesource.com/platform/system/core")
(commit (string-append "android-" version))))
(file-name (string-append "android-platform-system-core-"
version "-checkout"))
(sha256
(base32
"0xc2n7jxrf1iw9cc278pijdfjix2fkiig5ws27f6rwp40zg5mrgg"))))
(define liblog
(package
(name "liblog")
(version (android-platform-version))
(source (android-platform-system-core version))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; TODO.
#:make-flags '("CC=gcc")
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'enter-source
(lambda _ (chdir "liblog") #t))
(add-after 'enter-source 'create-Makefile
(lambda _
;; No useful makefile is shipped, so we create one.
(with-output-to-file "Makefile"
(lambda _
(display
(string-append
"NAME = liblog\n"
"SOURCES = log_event_list.c log_event_write.c"
" logger_write.c config_write.c logger_name.c"
" logger_lock.c fake_log_device.c fake_writer.c"
" event_tag_map.c\n"
"CFLAGS += -fvisibility=hidden -fPIC\n"
"CPPFLAGS += -I../include -DFAKE_LOG_DEVICE=1"
;; Keep these two in sync with "liblog/Android.bp".
" -DLIBLOG_LOG_TAG=1005"
" -DSNET_EVENT_LOG_TAG=1397638484\n"
"LDFLAGS += -shared -Wl,-soname,$(NAME).so.0 -lpthread\n"
"build: $(SOURCES)\n"
" $(CC) $^ -o $(NAME).so.0 $(CFLAGS) $(CPPFLAGS) $(LDFLAGS)\n"))
#t))))
(delete 'configure)
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(lib (string-append out "/lib")))
(install-file "liblog.so.0" lib)
(with-directory-excursion lib
(symlink "liblog.so.0" "liblog.so"))
#t))))))
(home-page "https://developer.android.com/")
(synopsis "Logging library from the Android platform.")
(description "@code{liblog} represents an interface to the volatile Android
Logging system for NDK (Native) applications and libraries and contain
interfaces for either writing or reading logs. The log buffers are divided up
in Main, System, Radio and Events sub-logs.")
(license license:asl2.0)))
(define libbase
(package
(name "libbase")
(version (android-platform-version))
(source (origin
(inherit (android-platform-system-core version))
(patches
(search-patches "libbase-use-own-logging.patch"
"libbase-fix-includes.patch"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; TODO.
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'enter-source
(lambda _ (chdir "base") #t))
(add-after 'enter-source 'create-Makefile
(lambda _
;; No useful makefile is shipped, so we create one.
(with-output-to-file "Makefile"
(lambda _
(display
(string-append
"NAME = libbase\n"
"SOURCES = file.cpp logging.cpp parsenetaddress.cpp"
" stringprintf.cpp strings.cpp errors_unix.cpp\n"
"CXXFLAGS += -std=gnu++11 -fPIC\n"
"CPPFLAGS += -Iinclude -I../include\n"
"LDFLAGS += -shared -Wl,-soname,$(NAME).so.0"
" -L.. -llog\n"
"build: $(SOURCES)\n"
" $(CXX) $^ -o $(NAME).so.0 $(CXXFLAGS) $(CPPFLAGS)"
" $(LDFLAGS)\n"))
#t))))
(delete 'configure)
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(lib (string-append out "/lib")))
(install-file "libbase.so.0" lib)
(with-directory-excursion lib
(symlink "libbase.so.0" "libbase.so"))
(copy-recursively "include" out)
#t))))))
(inputs `(("liblog" ,liblog)))
(home-page "https://developer.android.com/")
(synopsis "Android platform base library")
(description "@code{libbase} is a library in common use by the
various Android core host applications.")
(license license:asl2.0)))
(define libcutils
(package
(name "libcutils")
(version (android-platform-version))
(source (android-platform-system-core version))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; TODO.
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'enter-source
(lambda _ (chdir "libcutils") #t))
(add-after 'enter-source 'create-Makefile
(lambda _
;; No useful makefile is shipped, so we create one.
(with-output-to-file "Makefile"
(lambda _
(display
(string-append
"NAME = libcutils\n"
"SOURCES = load_file.o socket_local_client_unix.o"
" socket_loopback_client_unix.o socket_network_client_unix.o"
" socket_loopback_server_unix.o socket_local_server_unix.o"
" sockets_unix.o socket_inaddr_any_server_unix.o"
" sockets.o\n"
"CC = gcc\n"
"CFLAGS += -fPIC\n"
"CXXFLAGS += -std=gnu++11 -fPIC\n"
"CPPFLAGS += -Iinclude -I../include\n"
"LDFLAGS += -shared -Wl,-soname,$(NAME).so.0\n"
"build: $(SOURCES)\n"
" $(CXX) $^ -o $(NAME).so.0 $(CXXFLAGS) $(CPPFLAGS)"
" $(LDFLAGS)\n"))
#t))))
(delete 'configure)
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(lib (string-append out "/lib")))
(install-file "libcutils.so.0" lib)
(with-directory-excursion lib
(symlink "libcutils.so.0" "libcutils.so"))
#t))))))
(home-page "https://developer.android.com/")
(synopsis "Android platform c utils library")
(description "@code{libcutils} is a library in common use by the
various Android core host applications.")
(license license:asl2.0)))
(define-public adb
(package
(name "adb")
(version (android-platform-version))
(source (origin
(inherit (android-platform-system-core version))
(patches
(search-patches "libbase-use-own-logging.patch"
"libbase-fix-includes.patch"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'enter-source
(lambda _ (chdir "adb") #t))
(add-before 'build 'fix-clang
(lambda _
;; adb_client.h contains _Nonnull and _Nullable attributes, that
;; are not understood by gcc.
(substitute* "adb_client.h"
(("_Nonnull") "")
(("_Nullable") ""))
#t))
(add-before 'build 'fix-main
(lambda _
;; main.cpp used to be adb_main.cpp in the current directory
;; rather than in its own subdirectory, but it was not fixed.
;; This leads to some header files not being found anymore.
(copy-file "client/main.cpp" "adb_main.cpp")
#t))
(add-after 'enter-source 'create-Makefile
(lambda* (#:key outputs #:allow-other-keys)
;; No useful makefile is shipped, so we create one.
(with-output-to-file "Makefile"
(lambda _
(display
(string-append
;; Common for all components.
"CXXFLAGS += -std=gnu++14 -fpermissive\n"
"CPPFLAGS += -I../include -I../base/include -I. -DADB_HOST=1 "
"-DADB_REVISION='\"" ,version "\"' -fPIC\n"
"LDFLAGS += -lcrypto -lpthread -lbase -lcutils -L. -ladb\n"
;; Libadb specifics.
"LIBADB_SOURCES = adb.cpp adb_auth.cpp adb_io.cpp "
"adb_listeners.cpp adb_trace.cpp adb_utils.cpp fdevent.cpp "
"sockets.cpp transport.cpp transport_local.cpp transport_usb.cpp "
"get_my_path_linux.cpp sysdeps_unix.cpp usb_linux.cpp "
"adb_auth_host.cpp diagnose_usb.cpp services.cpp "
"shell_service_protocol.cpp bugreport.cpp line_printer.cpp\n"
"LIBADB_LDFLAGS += -shared -Wl,-soname,libadb.so.0 "
"-lcrypto -lpthread -lbase\n"
;; Adb specifics.
"ADB_SOURCES = adb_main.cpp console.cpp commandline.cpp "
"adb_client.cpp file_sync_client.cpp\n"
"ADB_LDFLAGS += -Wl,-rpath=" (assoc-ref outputs "out") "/lib\n"
"build: libadb $(ADB_SOURCES)\n"
" $(CXX) $(ADB_SOURCES) -o adb $(CXXFLAGS) $(CPPFLAGS) "
"$(ADB_LDFLAGS) $(LDFLAGS)\n"
"libadb: $(LIBADB_SOURCES)\n"
" $(CXX) $^ -o libadb.so.0 $(CXXFLAGS) $(CPPFLAGS) "
"$(LIBADB_LDFLAGS)\n"
" ln -sv libadb.so.0 libadb.so\n"))
#t))))
(delete 'configure)
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(lib (string-append out "/lib"))
(bin (string-append out "/bin")))
(install-file "libadb.so.0" lib)
(install-file "adb" bin)
(with-directory-excursion lib
(symlink "libadb.so.0" "libadb.so"))
#t))))
;; Test suite must be run with attached devices
#:tests? #f))
(inputs
`(("libbase" ,libbase)
("libcutils" ,libcutils)
("openssl" ,openssl)))
(home-page "https://developer.android.com/studio/command-line/adb.html")
(synopsis "Android Debug Bridge")
(description
"@command{adb} is a versatile command line tool that lets you communicate
with an emulator instance or connected Android device. It facilitates a variety
of device actions, such as installing and debugging apps, and it provides access
to a Unix shell that can run commands on the connected device or emulator.")
(license license:asl2.0)))
(define-public android-udev-rules
(package
(name "android-udev-rules")
(version "20170910")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/M0Rf30/android-udev-rules")
(commit version)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32 "0vic40n3si0dxag3dyc3hi3pn7cjpm5q378x8v2ys19n3iz9fp1g"))))
(build-system trivial-build-system)
(native-inputs `(("source" ,source)))
(arguments
'(#:modules ((guix build utils))
#:builder
(begin
(use-modules (guix build utils))
(let ((source (assoc-ref %build-inputs "source")))
(install-file (string-append source "/51-android.rules")
(string-append %output "/lib/udev/rules.d"))))))
(home-page "https://github.com/M0Rf30/android-udev-rules")
(synopsis "udev rules for Android devices")
(description "Provides a set of udev rules to allow using Android devices
with tools such as @command{adb} and @command{fastboot} without root
privileges. This package is intended to be added as a rule to the
@code{udev-service-type} in your @code{operating-system} configuration.
Additionally, an @code{adbusers} group must be defined and your user added to
it.
@emph{Simply installing this package will not have any effect.} It is meant
to be passed to the @code{udev} service.")
(license license:gpl3+)))
(define-public git-repo
(package
(name "git-repo")
(version "1.12.37")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://gerrit.googlesource.com/git-repo")
(commit (string-append "v" version))))
(file-name (string-append "git-repo-" version "-checkout"))
(sha256
(base32 "0qp7jqhblv7xblfgpcq4n18dyjdv8shz7r60c3vnjxx2fngkj2jd"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2 ; code says: "Python 3 support is … experimental."
#:phases
(modify-phases %standard-phases
(add-before 'build 'set-executable-paths
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(git (assoc-ref inputs "git"))
(gpg (assoc-ref inputs "gnupg"))
(ssh (assoc-ref inputs "ssh")))
(substitute* '("repo" "git_command.py")
(("^GIT = 'git' ")
(string-append "GIT = '" git "/bin/git' ")))
(substitute* "repo"
((" cmd = \\['gpg',")
(string-append " cmd = ['" gpg "/bin/gpg',")))
(substitute* "git_config.py"
((" command_base = \\['ssh',")
(string-append " command_base = ['" ssh "/bin/ssh',")))
#t)))
(add-before 'build 'do-not-clone-this-source
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(repo-dir (string-append out "/share/" ,name)))
(substitute* "repo"
(("^def _FindRepo\\(\\):.*")
(format #f "
def _FindRepo():
'''Look for a repo installation, starting at the current directory.'''
# Use the installed version of git-repo.
repo_main = '~a/main.py'
curdir = os.getcwd()
olddir = None
while curdir != '/' and curdir != olddir:
dot_repo = os.path.join(curdir, repodir)
if os.path.isdir(dot_repo):
return (repo_main, dot_repo)
else:
olddir = curdir
curdir = os.path.dirname(curdir)
return None, ''
# The remaining of this function is dead code. It was used to
# find a git-checked-out version in the local project.\n" repo-dir))
;; Neither clone, check out, nor verify the git repository
(("(^\\s+)_Clone\\(.*\\)") "")
(("(^\\s+)_Checkout\\(.*\\)") "")
((" rev = _Verify\\(.*\\)") " rev = None"))
#t)))
(delete 'build) ; nothing to build
(replace 'check
(lambda _
(zero? (system* "python" "-m" "nose"))))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin-dir (string-append out "/bin"))
(repo-dir (string-append out "/share/" ,name)))
(mkdir-p bin-dir)
(mkdir-p repo-dir)
(copy-recursively "." repo-dir)
(delete-file-recursively (string-append repo-dir "/tests"))
(symlink (string-append repo-dir "/repo")
(string-append bin-dir "/repo"))
#t))))))
(inputs
;; TODO: Add git-remote-persistent-https once it is available in guix
`(("git" ,git)
("gnupg" ,gnupg)
("ssh", openssh)))
(native-inputs
`(("nose" ,python2-nose)))
(home-page "https://code.google.com/p/git-repo/")
(synopsis "Helps to manage many Git repositories.")
(description "Repo is a tool built on top of Git. Repo helps manage many
Git repositories, does the uploads to revision control systems, and automates
parts of the development workflow. Repo is not meant to replace Git, only to
make it easier to work with Git. The repo command is an executable Python
script that you can put anywhere in your path.")
(license license:asl2.0)))
+32 -107
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,12 +19,10 @@
(define-module (gnu packages animation)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix utils)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages algebra)
#:use-module (gnu packages boost)
#:use-module (gnu packages compression)
#:use-module (gnu packages fontutils)
@@ -35,22 +33,20 @@
#:use-module (gnu packages image)
#:use-module (gnu packages imagemagick)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages pulseaudio)
#:use-module (gnu packages qt)
#:use-module (gnu packages video))
(define-public etl
(package
(name "etl")
(version "0.04.22")
(version "0.04.19")
(source (origin
(method url-fetch)
;; Keep this synchronized with the synfig release version.
(uri (string-append "mirror://sourceforge/synfig/releases/"
"1.2.0/source/ETL-" version ".tar.gz"))
"1.0.2/source/ETL-" version ".tar.gz"))
(sha256
(base32
"0ii73nsd3xzkhz6w1rnxwphl637j9w82xiy6apa9vin2isdynnmc"))))
"070c70slizrklq1gbgja8m49xfmq65wlcd6hz6418cpx0wd4r55s"))))
(build-system gnu-build-system)
(home-page "http://www.synfig.org")
(synopsis "Extended C++ template library")
@@ -63,7 +59,7 @@ C++ @dfn{Standard Template Library} (STL).")
(define-public synfig
(package
(name "synfig")
(version "1.2.0")
(version "1.0.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/synfig/releases/"
@@ -71,7 +67,8 @@ C++ @dfn{Standard Template Library} (STL).")
".tar.gz"))
(sha256
(base32
"1gqx4gn4c73rqwhsgzx0a460gr9hadmi28csp75rx30qavqsj7k1"))))
"1d3z2r78j3rkff47q3wl0ami69y3l4nyi5r9zclymb8ar7mgkk9l"))
(patches (search-patches "synfig-build-fix.patch"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
@@ -81,16 +78,6 @@ C++ @dfn{Standard Template Library} (STL).")
"/lib"))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-boost-build-error
;; A chain of Boost headers leads to this error: "make_array" is
;; not a member of "boost::serialization". This can be avoided by
;; loading the "array_wrapper" header first.
(lambda _
(substitute* "src/synfig/valuenodes/valuenode_dynamic.cpp"
(("#include <boost/numeric/odeint/integrate/integrate.hpp>" match)
(string-append
"#include <boost/serialization/array_wrapper.hpp>\n" match)))
#t))
(add-after 'unpack 'adapt-to-libxml++-changes
(lambda _
(substitute* "configure"
@@ -103,6 +90,16 @@ C++ @dfn{Standard Template Library} (STL).")
(("remove_child\\(") "remove_node("))
(substitute* "src/modules/mod_svg/svg_parser.cpp"
(("xmlpp::Node::NodeList") "xmlpp::Node::const_NodeList"))
#t))
(add-after 'unpack 'fix-isnan-error
(lambda _
(substitute* "src/synfig/time.cpp"
(("return !::isnan") "return !std::isnan"))
#t))
(add-before 'configure 'set-flags
(lambda _
;; Compile with C++11, required by libsigc++.
(setenv "CXXFLAGS" "-D__STDC_CONSTANT_MACROS -std=gnu++11")
#t)))))
(inputs
`(("boost" ,boost)
@@ -113,12 +110,11 @@ C++ @dfn{Standard Template Library} (STL).")
("libmng" ,libmng)
("zlib" ,zlib)))
;; synfig.pc lists the following as required: Magick++ freetype2
;; fontconfig fftw OpenEXR ETL glibmm-2.4 giomm-2.4 libxml++-3.0 sigc++-2.0
;; fontconfig OpenEXR ETL glibmm-2.4 giomm-2.4 libxml++-3.0 sigc++-2.0
;; cairo pango pangocairo mlt++
(propagated-inputs
`(("cairo" ,cairo)
("etl" ,etl)
("fftw" ,fftw)
("fontconfig" ,fontconfig)
("freetype" ,freetype)
("glibmm" ,glibmm)
@@ -141,7 +137,7 @@ for tweening, preventing the need to hand-draw each frame.")
(define-public synfigstudio
(package
(name "synfigstudio")
(version "1.2.0")
(version "1.0.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/synfig/releases/"
@@ -149,32 +145,29 @@ for tweening, preventing the need to hand-draw each frame.")
".tar.gz"))
(sha256
(base32
"0fbckfbw8dzf0m2wv7vlmw492k1dqa3zf510z019d0as3zpnp6qm"))
"1xa74dlgkpjn0gzdcs0x25z7wg0806v2wygvvi73f7sn1fm88ig4"))
(modules '((guix build utils)))
(snippet
'(begin
(substitute* "src/synfigapp/pluginmanager.cpp"
(("xmlpp::Node\\* n =") "const xmlpp::Node* n =")
(("xmlpp::Node::NodeList") "xmlpp::Node::const_NodeList"))
#t))
(patches
(search-patches "synfigstudio-fix-ui-with-gtk3.patch"))))
;; Some files are ISO-8859-1 encoded.
(with-fluids ((%default-port-encoding #f))
(substitute* (find-files "src/" "\\.(cpp|h)$")
(("#include <sigc\\+\\+/retype\\.h>")
"#include <sigc++/adaptors/retype.h>")
(("#include <sigc\\+\\+/hide\\.h>")
"#include <sigc++/adaptors/hide.h>")
(("#include <sigc\\+\\+/object\\.h>")
"#include <sigc++/trackable.h>")))
#t))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
;; This fixes the file chooser crash that happens with GTK 3.
(add-after 'install 'wrap-program
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(gtk (assoc-ref inputs "gtk+"))
(gtk-share (string-append gtk "/share")))
(wrap-program (string-append out "/bin/synfigstudio")
`("XDG_DATA_DIRS" ":" prefix (,gtk-share)))
#t))))))
`(#:configure-flags
(list "CXXFLAGS=-std=gnu++11")))
(inputs
`(("gtkmm" ,gtkmm)
("gtk+" ,gtk+)
("libsigc++" ,libsigc++)
("synfig" ,synfig)))
(native-inputs
@@ -188,71 +181,3 @@ be capable of producing feature-film quality animation. It eliminates the
need for tweening, preventing the need to hand-draw each frame. This package
contains the graphical user interface for synfig.")
(license license:gpl3+)))
(define-public papagayo
(let ((commit "e143684b30e59fe4a554f965cb655d23cbe93ee7")
(revision "1"))
(package
(name "papagayo")
(version (string-append "2.0b1-" revision "." (string-take commit 9)))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/LostMoho/Papagayo.git")
(commit commit)))
(sha256
(base32
"1p9gffjhbph34jhrvgpg93yha75bf88vkvlnk06x1r9601ph5321"))
(modules '((guix build utils)))
;; Delete bundled libsndfile sources.
(snippet
'(begin
(delete-file-recursively "libsndfile_1.0.19")
(delete-file-recursively "libsndfile_1.0.25")
#t))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((libsndfile (assoc-ref inputs "libsndfile")))
;; Do not use bundled libsndfile sources
(substitute* "Papagayo.pro"
(("else \\{")
(string-append "\nINCLUDEPATH += " libsndfile
"/include"
"\nLIBS +=" libsndfile
"/lib/libsndfile.so\n"
"win32 {"))))
(zero? (system* "qmake"
(string-append "DESTDIR="
(assoc-ref outputs "out")
"/bin")))))
;; Ensure that all required Qt plugins are found at runtime.
(add-after 'install 'wrap-executable
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(qt '("qt" "qtmultimedia")))
(wrap-program (string-append out "/bin/Papagayo")
`("QT_PLUGIN_PATH" ":" prefix
,(map (lambda (label)
(string-append (assoc-ref inputs label)
"/lib/qt5/plugins/"))
qt)))
#t))))))
(inputs
`(("qt" ,qtbase)
("qtmultimedia" ,qtmultimedia)
("libsndfile" ,libsndfile)))
(native-inputs
`(("qttools" ,qttools)))
(home-page "http://www.lostmarble.com/papagayo/")
(synopsis "Lip-syncing for animations")
(description
"Papagayo is a lip-syncing program designed to help you line up
phonemes with the actual recorded sound of actors speaking. Papagayo makes it
easy to lip sync animated characters by making the process very simple just
type in the words being spoken, then drag the words on top of the sounds
waveform until they line up with the proper sounds.")
(license license:gpl3+))))
+3 -4
View File
@@ -1,7 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,16 +30,16 @@
(define-public apl
(package
(name "apl")
(version "1.7")
(version "1.6")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/apl/apl-" version ".tar.gz"))
(sha256
(base32
"07xq8ddlmz8psvsmwr23gar108ri0lwmw0n6kpxcv8ypas1f5xlg"))))
"057zwzvvgcrrwsl52a27w86hgy31jqq6avqq629xj7yq90qah3ay"))))
(build-system gnu-build-system)
(home-page "https://www.gnu.org/software/apl/")
(home-page "http://www.gnu.org/software/apl/")
(inputs
`(("gettext" ,gettext-minimal)
("lapack" ,lapack)
+17 -16
View File
@@ -30,14 +30,14 @@
(define-public apr
(package
(name "apr")
(version "1.6.3")
(version "1.5.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://apache/apr/apr-"
version ".tar.bz2"))
(sha256
(base32
"0wiik6amxn6lkc55fv9yz5i3kbxnqbp36alrzabx1avsdp8hc7qk"))
"0ypn51xblix5ys9xy7da3ngdydip0qqh9rdq8nz54w9aq8lys0vx"))
(patches
(search-patches "apr-skip-getservbyname-test.patch"))
(patch-flags '("-p0"))))
@@ -65,14 +65,14 @@ around or take advantage of platform-specific deficiencies or features.")
(define-public apr-util
(package
(name "apr-util")
(version "1.6.1")
(version "1.5.4")
(source (origin
(method url-fetch)
(uri (string-append "mirror://apache/apr/apr-util-"
version ".tar.bz2"))
(sha256
(base32
"0nq3s1yn13vplgl6qfm09f7n0wm08malff9s59bqf9nid9xjzqfk"))))
"0bn81pfscy9yjvbmyx442svf43s6dhrdfcsnkpxz43fai5qk5kx6"))))
(build-system gnu-build-system)
(inputs
`(("apr" ,apr)))
@@ -80,18 +80,19 @@ around or take advantage of platform-specific deficiencies or features.")
`(("expat" ,expat)))
(arguments
'(#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(apr (assoc-ref inputs "apr"))
(expat (assoc-ref inputs "expat")))
(setenv "CONFIG_SHELL" (which "bash"))
(zero?
(system* "./configure"
(string-append "--prefix=" out)
(string-append "--with-apr=" apr)
(string-append "--with-expat=" expat)))))))
(alist-replace
'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(apr (assoc-ref inputs "apr"))
(expat (assoc-ref inputs "expat")))
(setenv "CONFIG_SHELL" (which "bash"))
(zero?
(system* "./configure"
(string-append "--prefix=" out)
(string-append "--with-apr=" apr)
(string-append "--with-expat=" expat)))))
%standard-phases)
;; There are race conditions during 'make check'. Typically, the
;; 'testall' executable is not built yet by the time 'make check' tries
+9 -140
View File
@@ -1,11 +1,10 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Christopher Andersson <christopher@8bits.nu>
;;; Copyright © 2016 Theodoros Foradis <theodoros@foradis.org>
;;; Copyright © 2016, 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2016 Theodoros Foradis <theodoros.for@openmailbox.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,10 +26,8 @@
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (guix licenses)
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages compression)
#:use-module (gnu packages perl))
#:use-module (gnu packages perl)
#:use-module (gnu packages base))
(define-public aspell
(package
@@ -43,8 +40,7 @@
version ".tar.gz"))
(sha256
(base32
"1qgn5psfyhbrnap275xjfrzppf5a83fb67gpql0kfqv37al869gm"))
(patches (search-patches "aspell-default-dict-dir.patch"))))
"1qgn5psfyhbrnap275xjfrzppf5a83fb67gpql0kfqv37al869gm"))))
(build-system gnu-build-system)
(arguments
`(#:phases
@@ -57,15 +53,6 @@
'("ASPELL_CONF" "" =
("${ASPELL_CONF:-\"dict-dir ${GUIX_PROFILE:-$HOME/.guix-profile}/lib/aspell\"}")))))))))
(inputs `(("perl" ,perl)))
(native-search-paths
;; This is a Guix-specific environment variable that takes a single
;; entry, not an actual search path.
(list (search-path-specification
(variable "ASPELL_DICT_DIR")
(separator #f)
(files '("lib/aspell")))))
(home-page "http://aspell.net/")
(synopsis "Spell checker")
(description
@@ -75,12 +62,12 @@ documents written in the UTF-8 encoding and its ability to use multiple
dictionaries, including personal ones.")
(license lgpl2.1+)))
;;;
;;; Dictionaries.
;;;
;;; Use 'export ASPELL_CONF="dict-dir $HOME/.guix-profile/lib/aspell"' to use
;;; them, or set the Guix-specific 'ASPELL_DICT_DIR', or just do nothing (as
;;; long as 'HOME' is set, that's fine!).
;;; them.
;;;
(define* (aspell-dictionary dict-name full-name
@@ -116,13 +103,6 @@ dictionaries, including personal ones.")
(home-page "http://aspell.net/")))
(define-public aspell-dict-ca
(aspell-dictionary "ca" "Catalan"
#:version "2.1.5-1"
#:sha256
(base32
"1fb5y5kgvk25nlsfvc8cai978hg66x3pbp9py56pldc7vxzf9npb")))
(define-public aspell-dict-de
(aspell-dictionary "de" "German"
#:version "20030222-1"
@@ -132,10 +112,10 @@ dictionaries, including personal ones.")
(define-public aspell-dict-en
(aspell-dictionary "en" "English"
#:version "2017.01.22-0"
#:version "2016.11.20-0"
#:sha256
(base32
"1qamzpw1fsnn5n9jpsnnnzqj1a0m0xvsikmkdp5a6pmb7sp3ziwk")))
"1496jnhh2jvhkzcj0p4vy89bcs4g5wz6a76m33vw4dhchn5xm9jw")))
(define-public aspell-dict-eo
(aspell-dictionary "eo" "Esperanto"
@@ -210,114 +190,3 @@ dictionaries, including personal ones.")
#:sha256
(base32
"1zxr8958v37v260fkqd4pg37ns5h5kyqm54hn1hg70wq5cz8h512")))
(define-public aspell-dict-pt-br
(aspell-dictionary "pt-br" "Brazilian Portuguese"
#:version "20090702-0"
#:prefix "aspell6-"
#:sha256
(base32
"1y09lx9zf2rnp55r16b2vgj953l3538z1vaqgflg9mdvm555bz3p")))
;;;
;;; Hunspell packages made from the Aspell word lists.
;;;
(define* (aspell-word-list language synopsis
#:optional
(nick (string-map (lambda (chr)
(if (char=? #\_ chr)
#\-
chr))
(string-downcase language))))
(package
(name (string-append "hunspell-dict-" nick))
(version "2017.08.24")
(source (origin
(method url-fetch)
(uri (string-append
"http://downloads.sourceforge.net/wordlist/scowl-"
version ".tar.gz"))
(sha256
(base32
"1kdhydzg5z5x20ad2j1x5hbdhvy08ljkfdi2v3gbyvghbagxm15s"))))
(native-inputs
`(("tar" ,tar)
("gzip" ,gzip)
("perl" ,perl)
("aspell" ,aspell)))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'configure)
(delete 'check)
(replace 'build
(lambda _
(substitute* "speller/make-hunspell-dict"
(("zip -9 .*$")
"return\n"))
(mkdir "speller/hunspell")
;; XXX: This actually builds all the dictionary variants.
(zero? (system* "make" "-C" "speller" "hunspell"))))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref %outputs "out"))
(hunspell (string-append out "/share/hunspell"))
(myspell (string-append out "/share/myspell"))
(doc (string-append out "/share/doc/"
,name)))
(mkdir-p myspell)
(install-file ,(string-append "speller/" language ".dic")
hunspell)
(install-file ,(string-append "speller/" language ".aff")
hunspell)
(symlink hunspell (string-append myspell "/dicts"))
(for-each (lambda (file)
(install-file file doc))
(find-files "."
"^(Copyright|.*\\.(txt|org|md))$"))
#t))))))
(synopsis synopsis)
(description
"This package provides a dictionary for the Hunspell spell-checking
library.")
(home-page "http://wordlist.aspell.net/")
(license (non-copyleft "file://Copyright"
"Word lists come from several sources, all
under permissive licensing terms. See the 'Copyright' file."))))
(define-syntax define-word-list-dictionary
(syntax-rules (synopsis)
((_ name language (synopsis text))
(define-public name
(aspell-word-list language text)))
((_ name language nick (synopsis text))
(define-public name
(aspell-word-list language text nick)))))
(define-word-list-dictionary hunspell-dict-en
"en"
(synopsis "Hunspell dictionary for English"))
(define-word-list-dictionary hunspell-dict-en-au
"en_AU"
(synopsis "Hunspell dictionary for Australian English"))
(define-word-list-dictionary hunspell-dict-en-ca
"en_CA"
(synopsis "Hunspell dictionary for Canadian English"))
(define-word-list-dictionary hunspell-dict-en-gb
"en_GB-ise" "en-gb"
(synopsis "Hunspell dictionary for British English, with -ise endings"))
(define-word-list-dictionary hunspell-dict-en-gb-ize
"en_GB-ize"
(synopsis "Hunspell dictionary for British English, with -ize endings"))
(define-word-list-dictionary hunspell-dict-en-us
"en_US"
(synopsis "Hunspell dictionary for United States English"))
+9 -9
View File
@@ -34,14 +34,14 @@
(define-public nasm
(package
(name "nasm")
(version "2.13.01")
(version "2.12.02")
(source (origin
(method url-fetch)
(uri (string-append "http://www.nasm.us/pub/nasm/releasebuilds/"
version "/" name "-" version ".tar.xz"))
(sha256
(base32
"0plsvcwxc7q3llr3bz10prwq1gn4ll38aqmv0yzfqcq4iw0160ma"))))
"08a3ah791cl7xdyrlz33mwv4xzs08rxh0p902p3ypi5iq1h6p1jc"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl) ;for doc and test target
("texinfo" ,texinfo)))
@@ -52,10 +52,10 @@
(add-after 'unpack 'dont-build-ps-pdf-outputs
(lambda _
(substitute* "doc/Makefile.in"
(("html nasmdoc.txt nasmdoc.pdf")
"html nasmdoc.txt")
(("\\$\\(INSTALL_DATA\\) nasmdoc.pdf")
"$(INSTALL_DATA)"))
(("info html nasmdoc.txt nasmdoc.ps nasmdoc.pdf")
"info html nasmdoc.txt")
(("nasmdoc.ps nasmdoc.pdf nasmdoc.txt \\$\\(INSTALLROOT\\)\\$\\(docdir\\)")
"nasmdoc.txt $(INSTALLROOT)$(docdir)"))
#t))
(add-after 'install 'install-info
(lambda _
@@ -103,14 +103,14 @@ debugging information in STABS, DWARF 2, and CodeView 8 formats.")
(define-public lightning
(package
(name "lightning")
(version "2.1.2")
(version "2.1.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/lightning/lightning-"
version ".tar.gz"))
(sha256
(base32
"0sbs2lm8b9in2m8d52zf0x9gpp40x6r7sl6sha92yq3pr78rwa4v"))))
"19j9nwl88k660045s40cbz5zrl1wpd2mcxnnc8qqnnaj311a58qz"))))
(build-system gnu-build-system)
(native-inputs `(("zlib" ,zlib)))
(synopsis "Library for generating assembly code at runtime")
@@ -119,5 +119,5 @@ debugging information in STABS, DWARF 2, and CodeView 8 formats.")
run-time. Thus, it is useful in creating Just-In-Time compilers. It
abstracts over the target CPU by exposing a standardized RISC instruction set
to the clients.")
(home-page "https://www.gnu.org/software/lightning/")
(home-page "http://www.gnu.org/software/lightning/")
(license license:gpl3+)))
+7 -64
View File
@@ -21,13 +21,7 @@
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix download)
#:use-module (gnu packages image)
#:use-module (gnu packages compression)
#:use-module (gnu packages gettext)
#:use-module (gnu packages perl)
#:use-module (gnu packages gl)
#:use-module (gnu packages qt)
#:use-module (gnu packages maths)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu))
(define-public cfitsio
@@ -64,7 +58,7 @@ in FITS files.")
(define-public wcslib
(package
(name "wcslib")
(version "5.17")
(version "5.15")
(source
(origin
(method url-fetch)
@@ -72,7 +66,7 @@ in FITS files.")
"ftp://ftp.atnf.csiro.au/pub/software/wcslib/" name "-" version
".tar.bz2"))
(sha256
(base32 "0v23x1fw01arhmqdrzfd9n593mjglhzfyx4793v065z0dg4bb72w"))))
(base32 "1s2nig327g4bimd9xshlk11ww09a7mrjmsbpdcd8smsmn2kl1glb"))))
(inputs
`(("cfitsio" ,cfitsio)))
(build-system gnu-build-system)
@@ -83,7 +77,7 @@ in FITS files.")
(substitute* "makedefs.in"
(("/bin/sh") "sh"))
#t)))))
(home-page "https://www.atnf.csiro.au/people/mcalabre/WCS")
(home-page "http://www.atnf.csiro.au/people/mcalabre/WCS")
(synopsis "Library which implements the FITS WCS standard")
(description "The FITS \"World Coordinate System\" (WCS) standard defines
keywords and usage that provide for the description of astronomical coordinate
@@ -93,7 +87,7 @@ systems in a FITS image header.")
(define-public gnuastro
(package
(name "gnuastro")
(version "0.4")
(version "0.2")
(source
(origin
(method url-fetch)
@@ -101,66 +95,15 @@ systems in a FITS image header.")
version ".tar.gz"))
(sha256
(base32
"1n30zz4kg89ic5h30b7nrxp0bk0ls2m3xnfi81mja56bxxwpihrs"))))
"0099g7zqg1gr9y94ybhyjgx9pkn9zv4rj1xb00fkybfw8w6ij9iv"))))
(inputs
`(("cfitsio" ,cfitsio)
("gsl" ,gsl)
("libjpeg" ,libjpeg-8)
("wcslib" ,wcslib)))
(build-system gnu-build-system)
(arguments
;; Reduce the number of required type conversions by enabling arithmetic
;; with all the supported types.
`(#:configure-flags '("--enable-bin-op-alltypes")))
(home-page "https://www.gnu.org/software/gnuastro/")
(synopsis "Astronomy utilities")
(home-page "https://www.gnu.org/software/gnuastro")
(synopsis "Astronomical data manipulation programs")
(description "The GNU Astronomy Utilities (Gnuastro) is a suite of
programs for the manipulation and analysis of astronomical data.")
(license license:gpl3+)))
(define-public stellarium
(package
(name "stellarium")
(version "0.16.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/stellarium/"
"Stellarium-sources/"
version "/stellarium-" version ".tar.gz"))
(sha256
(base32
"1krxj51lix096xbz64lys166a8zdwhill5vvs7dlxdn14amc8d98"))))
(build-system cmake-build-system)
(inputs
`(("qtbase" ,qtbase)
("qtlocation" ,qtlocation)
("qtmultimedia" ,qtmultimedia)
("qtscript" ,qtscript)
("qtserialport" ,qtserialport)
("zlib" ,zlib)))
(native-inputs
`(("gettext" ,gettext-minimal) ; xgettext is used at compile time
("perl" ,perl) ; For pod2man
("qtbase" ,qtbase) ; Qt MOC is needed at compile time
("qttools" ,qttools)))
(arguments
`(#:test-target "tests"
#:phases (modify-phases %standard-phases
(add-after 'unpack 'patch-tests
(lambda _
(substitute* "src/tests/testStelSphereGeometry.cpp"
(("Vec3d v[(]0[)]") "Vec3d v(0.0)"))
#t))
(add-before 'check 'set-offscreen-display
(lambda _
;; make Qt render "offscreen", required for tests
(setenv "QT_QPA_PLATFORM" "offscreen")
(setenv "HOME" "/tmp")
#t)))))
(home-page "http://www.stellarium.org/")
(synopsis "3D sky viewer")
(description "Stellarium is a planetarium. It shows a realistic sky in
3D, just like what you see with the naked eye, binoculars, or a telescope. It
can be used to control telescopes over a serial port for tracking celestial
objects.")
(license license:gpl2+)))
+1 -1
View File
@@ -54,7 +54,7 @@
;; Use the right shell.
(substitute* "test/run"
(("/bin/sh")
(which "sh")))
(which "bash")))
;; When building natively, run the tests.
(unless target
+101
View File
@@ -0,0 +1,101 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;;
;;; 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 (gnu packages audacity)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages audio)
#:use-module (gnu packages base)
#:use-module (gnu packages gtk)
#:use-module (gnu packages linux)
#:use-module (gnu packages mp3)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages pulseaudio)
#:use-module (gnu packages python)
#:use-module (gnu packages xiph)
#:use-module (gnu packages xml)
#:use-module (gnu packages video)
#:use-module (gnu packages wxwidgets))
(define-public audacity
(package
(name "audacity")
(version "2.1.0")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/audacity/audacity/" version
"/audacity-minsrc-" version ".tar.xz"))
(sha256
(base32 "1cs2w3fwqylpqmfwkvlgdx5lhclpckfil7pqibl37qlbnf4qvndh"))
(patches (search-patches "audacity-fix-ffmpeg-binding.patch"))))
(build-system gnu-build-system)
(inputs
;; TODO: Add portSMF and libwidgetextra once they're packaged. In-tree
;; versions shipping with Audacity are used for now.
`(("wxwidgets" ,wxwidgets-2)
("gtk" ,gtk+-2)
("alsa-lib" ,alsa-lib)
("jack" ,jack-1)
("expat" ,expat)
("ffmpeg" ,ffmpeg)
("lame" ,lame)
("flac" ,flac)
("libid3tag" ,libid3tag)
("libmad" ,libmad)
("libsbsms" ,libsbsms)
("libsndfile" ,libsndfile)
("soundtouch" ,soundtouch)
("soxr" ,soxr) ;replaces libsamplerate
("twolame" ,twolame)
("vamp" ,vamp)
("libvorbis" ,libvorbis)
("lv2" ,lv2)
("lilv" ,lilv)
("portaudio" ,portaudio)))
(native-inputs
`(("pkg-config" ,pkg-config)
("python" ,python-2)
("which" ,which)))
(arguments
'(#:configure-flags
(let ((libid3tag (assoc-ref %build-inputs "libid3tag"))
(libmad (assoc-ref %build-inputs "libmad")))
(list
;; Loading FFmpeg dynamically is problematic.
"--disable-dynamic-loading"
;; libid3tag and libmad provide no .pc files, so pkg-config fails to
;; find them. Force their inclusion.
(string-append "ID3TAG_CFLAGS=-I" libid3tag "/include")
(string-append "ID3TAG_LIBS=-L" libid3tag "/lib -lid3tag -lz")
(string-append "LIBMAD_CFLAGS=-I" libmad "/include")
(string-append "LIBMAD_LIBS=-L" libmad "/lib -lmad")))
;; The test suite is not "well exercised" according to the developers,
;; and fails with various errors. See
;; <http://sourceforge.net/p/audacity/mailman/message/33524292/>.
#:tests? #f))
(home-page "http://audacity.sourceforge.net/")
(synopsis "Software for recording and editing sounds")
(description
"Audacity is a multi-track audio editor designed for recording, playing
and editing digital audio. It features digital effects and spectrum analysis
tools.")
(license license:gpl2+)))
+202 -493
View File
File diff suppressed because it is too large Load Diff
+3 -4
View File
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,14 +30,14 @@
(define-public augeas
(package
(name "augeas")
(version "1.8.1")
(version "1.4.0")
(source (origin
(method url-fetch)
(uri (string-append "http://download.augeas.net/augeas-"
version ".tar.gz"))
(sha256
(base32
"1yf93fqwav1zsl8dpyfkf0g11w05mmfckqy6qsjy5zkklnspbkv5"))))
"0c2vncn0afmgwggnqa5s5z7m3zbcc66bi8v9m1h9w0i9q9xax7v5"))))
(build-system gnu-build-system)
;; Marked as "required" in augeas.pc
(propagated-inputs
+21 -77
View File
@@ -1,12 +1,10 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
;;; Copyright © 2014 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;; Copyright © 2015, 2017 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;; Copyright © 2017 ng0 <ng0@infotropique.org>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,7 +26,6 @@
#:use-module (gnu packages)
#:use-module (gnu packages perl)
#:use-module (gnu packages m4)
#:use-module (gnu packages man)
#:use-module (gnu packages bash)
#:use-module (guix utils)
#:use-module (guix packages)
@@ -93,35 +90,6 @@ know anything about Autoconf or M4.")
(base32
"0j3jdjpf5ly39dlp0bg70h72nzqr059k0x8iqxvaxf106chpgn9j"))))))
(define-public autoconf-2.13
;; GNU IceCat 52.x requires autoconf-2.13 to build!
(package (inherit autoconf)
(version "2.13")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/autoconf/autoconf-"
version ".tar.gz"))
(sha256
(base32
"07krzl4czczdsgzrrw9fiqx35xcf32naf751khg821g5pqv12qgh"))))
(arguments
`(#:tests? #f
#:phases
;; The 'configure' script in autoconf-2.13 can't cope with "SHELL=" and
;; "CONFIG_SHELL=" arguments, so we set them as environment variables
;; and pass a simplified set of arguments.
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key build inputs outputs #:allow-other-keys)
(let ((bash (which "bash"))
(out (assoc-ref outputs "out")))
(setenv "CONFIG_SHELL" bash)
(setenv "SHELL" bash)
(zero? (system* bash "./configure"
(string-append "--prefix=" out)
(string-append "--build=" build)))))))))))
(define* (autoconf-wrapper #:optional (autoconf autoconf))
"Return an wrapper around AUTOCONF that generates `configure' scripts that
@@ -195,7 +163,7 @@ exec ~a --no-auto-compile \"$0\" \"$@\"
(define-public autoconf-archive
(package
(name "autoconf-archive")
(version "2017.09.28")
(version "2016.09.16")
(source
(origin
(method url-fetch)
@@ -203,9 +171,9 @@ exec ~a --no-auto-compile \"$0\" \"$@\"
version ".tar.xz"))
(sha256
(base32
"00gsh9hkrgg291my98plkrwlcpxkfrpq64pglf18kciqbf2bb7sw"))))
"10mxz9hfnfz66m1l9s28sbyfb9a04akz92wkyv9blhpq6p9fzwp8"))))
(build-system gnu-build-system)
(home-page "https://www.gnu.org/software/autoconf-archive/")
(home-page "https://www.gnu.org/software/autoconf-archive")
(synopsis "Collection of freely reusable Autoconf macros")
(description
"Autoconf Archive is a collection of over 450 new macros for Autoconf,
@@ -238,7 +206,6 @@ output is indexed in many ways to simplify browsing.")
(license gpl3+)))
(define-public automake
;; Replace with 'automake/latest' on the next rebuild cycle.
(package
(name "automake")
(version "1.15")
@@ -308,7 +275,7 @@ output is indexed in many ways to simplify browsing.")
args)))))
(find-files dir ".*"))))
%standard-phases))))
(home-page "https://www.gnu.org/software/automake/")
(home-page "http://www.gnu.org/software/automake/")
(synopsis "Making GNU standards-compliant Makefiles")
(description
"Automake the part of the GNU build system for producing
@@ -317,22 +284,6 @@ intuitive format and then Automake works with Autoconf to produce a robust
Makefile, simplifying the entire process for the developer.")
(license gpl2+))) ; some files are under GPLv3+
(define-public automake/latest
;; Merge with 'automake' on the next rebuild cycle.
(package
(inherit automake)
(version "1.15.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/automake/automake-"
version ".tar.xz"))
(sha256
(base32
"1bzd9g32dfm4rsbw93ld9x7b5nc1y6i4m6zp032qf1i28a8s6sxg"))
(patches
(search-patches "automake-skip-amhello-tests.patch"))))))
(define-public libtool
(package
(name "libtool")
@@ -349,7 +300,6 @@ Makefile, simplifying the entire process for the developer.")
(propagated-inputs `(("m4" ,m4)))
(native-inputs `(("m4" ,m4)
("perl" ,perl)
("help2man" ,help2man) ;because we modify ltmain.sh
("automake" ,automake) ;some tests rely on 'aclocal'
("autoconf" ,(autoconf-wrapper)))) ;others on 'autom4te'
@@ -363,34 +313,28 @@ Makefile, simplifying the entire process for the developer.")
(or (%current-target-system)
(%current-system))))
#:phases
(modify-phases %standard-phases
(add-before 'check 'pre-check
(lambda* (#:key inputs #:allow-other-keys)
;; Run the test suite in parallel, if possible.
(setenv "TESTSUITEFLAGS"
(string-append
"-j"
(number->string (parallel-job-count))))
;; Patch references to /bin/sh.
(let ((bash (assoc-ref inputs "bash")))
(substitute* "tests/testsuite"
(("/bin/sh")
(string-append bash "/bin/sh")))
#t)))
(add-after 'patch-source-shebangs 'restore-ltmain-shebang
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "build-aux/ltmain.in"
(("^#!.*/bin/sh$") "#!/bin/sh"))
#t)))))
#:phases (alist-cons-before
'check 'pre-check
(lambda* (#:key inputs #:allow-other-keys)
;; Run the test suite in parallel, if possible.
(setenv "TESTSUITEFLAGS"
(string-append
"-j"
(number->string (parallel-job-count))))
;; Path references to /bin/sh.
(let ((bash (assoc-ref inputs "bash")))
(substitute* "tests/testsuite"
(("/bin/sh")
(string-append bash "/bin/bash")))))
%standard-phases)))
(synopsis "Generic shared library support tools")
(description
"GNU Libtool helps in the creation and use of shared libraries, by
presenting a single consistent, portable interface that hides the usual
complexity of working with shared libraries across platforms.")
(license gpl3+)
(home-page "https://www.gnu.org/software/libtool/")))
(home-page "http://www.gnu.org/software/libtool/")))
(define-public libltdl
;; This is a libltdl package separate from the libtool package. This is
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
+1 -3
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -25,7 +25,6 @@
#:use-module (gnu packages)
#:use-module (gnu packages databases)
#:use-module (gnu packages libdaemon)
#:use-module (gnu packages linux)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages glib)
#:use-module (gnu packages xml))
@@ -60,7 +59,6 @@
("glib" ,glib)
("dbus" ,dbus)
("gdbm" ,gdbm)
("libcap" ,libcap) ;to enable chroot support in avahi-daemon
("libdaemon" ,libdaemon)))
(native-inputs
`(("intltool" ,intltool)
+5 -5
View File
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2016 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
@@ -27,11 +27,11 @@
#:use-module (guix build-system gnu)
#:use-module (guix build-system trivial)
#:use-module (gnu packages)
#:use-module (gnu packages compression)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages flashing-tools)
#:use-module (gnu packages gcc)
#:use-module (gnu packages vim))
#:use-module (gnu packages vim)
#:use-module (gnu packages zip))
(define-public avr-binutils
(package
@@ -39,7 +39,7 @@
(name "avr-binutils")))
(define-public avr-gcc-4.9
(let ((xgcc (cross-gcc "avr" #:xgcc gcc-4.9 #:xbinutils avr-binutils)))
(let ((xgcc (cross-gcc "avr" avr-binutils)))
(package
(inherit xgcc)
(name "avr-gcc")
@@ -157,7 +157,7 @@ C++.")
(list (string-append "PREFIX=" (assoc-ref %outputs "out")))))
(native-inputs
`(("unzip" ,unzip)
("xxd" ,xxd)))
("vim" ,vim))) ; for xxd
(home-page "http://microscheme.org/")
(synopsis "Scheme subset for Atmel microcontrollers")
(description
-352
View File
@@ -1,352 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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 (gnu packages axoloti)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system gnu)
#:use-module (guix build-system ant)
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages compression)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages embedded)
#:use-module (gnu packages flashing-tools)
#:use-module (gnu packages java)
#:use-module (gnu packages libusb)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages textutils)
#:use-module (gnu packages version-control)
#:use-module (gnu packages xml))
(define libusb-for-axoloti
(package (inherit libusb)
(name "axoloti-libusb")
(version (package-version libusb))
(source
(origin
(inherit (package-source libusb))
(patches (list (search-patch "libusb-for-axoloti.patch")))))))
(define dfu-util-for-axoloti
(package (inherit dfu-util)
(name "axoloti-dfu-util")
(version "0.8")
(source
(origin
(method url-fetch)
(uri (string-append "http://dfu-util.sourceforge.net/releases/"
"dfu-util-" version ".tar.gz"))
(sha256
(base32
"0n7h08avlzin04j93m6hkq9id6hxjiiix7ff9gc2n89aw6dxxjsm"))))
(inputs
`(("libusb" ,libusb-for-axoloti)))))
(define-public axoloti-runtime
(package
(name "axoloti-runtime")
(version "1.0.12")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/axoloti/axoloti/"
"archive/" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1dynk6h0nixp4zihpirpqa4vi8fq1lhm443jsmvhk135ykhf364p"))
(modules '((guix build utils)))
(snippet
'(begin
;; Remove pre-built Java binaries.
(delete-file-recursively "lib/")
#t))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no check target
#:modules ((guix build gnu-build-system)
(guix build utils)
(srfi srfi-1)
(srfi srfi-26)
(ice-9 match)
(ice-9 regex))
#:imported-modules ((guix build syscalls)
,@%gnu-build-system-modules)
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-paths
(lambda* (#:key inputs #:allow-other-keys)
;; prepare ChibiOS
(and (zero? (system* "unzip" "-o" (assoc-ref inputs "chibios")))
(zero? (system* "mv" "ChibiOS_2.6.9" "chibios"))
(with-directory-excursion "chibios/ext"
(zero? (system* "unzip" "-o" "fatfs-0.9-patched.zip"))))
;; Remove source of non-determinism in ChibiOS
(substitute* "chibios/os/various/shell.c"
(("#ifdef __DATE__") "#if 0"))
;; Patch shell paths
(substitute* '("src/main/java/qcmds/QCmdCompileFirmware.java"
"src/main/java/qcmds/QCmdCompilePatch.java"
"src/main/java/qcmds/QCmdFlashDFU.java")
(("/bin/sh") (which "sh")))
;; Override cross compiler base name
(substitute* "firmware/Makefile.patch"
(("arm-none-eabi-(gcc|g\\+\\+|objcopy|objdump)" tool)
(which tool)))
;; Hardcode full path to compiler tools
(substitute* '("firmware/Makefile"
"firmware/flasher/Makefile"
"firmware/mounter/Makefile")
(("TRGT =.*")
(string-append "TRGT = "
(assoc-ref inputs "cross-toolchain")
"/bin/arm-none-eabi-\n")))
;; Hardcode path to "make"
(substitute* '("firmware/compile_firmware_linux.sh"
"firmware/compile_patch_linux.sh")
(("make") (which "make")))
;; Hardcode path to "dfu-util"
(substitute* "platform_linux/upload_fw_dfu.sh"
(("-f \"\\$\\{platformdir\\}/bin/dfu-util\"") "-z \"\"")
(("\\./dfu-util") (which "dfu-util")))
#t))
(delete 'configure)
(replace 'build
;; Build Axoloti firmware with cross-compiler
(lambda* (#:key inputs #:allow-other-keys)
(let* ((toolchain (assoc-ref inputs "cross-toolchain"))
(headers (string-append
toolchain
"/arm-none-eabi/include:"
toolchain
"/arm-none-eabi/include/arm-none-eabi/armv7e-m")))
(setenv "CROSS_CPATH" headers)
(setenv "CROSS_CPLUS_INCLUDE_PATH" headers)
(setenv "CROSS_LIBRARY_PATH"
(string-append toolchain
"/arm-none-eabi/lib")))
(with-directory-excursion "platform_linux"
(zero? (system* "sh" "compile_firmware.sh")))))
(replace 'install
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(share (string-append out "/share/axoloti/"))
(doc (string-append share "doc"))
(dir (getcwd))
(pats '("/doc/[^/]+$"
"/patches/[^/]+/[^/]+$"
"/objects/[^/]+/[^/]+$"
"/firmware/.+"
"/chibios/[^/]+$"
"/chibios/boards/ST_STM32F4_DISCOVERY/[^/]+$"
"/chibios/(ext|os|docs)/.+"
"/CMSIS/[^/]+/[^/]+$"
"/patch/[^/]+/[^/]+$"
"/[^/]+\\.txt$"))
(pattern (string-append
"(" (string-join
(map (cut string-append dir <>)
pats)
"|") ")"))
(files (find-files dir
(lambda (file stat)
(and (eq? 'regular (stat:type stat))
(string-match pattern file))))))
(for-each (lambda (file)
(install-file file
(string-append
share
(regexp-substitute
#f
(string-match dir (dirname file))
'pre 'post))))
files)
#t))))))
(inputs
`(("chibios"
,(origin
(method url-fetch)
(uri "mirror://sourceforge/chibios/ChibiOS_RT%20stable/Version%202.6.9/ChibiOS_2.6.9.zip")
(sha256
(base32
"0lb5s8pkj80mqhsy47mmq0lqk34s2a2m3xagzihalvabwd0frhlj"))))
;; for compiling patches
("make" ,gnu-make)
;; for compiling firmware
("cross-toolchain" ,arm-none-eabi-nano-toolchain-4.9)
;; for uploading compiled patches and firmware
("dfu-util" ,dfu-util-for-axoloti)))
(native-inputs
`(("unzip" ,unzip)))
(home-page "http://www.axoloti.com/")
(synopsis "Audio development environment for the Axoloti core board")
(description
"The Axoloti patcher offers a “patcher” environment similar to Pure Data
for sketching digital audio algorithms. The patches run on a standalone
powerful microcontroller board: Axoloti Core. This package provides the
runtime.")
(license license:gpl3+)))
(define-public axoloti-patcher
(package (inherit axoloti-runtime)
(name "axoloti-patcher")
(version (package-version axoloti-runtime))
(arguments
`(#:tests? #f ; no check target
#:modules ((guix build gnu-build-system)
((guix build ant-build-system) #:prefix ant:)
(guix build utils)
(srfi srfi-1)
(srfi srfi-26)
(ice-9 match)
(ice-9 regex)
(sxml simple)
(sxml xpath)
(sxml transform))
#:imported-modules ((guix build ant-build-system)
(guix build syscalls)
,@%gnu-build-system-modules)
#:phases
(modify-phases %standard-phases
(delete 'configure)
(replace 'build
(lambda* (#:key inputs #:allow-other-keys)
(setenv "JAVA_HOME" (assoc-ref inputs "icedtea"))
;; We want to use our own jar files instead of the pre-built
;; stuff in lib. So we replace the zipfileset tags in the
;; build.xml with new ones that reference our jars.
(let* ((build.xml (with-input-from-file "build.xml"
(lambda _
(xml->sxml #:trim-whitespace? #t))))
(jars (append-map (match-lambda
(((? (cut string-prefix? "java-" <>)
label) . directory)
(find-files directory "\\.jar$"))
(_ '()))
inputs))
(classpath (string-join jars ":"))
(fileset (map (lambda (jar)
`(zipfileset (@ (excludes "META-INF/*.SF")
(src ,jar))))
jars)))
(call-with-output-file "build.xml"
(lambda (port)
(sxml->xml
(pre-post-order
build.xml
`(;; Remove all zipfileset tags from the "jar" tree and
;; inject our own tags.
(jar . ,(lambda (tag . kids)
`(jar ,@(append-map
(filter (lambda (e)
(not (eq? 'zipfileset (car e)))))
kids)
,@fileset)))
;; Skip the "bundle" target (and the "-post-jar" target
;; that depends on it), because we don't need it and it
;; confuses sxml->xml.
(target . ,(lambda (tag . kids)
(let ((name ((sxpath '(name *text*))
(car kids))))
(if (or (member "bundle" name)
(member "-post-jar" name))
'() ; skip
`(,tag ,@kids)))))
(*default* . ,(lambda (tag . kids) `(,tag ,@kids)))
(*text* . ,(lambda (_ txt)
(match txt
;; Remove timestamp.
("${TODAY}" "(unknown)")
(_ txt))))))
port)))
;; Build it!
(zero? (system* "ant"
(string-append "-Djavac.classpath=" classpath)
"-Dbuild.runtime=true"
"-Dbuild.time=01/01/1970 00:00:00"
"-Djavac.source=1.7"
"-Djavac.target=1.7"
(string-append "-Dtag.short.version="
,version))))))
(replace 'install
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(share (string-append out "/share/axoloti/")))
(install-file "dist/Axoloti.jar" share)
;; We do this to ensure that this package retains references to
;; other Java packages' jar files.
(install-file "build.xml" share)
;; Create a launcher script
(mkdir (string-append out "/bin"))
(let ((target (string-append out "/bin/Axoloti")))
(with-output-to-file target
(lambda ()
(let* ((dir (string-append (assoc-ref outputs "out")
"/share/axoloti"))
(runtime (string-append (assoc-ref inputs "axoloti-runtime")
"/share/axoloti"))
(toolchain (assoc-ref inputs "cross-toolchain"))
(includes (string-append
toolchain
"/arm-none-eabi/include:"
toolchain
"/arm-none-eabi/include/arm-none-eabi/armv7e-m")))
(display
(string-append "#!" (which "sh") "\n"
"export CROSS_CPATH=" includes "\n"
"export CROSS_CPLUS_INCLUDE_PATH=" includes "\n"
"export CROSS_LIBRARY_PATH="
toolchain "/arm-none-eabi/lib" "\n"
(which "java")
" -Daxoloti_release=" runtime
" -Daxoloti_runtime=" runtime
" -jar " dir "/Axoloti.jar")))))
(chmod target #o555))
#t)))
(add-after 'install 'strip-jar-timestamps
(assoc-ref ant:%standard-phases 'strip-jar-timestamps)))))
(inputs
`(("icedtea" ,icedtea "jdk")
("cross-toolchain" ,arm-none-eabi-nano-toolchain-4.9)
("java-simple-xml" ,java-simple-xml)
("java-rsyntaxtextarea" ,java-rsyntaxtextarea)
("java-usb4java" ,java-usb4java)
("java-jsch" ,java-jsch)
("java-slf4j-api" ,java-slf4j-api)
("java-jgit" ,java-jgit-4.2)
("axoloti-runtime" ,axoloti-runtime)))
(native-inputs
`(("ant" ,ant)
("zip" ,zip) ; for repacking the jar
("unzip" ,unzip)))
(description
"The Axoloti patcher offers a “patcher” environment similar to Pure Data
for sketching digital audio algorithms. The patches run on a standalone
powerful microcontroller board: Axoloti Core. This package provides the
patcher application.")))
+64 -288
View File
@@ -1,12 +1,8 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
;;; Copyright © 2015, 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2015, 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2017 Kei Kebreau <kkebreau@posteo.net>
;;; Copyright © 2017 Christopher Allan Webber <cwebber@dustycloud.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,17 +24,16 @@
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix download)
#:use-module (guix utils)
#:use-module (guix build utils)
#:use-module (guix build-system gnu)
#:use-module (guix build-system python)
#:use-module (gnu packages)
#:use-module (gnu packages acl)
#:use-module (gnu packages autotools)
#:use-module (gnu packages base)
#:use-module (gnu packages check)
#:use-module (gnu packages compression)
#:use-module (gnu packages databases)
#:use-module (gnu packages dejagnu)
#:use-module (gnu packages ftp)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages gperf)
@@ -47,11 +42,8 @@
#:use-module (gnu packages mcrypt)
#:use-module (gnu packages nettle)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages python-crypto)
#:use-module (gnu packages python-web)
#:use-module (gnu packages rsync)
#:use-module (gnu packages ssh)
#:use-module (gnu packages tls)
@@ -60,7 +52,7 @@
(define-public duplicity
(package
(name "duplicity")
(version "0.7.12")
(version "0.6.26")
(source
(origin
(method url-fetch)
@@ -70,20 +62,18 @@
version ".tar.gz"))
(sha256
(base32
"1rhgrz2lm9vbfdp2raykrih1c6n2lw5jd572z4dsz488m52avjqi"))))
"0jh79syhr8n3l81jxlwsmwm1pklb4d923m2lgqbswyavh1fqmvwb"))
(patches (search-patches "duplicity-piped-password.patch"
"duplicity-test_selection-tmp.patch"))))
(build-system python-build-system)
(native-inputs
`(("util-linux" ,util-linux) ;setsid command, for the tests
("par2cmdline" ,par2cmdline)
("python-pexpect" ,python2-pexpect)
("mock" ,python2-mock)))
(propagated-inputs
`(("lockfile" ,python2-lockfile)
("urllib3" ,python2-urllib3)))
`(("util-linux" ,util-linux))) ;setsid command, for the tests
(inputs
`(("librsync" ,librsync)
("lftp" ,lftp)
("gnupg" ,gnupg) ;gpg executable needed
`(("python" ,python-2)
("librsync" ,librsync)
("mock" ,python2-mock) ;for testing
("lockfile" ,python2-lockfile)
("gnupg" ,gnupg-1) ;gpg executable needed
("util-linux" ,util-linux) ;for setsid
("tzdata" ,tzdata)))
(arguments
@@ -91,18 +81,10 @@
#:test-target "test"
#:phases
(modify-phases %standard-phases
(add-before 'build 'patch-source
(lambda* (#:key inputs #:allow-other-keys)
;; embed gpg store name
(substitute* "duplicity/gpginterface.py"
(("self.call = 'gpg'")
(string-append "self.call = '" (assoc-ref inputs "gnupg") "/bin/gpg'")))
(substitute* '("testing/functional/__init__.py"
"testing/overrides/bin/lftp")
(("/bin/sh") (which "sh")))
#t))
(add-before 'check 'check-setup
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "testing/functional/__init__.py"
(("/bin/sh") (which "sh")))
(setenv "HOME" (getcwd)) ;gpg needs to write to $HOME
(setenv "TZDIR" ;some timestamp checks need TZDIR
(string-append (assoc-ref inputs "tzdata")
@@ -122,7 +104,7 @@ spying and/or modification by the server.")
(define-public par2cmdline
(package
(name "par2cmdline")
(version "0.7.4")
(version "0.6.14")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/Parchive/par2cmdline/archive/v"
@@ -130,7 +112,15 @@ spying and/or modification by the server.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0iwwskiag3262mvhinvnbk6n0qh6sh56m86y4d0m285v0jl0y9pa"))))
"0ykfb7ar0x0flfdgf6i8xphyv5b93dalbjj2jb6hx7sdjax33n1g"))
;; This test merely needs a file to test recovery on, but
;; /dev/random is essentially /dev/urandom plus minimum entropy
;; locking, making the test hang indefinitely. This change is
;; already upstream: remove on upgrade to future 0.6.15.
;; https://github.com/Parchive/par2cmdline/commit/27723a678f780da82c79b98592592009c779a4fb
(modules '((guix build utils)))
(snippet
'(substitute* "tests/test20" (("if=/dev/random") "if=/dev/urandom")))))
(native-inputs
`(("automake" ,automake)
("autoconf" ,autoconf)))
@@ -140,15 +130,10 @@ spying and/or modification by the server.")
(modify-phases %standard-phases
(add-after 'unpack 'autoreconf
(lambda _ (zero? (system* "autoreconf" "-vfi")))))))
(synopsis "File verification and repair tools")
(description "Par2cmdline uses Reed-Solomon error-correcting codes to
generate and verify PAR2 recovery files. These files can be distributed
alongside the source files or stored together with back-ups to protect against
transmission errors or @dfn{bit rot}, the degradation of storage media over
time.
Unlike a simple checksum, PAR2 doesn't merely detect errors: as long as the
damage isn't too extensive (and smaller than the size of the recovery file), it
can even repair them.")
(synopsis "File verification and repair tool")
(description "Par2cmdline is a tool for generating RAID-like PAR2 recovery
files using Reed-Solomon coding. PAR2 files can be stored along side backups
or distributed files for recovering from bitrot.")
(home-page "https://github.com/Parchive/par2cmdline")
(license license:gpl3+)))
@@ -188,16 +173,20 @@ backups (called chunks) to allow easy burning to CD/DVD.")
(define-public libarchive
(package
(name "libarchive")
(replacement libarchive-3.3.2)
(version "3.3.1")
(version "3.2.1")
(source
(origin
(method url-fetch)
(uri (string-append "http://libarchive.org/downloads/libarchive-"
version ".tar.gz"))
(patches (search-patches
"libarchive-7zip-heap-overflow.patch"
"libarchive-fix-symlink-check.patch"
"libarchive-fix-filesystem-attacks.patch"
"libarchive-safe_fprintf-buffer-overflow.patch"))
(sha256
(base32
"1rr40hxlm9vy5z2zb5w7pyfkgd1a4s061qapm83s19accb8mpji9"))))
"1lngng84k1kkljl74q0cdqc3s82vn2kimfm02dgm4d6m7x71mvkj"))))
(build-system gnu-build-system)
;; TODO: Add -L/path/to/nettle in libarchive.pc.
(inputs
@@ -244,20 +233,6 @@ archive. In particular, note that there is currently no built-in support for
random access nor for in-place modification.")
(license license:bsd-2)))
(define libarchive-3.3.2
(package
(inherit libarchive)
(version "3.3.2")
(source
(origin
(method url-fetch)
(uri (string-append "http://libarchive.org/downloads/libarchive-"
version ".tar.gz"))
(patches (search-patches "libarchive-CVE-2017-14166.patch"))
(sha256
(base32
"1km0mzfl6in7l5vz9kl09a88ajx562rw93ng9h2jqavrailvsbgd"))))))
(define-public rdup
(package
(name "rdup")
@@ -297,20 +272,20 @@ random access nor for in-place modification.")
("nettle" ,nettle)))
(arguments
`(#:parallel-build? #f ;race conditions
#:phases
(modify-phases %standard-phases
(add-before 'build 'remove-Werror
;; rdup uses a deprecated function from libarchive
(lambda _
(substitute* "GNUmakefile"
(("^(CFLAGS=.*)-Werror" _ front) front))
#t))
(add-before 'check 'pre-check
(lambda _
(setenv "HOME" (getcwd))
(substitute* "testsuite/rdup/rdup.rdup-up-t-with-file.exp"
(("/bin/cat") (which "cat")))
#t)))))
#:phases (alist-cons-before
'build 'remove-Werror
;; rdup uses a deprecated function from libarchive
(lambda _
(substitute* "GNUmakefile"
(("^(CFLAGS=.*)-Werror" _ front) front)))
(alist-cons-before
'check 'pre-check
(lambda _
(setenv "HOME" (getcwd))
(substitute* "testsuite/rdup/rdup.rdup-up-t-with-file.exp"
(("/bin/cat") (which "cat"))))
%standard-phases))))
(home-page "http://archive.miek.nl/projects/rdup/index.html")
(synopsis "Provide a list of files to backup")
(description
@@ -340,9 +315,9 @@ list and implement the backup strategy.")
"CC=gcc")
#:tests? #f ;test input not distributed
#:phases
;; no configure phase
(modify-phases %standard-phases
(delete 'configure))))
(alist-delete
'configure ;no configure phase
%standard-phases)))
(home-page "http://viric.name/cgi-bin/btar/doc/trunk/doc/home.wiki")
(synopsis "Tar-compatible archiver")
(description
@@ -387,42 +362,6 @@ to a remote location, and only the differences will be transmitted. Finally,
rdiff-backup is easy to use and settings have sensible defaults.")
(license license:gpl2+)))
(define-public rsnapshot
(package
(name "rsnapshot")
(version "1.4.2")
(source
(origin
(method url-fetch)
(uri (string-append
"https://github.com/rsnapshot/rsnapshot/releases/download/"
version "/rsnapshot-" version ".tar.gz"))
(sha256
(base32
"05jfy99a0xs6lvsjfp3wz21z0myqhmwl2grn3jr9clijbg282ah4"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
(substitute* '("t/cmd-post_pre-exec/conf/pre-true-post-true.conf"
"t/backup_exec/conf/backup_exec_fail.conf"
"t/backup_exec/conf/backup_exec.conf")
(("/bin/true") (which "true"))
(("/bin/false") (which "false")))
(zero? (system* "make" "test")))))))
(inputs
`(("perl" ,perl)
("rsync" ,rsync)))
(home-page "http://rsnapshot.org")
(synopsis "Deduplicating snapshot backup utility based on rsync")
(description "rsnapshot is a filesystem snapshot utility based on rsync.
rsnapshot makes it easy to make periodic snapshots of local machines, and
remote machines over SSH. To reduce the disk space required for each backup,
rsnapshot uses hard links to deduplicate identical files.")
(license license:gpl2+)))
(define-public libchop
(package
(name "libchop")
@@ -466,13 +405,13 @@ detection, and lossless compression.")
(define-public borg
(package
(name "borg")
(version "1.1.3")
(version "1.0.9")
(source (origin
(method url-fetch)
(uri (pypi-uri "borgbackup" version))
(sha256
(base32
"1rvn8b6clzd1r317r9jkvk34r31risi0dxfjc7jffhnwasck4anc"))
"1ciwp9yilcibk0x82y5nn8ps95jrm8rxvff8mjrlp7a2w100i1im"))
(modules '((guix build utils)))
(snippet
'(for-each
@@ -509,7 +448,6 @@ detection, and lossless compression.")
(string-append
;; These tests need to write to '/var'.
"not test_get_cache_dir "
"and not test_get_config_dir "
"and not test_get_keys_dir "
"and not test_get_security_dir "
;; These tests assume there is a root user in
@@ -521,10 +459,9 @@ detection, and lossless compression.")
"and not benchmark "
;; These tests assume the kernel supports FUSE.
"and not test_fuse "
"and not test_fuse_allow_damaged_files "
"and not test_mount_hardlinks"))))))
"and not test_fuse_allow_damaged_files"))))))
(add-after 'install 'install-doc
(lambda* (#:key inputs outputs #:allow-other-keys)
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(man (string-append out "/share/man/man1"))
(misc (string-append out "/share/borg/misc")))
@@ -532,21 +469,21 @@ detection, and lossless compression.")
'("docs/misc/create_chunker-params.txt"
"docs/misc/internals-picture.txt"
"docs/misc/prune-example.txt"))
(add-installed-pythonpath inputs outputs)
(and
(zero? (system* "python3" "setup.py" "build_man"))
(zero? (system* "python3" "setup.py" "build_ext" "--inplace"))
(zero? (system* "make" "-C" "docs" "man"))
(begin
(copy-recursively "docs/man" man)
(install-file "docs/_build/man/borg.1" man)
#t))))))))
(native-inputs
`(("python-cython" ,python-cython)
("python-setuptools-scm" ,python-setuptools-scm)
;; Borg 1.0.8's test suite uses 'tmpdir_factory', which was introduced in
;; pytest 2.8.
("python-pytest" ,python-pytest-3.0)
("python-pytest" ,python-pytest-2.9.2)
;; For generating the documentation.
("python-sphinx" ,python-sphinx)
("python-guzzle-sphinx-theme" ,python-guzzle-sphinx-theme)))
("python-sphinx-rtd-theme" ,python-sphinx-rtd-theme)))
(inputs
`(("acl" ,acl)
("lz4" ,lz4)
@@ -560,7 +497,7 @@ provide an efficient and secure way to backup data. The data deduplication
technique used makes Borg suitable for daily backups since only changes are
stored. The authenticated encryption technique makes it suitable for backups
to not fully trusted targets. Borg is a fork of Attic.")
(home-page "https://www.borgbackup.org/")
(home-page "https://borgbackup.github.io/borgbackup/")
(license license:bsd-3)))
(define-public attic
@@ -612,14 +549,14 @@ changes are stored.")
(define-public wimlib
(package
(name "wimlib")
(version "1.12.0")
(version "1.10.0")
(source (origin
(method url-fetch)
(uri (string-append "https://wimlib.net/downloads/"
name "-" version ".tar.gz"))
(sha256
(base32
"0ks6hq7vwq13ljkzxp3a490bf8dnracgl2azf57rg49ad2fzab45"))))
"0mbz03smlc054i2m9q2sbqymml9m897kfs84q7g81i26y811p6wq"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
@@ -642,164 +579,3 @@ NTFS volumes using @code{ntfs-3g}, preserving NTFS-specific attributes.")
(license (list license:gpl3+
license:lgpl3+
license:cc0))))
(define-public obnam
(package
(name "obnam")
(version "1.21")
(source
(origin
(method url-fetch)
(uri (string-append
"http://code.liw.fi/debian/pool/main/o/obnam/obnam_"
version ".orig.tar.xz"))
(sha256
(base32
"0qlipsq50hca71zc0dp1mg9zs12qm0sbblw7qfzl0hj6mk2rv1by"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2
#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
(substitute* "obnamlib/vfs_local_tests.py"
;; Check for the nobody user instead of root
(("self.fs.get_username\\(0\\), 'root'")
"self.fs.get_username(65534), 'nobody'")
;; Disable tests checking for root group
(("self.fs.get_groupname\\(0\\)") "'root'"))
(substitute* "obnamlib/vfs_local.py"
;; Don't cover get_groupname function
(("def get_groupname\\(self, gid\\):")
"def get_groupname(self, gid): # pragma: no cover"))
;; Can't run network tests
(zero? (system* "./check" "--unit-tests")))))))
(inputs
`(("python2-cliapp" ,python2-cliapp)
("python2-larch" ,python2-larch)
("python2-paramiko" ,python2-paramiko)
("python2-pyaml" ,python2-pyaml)
("python2-tracing" ,python2-tracing)
("python2-ttystatus" ,python2-ttystatus)))
(native-inputs
`(("gnupg" ,gnupg)
("python2-coverage" ,python2-coverage)
("python2-coverage-test-runner" ,python2-coverage-test-runner)
("python2-pep8" ,python2-pep8)
("python2-pylint" ,python2-pylint)))
(home-page "https://obnam.org/")
(synopsis "Easy and secure backup program")
(description "Obnam is an easy, secure backup program. Features
include snapshot backups, data de-duplication and encrypted backups
using GnuPG. Backups can be stored on local hard disks, or online via
the SSH SFTP protocol. The backup server, if used, does not require
any special software, on top of SSH.")
(license license:gpl3+)))
(define-public dirvish
(package
(name "dirvish")
(version "1.2.1")
(build-system gnu-build-system)
(source (origin
(method url-fetch)
(uri (string-append
"http://dirvish.org/dirvish-" version ".tgz"))
(sha256
(base32
"1kbxa1irszp2zw8hd5qzqnrrzb4vxfivs1vn64yxnj0lak1jjzvb"))))
(arguments
`(#:modules ((ice-9 match) (ice-9 rdelim)
,@%gnu-build-system-modules)
#:phases
;; This mostly mirrors the steps taken in the install.sh that ships
;; with dirvish, but simplified because we aren't prompting interactively
(modify-phases %standard-phases
(delete 'configure)
(delete 'build)
(delete 'check)
(replace 'install
(lambda* (#:key inputs outputs #:allow-other-keys)
;; These are mostly the same steps the install.sh that comes with
;; dirvish does
(let* (;; Files we'll be copying
(executables
'("dirvish" "dirvish-runall"
"dirvish-expire" "dirvish-locate"))
(man-pages
'(("dirvish" "8") ("dirvish-runall" "8")
("dirvish-expire" "8") ("dirvish-locate" "8")
("dirvish.conf" "5")))
(output-dir
(assoc-ref outputs "out"))
;; Just a default... not so useful on guixsd though
;; You probably want to a service with file(s) to point to.
(confdir "/etc/dirvish")
(perl (string-append (assoc-ref %build-inputs "perl")
"/bin/perl"))
(loadconfig.pl (call-with-input-file "loadconfig.pl"
read-string)))
(define (write-pl filename)
(define pl-header
(string-append "#!" perl "\n\n"
"$CONFDIR = \"" confdir "\";\n\n"))
(define input-file-location
(string-append filename ".pl"))
(define target-file-location
(string-append output-dir "/bin/" filename ".pl"))
(define text-to-write
(string-append pl-header
(call-with-input-file input-file-location
read-string)
"\n" loadconfig.pl))
(with-output-to-file target-file-location
(lambda ()
(display text-to-write)))
(chmod target-file-location #o755)
(wrap-program target-file-location
`("PERL5LIB" ":" prefix
,(map (lambda (l) (string-append (assoc-ref %build-inputs l)
"/lib/perl5/site_perl"))
'("perl-libtime-period"
"perl-libtime-parsedate")))))
(define write-man
(match-lambda
((file-base man-num)
(let* ((filename
(string-append file-base "." man-num))
(output-path
(string-append output-dir
"/share/man/man" man-num
"/" filename)))
(copy-file filename output-path)))))
;; Make directories
(mkdir-p (string-append output-dir "/bin/"))
(mkdir-p (string-append output-dir "/share/man/man8/"))
(mkdir-p (string-append output-dir "/share/man/man5/"))
;; Write out executables
(for-each write-pl executables)
;; Write out man pages
(for-each write-man man-pages)
#t))))))
(inputs
`(("perl" ,perl)
("rsync" ,rsync)
("perl-libtime-period" ,perl-libtime-period)
("perl-libtime-parsedate" ,perl-libtime-parsedate)))
(home-page "http://dirvish.org/")
(synopsis "Fast, disk based, rotating network backup system")
(description
"With dirvish you can maintain a set of complete images of your
filesystems with unattended creation and expiration. A dirvish backup vault
is like a time machine for your data. ")
(license (license:fsf-free "file://COPYING"
"Open Software License 2.0"))))
+103 -208
View File
@@ -1,15 +1,12 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;; Copyright © 2014, 2015 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017 Rene Saavedra <rennes@openmailbox.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -75,22 +72,21 @@
"GNU Hello prints the message \"Hello, world!\" and then exits. It
serves as an example of standard GNU coding practices. As such, it supports
command-line arguments, multiple languages, and so on.")
(home-page "https://www.gnu.org/software/hello/")
(home-page "http://www.gnu.org/software/hello/")
(license gpl3+)))
(define-public grep
(package
(name "grep")
(version "3.0")
(version "2.25")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/grep/grep-"
version ".tar.xz"))
(sha256
(base32
"1dcasjp3a578nrvzrcn38mpizb8w1q6mvfzhjmcqqgkf0nsivj72"))
(patches (search-patches "grep-timing-sensitive-test.patch"
"grep-gnulib-lock.patch"))))
"0c38b67cnwchwzv4wq2gpz6smkhdxrac2hhssv8f0l04qnx867p2"))
(patches (search-patches "grep-timing-sensitive-test.patch"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl))) ;some of the tests require it
(arguments
@@ -117,41 +113,35 @@ however the output can be greatly customized to include, for example, line
numbers. GNU grep offers many extensions over the standard utility,
including, for example, recursive directory searching.")
(license gpl3+)
(home-page "https://www.gnu.org/software/grep/")))
(home-page "http://www.gnu.org/software/grep/")))
(define-public sed
(package
(name "sed")
(version "4.4")
(version "4.2.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/sed/sed-" version
".tar.xz"))
".tar.bz2"))
(sha256
(base32
"0fv88bcnraixc8jvpacvxshi30p5x9m7yb8ns1hfv07hmb2ypmnb"))))
"1myvrmh99jsvk7v3d7crm0gcrq51hmmm1r2kjyyci152in1x2j7h"))
(patches (search-patches "sed-hurd-path-max.patch"))))
(build-system gnu-build-system)
(synopsis "Stream editor")
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'dont-rebuild-sed.1
(lambda _
;; Make sure we do not attempt to rebuild 'doc/sed.1', which does
;; not work when cross-compiling because we cannot run 'sed'.
;; This is fixed upstream as commit a0a25e3.
(substitute* "Makefile.in"
(("^doc/sed\\.1:.*")
"doc/sed.1:\n"))
#t))
(add-before 'patch-source-shebangs 'patch-test-suite
(lambda* (#:key inputs #:allow-other-keys)
(patch-makefile-SHELL "testsuite/Makefile.tests")
(substitute* '("testsuite/bsd.sh"
"testsuite/bug-regex9.c")
(("/bin/sh")
(which "sh")))
#t)))))
(if (%current-target-system)
'()
`(#:phases (alist-cons-before
'patch-source-shebangs 'patch-test-suite
(lambda* (#:key inputs #:allow-other-keys)
(let ((bash (assoc-ref inputs "bash")))
(patch-makefile-SHELL "testsuite/Makefile.tests")
(substitute* '("testsuite/bsd.sh"
"testsuite/bug-regex9.c")
(("/bin/sh")
(string-append bash "/bin/bash")))))
%standard-phases))))
(description
"Sed is a non-interactive, text stream editor. It receives a text
input from a file or from standard input and it then applies a series of text
@@ -159,7 +149,7 @@ editing commands to the stream and prints its output to standard output. It
is often used for substituting text patterns in a stream. The GNU
implementation offers several extensions over the standard utility.")
(license gpl3+)
(home-page "https://www.gnu.org/software/sed/")))
(home-page "http://www.gnu.org/software/sed/")))
(define-public tar
(package
@@ -172,8 +162,7 @@ implementation offers several extensions over the standard utility.")
(sha256
(base32
"097hx7sbzp8qirl4m930lw84kn0wmxhmq7v1qpra3mrg0b8cyba0"))
(patches (search-patches "tar-CVE-2016-6321.patch"
"tar-skip-unreliable-tests.patch"))))
(patches (search-patches "tar-skip-unreliable-tests.patch"))))
(build-system gnu-build-system)
;; Note: test suite requires ~1GiB of disk space.
(arguments
@@ -202,7 +191,7 @@ directory structure and file information such as permissions and
creation/modification dates. GNU tar offers many extensions over the
standard utility.")
(license gpl3+)
(home-page "https://www.gnu.org/software/tar/")))
(home-page "http://www.gnu.org/software/tar/")))
(define-public patch
(package
@@ -226,19 +215,19 @@ files depending on the contents of the diff file. It accepts several
different diff formats. It may also be used to revert previously applied
differences.")
(license gpl3+)
(home-page "https://savannah.gnu.org/projects/patch/")))
(home-page "http://savannah.gnu.org/projects/patch/")))
(define-public diffutils
(package
(name "diffutils")
(version "3.6")
(version "3.5")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/diffutils/diffutils-"
version ".tar.xz"))
(sha256
(base32
"1mivg0fy3a6fcn535ln8nkgfj6vxh5hsxxs5h6692wxmsjyyh8fn"))))
"0csmqfz8ks23kdjsq0v2ll1acqiz8lva06dj19mwmymrsp69ilys"))))
(build-system gnu-build-system)
(synopsis "Comparing and merging files")
(description
@@ -248,7 +237,7 @@ differ, while \"cmp\" shows the offsets and line numbers where they differ.
\"diff3\" allows you to compare three files. Finally, \"sdiff\" offers an
interactive means to merge two files.")
(license gpl3+)
(home-page "https://www.gnu.org/software/diffutils/")))
(home-page "http://www.gnu.org/software/diffutils/")))
(define-public findutils
(package
@@ -261,13 +250,8 @@ interactive means to merge two files.")
(sha256
(base32
"178nn4dl7wbcw499czikirnkniwnx36argdnqgz4ik9i6zvwkm6y"))
(patches (search-patches
"findutils-localstatedir.patch"
"findutils-test-xargs.patch"
;; test-lock has performance issues on multi-core
;; machines, it hangs or takes a long time to complete.
;; This is a commit from gnulib to fix this issue.
"findutils-gnulib-multi-core.patch"))))
(patches (search-patches "findutils-localstatedir.patch"
"findutils-test-xargs.patch"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags (list
@@ -288,20 +272,19 @@ recursively searches for files in a directory according to given criteria and
are included: \"updatedb\" updates the file name database and \"xargs\" may be
used to apply commands with arbitrarily long arguments.")
(license gpl3+)
(home-page "https://www.gnu.org/software/findutils/")))
(home-page "http://www.gnu.org/software/findutils/")))
(define-public coreutils
(package
(name "coreutils")
(version "8.27")
(version "8.25")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/coreutils/coreutils-"
version ".tar.xz"))
(sha256
(base32
"0sv547572iq8ayy8klir4hnngnx92a9nsazmf1wgzfc7xr4x74c8"))
(patches (search-patches "coreutils-cut-huge-range-test.patch"))))
"11yfrnb94xzmvi4lhclkcmkqsbhww64wf234ya1aacjvg82prrii"))))
(build-system gnu-build-system)
(inputs `(("acl" ,acl) ; TODO: add SELinux
("gmp" ,gmp) ;bignums in 'expr', yay!
@@ -344,7 +327,7 @@ expected in a POSIX system. These provide the basic file, shell and text
manipulation functions of the GNU system. Most of these tools offer extended
functionality beyond that which is outlined in the POSIX standard.")
(license gpl3+)
(home-page "https://www.gnu.org/software/coreutils/")))
(home-page "http://www.gnu.org/software/coreutils/")))
(define-public coreutils-minimal
;; Coreutils without its optional dependencies.
@@ -379,7 +362,7 @@ functionality beyond that which is outlined in the POSIX standard.")
(let ((bash (assoc-ref inputs "bash")))
(substitute* "job.c"
(("default_shell =.*$")
(format #f "default_shell = \"~a/bin/sh\";\n"
(format #f "default_shell = \"~a/bin/bash\";\n"
bash)))))))))
(synopsis "Remake files automatically")
(description
@@ -390,22 +373,22 @@ generated from its source. It has powerful dependency resolution and the
ability to determine when files have to be regenerated after their sources
change. GNU make offers many powerful extensions over the standard utility.")
(license gpl3+)
(home-page "https://www.gnu.org/software/make/")))
(home-page "http://www.gnu.org/software/make/")))
(define-public binutils
(package
(replacement binutils/fixed)
(name "binutils")
(version "2.28")
(version "2.27")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/binutils/binutils-"
version ".tar.bz2"))
(sha256
(base32
"0wiasgns7i8km8nrxas265sh2dfpsw93b3qw195ipc90w4z475v2"))
"125clslv17xh1sab74343fg6v31msavpmaa1c1394zsqa773g5rn"))
(patches (search-patches "binutils-ld-new-dtags.patch"
"binutils-loongson-workaround.patch"))))
"binutils-loongson-workaround.patch"
"binutils-mips-bash-bug.patch"))))
(build-system gnu-build-system)
;; TODO: Add dependency on zlib + those for Gold.
@@ -417,6 +400,10 @@ change. GNU make offers many powerful extensions over the standard utility.")
;; Don't search under /usr/lib & co.
"--with-lib-path=/no-ld-lib-path"
;; Glibc 2.17 has a "comparison of unsigned
;; expression >= 0 is always true" in wchar.h.
"--disable-werror"
;; Install BFD. It ends up in a hidden directory,
;; but it's here.
"--enable-install-libbfd"
@@ -434,25 +421,12 @@ the strings in a binary file, and utilities for working with archives. The
\"bfd\" library for working with executable and object formats is also
included.")
(license gpl3+)
(home-page "https://www.gnu.org/software/binutils/")))
(define binutils/fixed
(package
(inherit binutils)
;; 2.28.1 is two characters longer than 2.28, so grafting fails due to
;; mismatched lengths of filenames, so we have to force it to the same length.
(version "2281")
(source
(origin (inherit (package-source binutils))
(uri "mirror://gnu/binutils/binutils-2.28.1.tar.bz2")
(sha256
(base32
"1sj234nd05cdgga1r36zalvvdkvpfbr12g5mir2n8i1dwsdrj939"))))))
(home-page "http://www.gnu.org/software/binutils/")))
(define* (make-ld-wrapper name #:key
(target (const #f))
binutils
(guile (canonical-package guile-2.2))
(guile (canonical-package guile-2.0))
(bash (canonical-package bash))
(guile-for-build guile))
"Return a package called NAME that contains a wrapper for the 'ld' program
@@ -519,7 +493,7 @@ wrapper for the cross-linker for that target, called 'TARGET-ld'."
"The linker wrapper (or 'ld-wrapper') wraps the linker to add any
missing '-rpath' flags, and to detect any misuse of libraries outside of the
store.")
(home-page "https://www.gnu.org/software/guix//")
(home-page "http://www.gnu.org/software/guix/")
(license gpl3+)))
(export make-ld-wrapper)
@@ -527,15 +501,14 @@ store.")
(define-public glibc/linux
(package
(name "glibc")
(version "2.25")
(replacement glibc/fixed)
(version "2.24")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/glibc/glibc-"
version ".tar.xz"))
(sha256
(base32
"1813dzkgw6v8q8q1m4v96yfis7vjqc9pslqib6j9mrwh6fxxjyq6"))
"1lxmprg9gm73gvafxd503x70z32phwjzcy74i0adfi6ixzla7m4r"))
(snippet
;; Disable 'ldconfig' and /etc/ld.so.cache. The latter is
;; required on LFS distros to avoid loading the distro's libc.so
@@ -546,12 +519,7 @@ store.")
(modules '((guix build utils)))
(patches (search-patches "glibc-ldd-x86_64.patch"
"glibc-versioned-locpath.patch"
"glibc-o-largefile.patch"
"glibc-memchr-overflow-i686.patch"
"glibc-vectorized-strcspn-guards.patch"
"glibc-CVE-2017-1000366-pt1.patch"
"glibc-CVE-2017-1000366-pt2.patch"
"glibc-CVE-2017-1000366-pt3.patch"))))
"glibc-o-largefile.patch"))))
(build-system gnu-build-system)
;; Glibc's <limits.h> refers to <linux/limit.h>, for instance, so glibc
@@ -563,6 +531,10 @@ store.")
(arguments
`(#:out-of-source? #t
;; In version 2.21, there a race in the 'elf' directory, see
;; <http://lists.gnu.org/archive/html/guix-devel/2015-02/msg00709.html>.
#:parallel-build? #f
;; The libraries have an empty RUNPATH, but some, such as the versioned
;; libraries (libdl-2.24.so, etc.) have ld.so marked as NEEDED. Since
;; these libraries are always going to be found anyway, just skip
@@ -647,14 +619,14 @@ store.")
;; Same for `popen'.
(substitute* "libio/iopopen.c"
(("/bin/sh")
(string-append bash "/bin/sh")))
(string-append bash "/bin/bash")))
;; Same for the shell used by the 'exec' functions for
;; scripts that lack a shebang.
(substitute* (find-files "." "^paths\\.h$")
(("#define[[:blank:]]+_PATH_BSHELL[[:blank:]].*$")
(string-append "#define _PATH_BSHELL \""
bash "/bin/sh\"\n")))
bash "/bin/bash\"\n")))
;; Nscd uses __DATE__ and __TIME__ to create a string to
;; make sure the client and server come from the same
@@ -701,7 +673,7 @@ printf, exit...
The GNU C library is used as the C library in the GNU system and most systems
with the Linux kernel.")
(license lgpl2.0+)
(home-page "https://www.gnu.org/software/libc/")))
(home-page "http://www.gnu.org/software/libc/")))
(define-public glibc/hurd
;; The Hurd's libc variant.
@@ -729,33 +701,21 @@ with the Linux kernel.")
((#:phases original-phases)
;; Add libmachuser.so and libhurduser.so to libc.so's search path.
;; See <http://lists.gnu.org/archive/html/bug-hurd/2015-07/msg00051.html>.
`(modify-phases ,original-phases
(add-after 'install 'augment-libc.so
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")))
(substitute* (string-append out "/lib/libc.so")
(("/[^ ]+/lib/libc.so.0.3")
(string-append out "/lib/libc.so.0.3" " libmachuser.so" " libhurduser.so"))))
#t))
(add-after 'pre-configure 'pre-configure-set-pwd
(lambda _
;; Use the right 'pwd'.
(substitute* "configure"
(("/bin/pwd") "pwd"))
#t))
(replace 'build
(lambda _
;; Force mach/hurd/libpthread subdirs to build first in order to avoid
;; linking errors.
;; See <https://lists.gnu.org/archive/html/bug-hurd/2016-11/msg00045.html>
(let ((-j (list "-j" (number->string (parallel-job-count)))))
(let-syntax ((make (syntax-rules ()
((_ target)
(zero? (apply system* "make" target -j))))))
(and (make "mach/subdir_lib")
(make "hurd/subdir_lib")
(make "libpthread/subdir_lib")
(zero? (apply system* "make" -j)))))))))
`(alist-cons-after
'install 'augment-libc.so
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")))
(substitute* (string-append out "/lib/libc.so")
(("/[^ ]+/lib/libc.so.0.3")
(string-append out "/lib/libc.so.0.3" " libmachuser.so" " libhurduser.so"))))
#t)
(alist-cons-after
'pre-configure 'pre-configure-set-pwd
(lambda _
;; Use the right 'pwd'.
(substitute* "configure"
(("/bin/pwd") "pwd")))
,original-phases)))
((#:configure-flags original-configure-flags)
`(append (list "--host=i586-pc-gnu"
@@ -787,39 +747,9 @@ GLIBC/HURD for a Hurd host"
(define-syntax glibc
(identifier-syntax (glibc-for-target)))
(define glibc/fixed
(package
(inherit glibc)
(source (origin
(inherit (package-source glibc))
(patches (append
(origin-patches (package-source glibc))
(search-patches "glibc-CVE-2017-15670-15671.patch")))))))
;; Below are old libc versions, which we use mostly to build locale data in
;; the old format (which the new libc cannot cope with.)
(define-public glibc-2.24
(package
(inherit glibc)
(version "2.24")
(source (origin
(inherit (package-source glibc))
(uri (string-append "mirror://gnu/glibc/glibc-"
version ".tar.xz"))
(sha256
(base32
"1lxmprg9gm73gvafxd503x70z32phwjzcy74i0adfi6ixzla7m4r"))
(patches (search-patches "glibc-ldd-x86_64.patch"
"glibc-versioned-locpath.patch"
"glibc-o-largefile.patch"
"glibc-vectorized-strcspn-guards.patch"
"glibc-CVE-2015-5180.patch"
"glibc-CVE-2017-15670-15671.patch"
"glibc-CVE-2017-1000366-pt1.patch"
"glibc-CVE-2017-1000366-pt2.patch"
"glibc-CVE-2017-1000366-pt3.patch"))))))
(define-public glibc-2.23
(package
(inherit glibc)
@@ -830,19 +760,7 @@ GLIBC/HURD for a Hurd host"
version ".tar.xz"))
(sha256
(base32
"1s8krs3y2n6pzav7ic59dz41alqalphv7vww4138ag30wh0fpvwl"))
(patches (search-patches "glibc-ldd-x86_64.patch"
"glibc-versioned-locpath.patch"
"glibc-o-largefile.patch"
"glibc-vectorized-strcspn-guards.patch"
"glibc-CVE-2015-5180.patch"
"glibc-CVE-2016-3075.patch"
"glibc-CVE-2016-3706.patch"
"glibc-CVE-2016-4429.patch"
"glibc-CVE-2017-15670-15671.patch"
"glibc-CVE-2017-1000366-pt1.patch"
"glibc-CVE-2017-1000366-pt2.patch"
"glibc-CVE-2017-1000366-pt3.patch"))))))
"1s8krs3y2n6pzav7ic59dz41alqalphv7vww4138ag30wh0fpvwl"))))))
(define-public glibc-2.22
(package
@@ -855,27 +773,29 @@ GLIBC/HURD for a Hurd host"
(sha256
(base32
"0j49682pm2nh4qbdw35bas82p1pgfnz4d2l7iwfyzvrvj0318wzb"))
(patches (search-patches "glibc-ldd-x86_64.patch"
"glibc-vectorized-strcspn-guards.patch"
"glibc-CVE-2015-5180.patch"
"glibc-CVE-2015-7547.patch"
"glibc-CVE-2016-3075.patch"
"glibc-CVE-2016-3706.patch"
"glibc-CVE-2016-4429.patch"
"glibc-CVE-2017-15670-15671.patch"
"glibc-CVE-2017-1000366-pt1.patch"
"glibc-CVE-2017-1000366-pt2.patch"
"glibc-CVE-2017-1000366-pt3.patch"))))
(patches (search-patches "glibc-ldd-x86_64.patch"))))
(arguments
(substitute-keyword-arguments (package-arguments glibc)
((#:phases phases)
`(modify-phases ,phases
(add-before 'configure 'fix-pwd
(lambda _
;; Use `pwd' instead of `/bin/pwd' for glibc-2.22.
;; Use `pwd' instead of `/bin/pwd' for glibc-2.21
(substitute* "configure"
(("/bin/pwd") "pwd"))
#t))))))))
(("/bin/pwd") "pwd"))))))))))
(define-public glibc-2.21
(package
(inherit glibc-2.22)
(version "2.21")
(source (origin
(inherit (package-source glibc))
(uri (string-append "mirror://gnu/glibc/glibc-"
version ".tar.xz"))
(sha256
(base32
"1f135546j34s9bfkydmx2nhh9vwxlx60jldi80zmsnln6wj3dsxf"))
(patches (search-patches "glibc-ldd-x86_64.patch"))))))
(define-public glibc-locales
(package
@@ -896,12 +816,12 @@ the 'share/locale' sub-directory of this package.")
,@(package-arguments glibc))))
(substitute-keyword-arguments args
((#:phases phases)
`(modify-phases ,phases
(replace 'build
(lambda _
(zero? (system* "make" "localedata/install-locales"
"-j" (number->string (parallel-job-count))))))
(delete 'install)))
`(alist-replace
'build
(lambda* (#:key outputs #:allow-other-keys)
(zero? (system* "make" "localedata/install-locales"
"-j" (number->string (parallel-job-count)))))
(alist-delete 'install ,phases)))
((#:configure-flags flags)
`(append ,flags
;; Use $(libdir)/locale/X.Y as is the case by default.
@@ -1023,7 +943,7 @@ command.")
(define-public tzdata
(package
(name "tzdata")
(version "2017b")
(version "2016j")
(source (origin
(method url-fetch)
(uri (string-append
@@ -1031,7 +951,7 @@ command.")
version ".tar.gz"))
(sha256
(base32
"11l0s43vx33dcs78p80122i8s5s9l1sjwkzzwh66njd35r92l97q"))))
"1j4xycpwhs57qnkcxwh3np8wnf3km69n3cf4w6p2yv2z247lxvpm"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f
@@ -1079,7 +999,7 @@ command.")
version ".tar.gz"))
(sha256
(base32
"0h1d567gn8l3iqgyadcswwdy2yh07nhz3lfl8ds8saz2ajxka5sd"))))))
"1dxhrk4z0n2di8p0yd6q00pa6bwyz5xqbrfbasiz8785ni7zrvxr"))))))
(home-page "https://www.iana.org/time-zones")
(synopsis "Database of current and historical time zones")
(description "The Time Zone Database (often called tz or zoneinfo)
@@ -1089,42 +1009,17 @@ reflect changes made by political bodies to time zone boundaries, UTC offsets,
and daylight-saving rules.")
(license public-domain)))
;;; A "fixed" version of tzdata, which is used in the test suites of
;;; glib and R. We can update this whenever we are able to rebuild
;;; thousands of packages (for example, in a core-updates rebuild).
(define-public tzdata-2017a
(package
(inherit tzdata)
(version "2017a")
(source
(origin
(method url-fetch)
(uri (string-append "https://www.iana.org/time-zones/repository"
"/releases/tzdata" version ".tar.gz"))
(sha256
(base32
"1mmv4rvcs12lrvgghw4fidczvb69yv69cmzknghcvw1c196mqfnz"))))
(inputs `(("tzcode" ,(origin
(method url-fetch)
(uri (string-append
"http://www.iana.org/time-zones/repository/releases/tzcode"
version ".tar.gz"))
(sha256
(base32
"1b1q7gnlsh5hjgs5065pvajd37rmbc3k9b8cgzad1vcrifswdwh2"))))))))
(define-public libiconv
(package
(name "libiconv")
(version "1.15")
(version "1.14")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/libiconv/libiconv-"
version ".tar.gz"))
(sha256
(base32
"0y1ij745r4p48mxq84rax40p10ln7fc7m243p8k8sia519i3dxfc"))
"04q6lgl3kglmmhw59igq1n7v3rp1rpkypl366cy1k1yn2znlvckj"))
(modules '((guix build utils)))
(snippet
;; Work around "declared gets" error on glibc systems (fixed by
@@ -1138,7 +1033,7 @@ and daylight-saving rules.")
"libiconv provides an implementation of the iconv function for systems
that lack it. iconv is used to convert between character encodings in a
program. It supports a wide variety of different encodings.")
(home-page "https://www.gnu.org/software/libiconv/")
(home-page "http://www.gnu.org/software/libiconv/")
(license lgpl3+)))
(define* (libiconv-if-needed #:optional (target (%current-target-system)))
+31 -56
View File
@@ -1,8 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2015 Leo Famulari <leo@famulari.name>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,7 +21,6 @@
(define-module (gnu packages bash)
#:use-module (guix licenses)
#:use-module (gnu packages)
#:use-module (gnu packages bootstrap)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages readline)
#:use-module (gnu packages bison)
@@ -30,9 +28,6 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix utils)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix build-system gnu)
#:autoload (guix gnupg) (gnupg-verify*)
#:autoload (guix hash) (port-sha256)
@@ -43,7 +38,7 @@
(define (patch-url seqno)
"Return the URL of Bash patch number SEQNO."
(format #f "mirror://gnu/bash/bash-4.4-patches/bash44-~3,'0d" seqno))
(format #f "mirror://gnu/bash/bash-4.3-patches/bash43-~3,'0d" seqno))
(define (bash-patch seqno sha256)
"Return the origin of Bash patch SEQNO, with expected hash SHA256"
@@ -59,19 +54,7 @@
(define %patch-series-4.4
;; This is the current patches series for 4.4, generated using
;; 'download-patches' below.
(patch-series
(1 "03vzy7qwjdd5qvl3ydg99naazas2qmyd0yhnrflgjbbm64axja1y")
(2 "0lrwq6vyqism3yqv9s7kzaf3dsl4q5w9r5svcqz279qp7qca083h")
(3 "1chqww2rj6g42b8s60q5zlzy0jzp684jkpsbrbfy1vzxja8mmpsi")
(4 "1cy8abf96hkrjhw921ndr0shlcnc52bg45rn6xri4v5clhq0l25d")
(5 "0a8515kyk4zsgmvlqvlganjfr7pq0j6kzpr4d6xx02kpbdr4n7i2")
(6 "1f24wgqngmj2mrj9yibwvc2zvlmn5xi53mnw777g3l40c4m2x3ka")
(7 "1bzdsnqaf05gdbqpsixhan8vygjxpcxlz1dd8d9f5jdznw3wq76y") ;CVE-2017-5932
(8 "1firw915mjm03hbbw9a70ch3cpgrgnvqjpllgdnn6csr8q04f546")
(9 "0g1l56kvw61rpw7dqa9fcl9llkl693h73g631hrhxlm030ddssqb")
(10 "01lfhrkdsdkdz8ypzapr614ras23x7ckjnr60aa5bzkaqprccrc4")
(11 "038p7mhnq9m65g505hi3827jkf9f35nd1cy00w8mwafpyxp44mnx")
(12 "0gh6lbb1rwpk44pvbamm6vzdfi50xnwkqd9v7s8cjwk3pz973hps")))
(patch-series))
(define (download-patches store count)
"Download COUNT Bash patches into store. Return a list of
@@ -176,13 +159,6 @@ number/base32-hash tuples, directly usable in the 'patch-series' form."
(rename-file (string-append out "/lib/pkgconfig")
(string-append include
"/lib/pkgconfig"))
;; Don't capture the absolute file name of 'install' to avoid
;; retaining a dependency on Coreutils.
(substitute* (string-append (lib include)
"/Makefile.inc")
(("^INSTALL =.*")
"INSTALL = install -c\n"))
#t))))))
(native-search-paths
@@ -199,7 +175,7 @@ allows command-line editing, unlimited command history, shell functions and
aliases, and job control while still allowing most sh scripts to be run
without modification.")
(license gpl3+)
(home-page "https://www.gnu.org/software/bash/"))))
(home-page "http://www.gnu.org/software/bash/"))))
(define-public bash-minimal
;; A stripped-down Bash for non-interactive use.
@@ -211,33 +187,32 @@ without modification.")
(outputs (delete "include" (package-outputs bash)))
(arguments
(substitute-keyword-arguments (package-arguments bash)
((#:modules _ '())
'((guix build gnu-build-system)
(guix build utils)
(srfi srfi-1)
(srfi srfi-26)))
((#:configure-flags flags '())
`(list "--without-bash-malloc"
"--disable-readline"
"--disable-history"
"--disable-help-builtin"
"--disable-progcomp"
"--disable-net-redirections"
"--disable-nls"
(let ((args `(#:modules ((guix build gnu-build-system)
(guix build utils)
(srfi srfi-1)
(srfi srfi-26))
,@(package-arguments bash))))
(substitute-keyword-arguments args
((#:configure-flags flags)
`(list "--without-bash-malloc"
"--disable-readline"
"--disable-history"
"--disable-help-builtin"
"--disable-progcomp"
"--disable-net-redirections"
"--disable-nls"
;; Pretend 'dlopen' is missing so we don't build loadable
;; modules and related code.
"ac_cv_func_dlopen=no"
;; Pretend 'dlopen' is missing so we don't build loadable
;; modules and related code.
"ac_cv_func_dlopen=no"
,@(if (%current-target-system)
'("bash_cv_job_control_missing=no"
"bash_cv_getcwd_malloc=yes")
'())))
((#:phases phases)
`(modify-phases ,phases
;; No loadable modules.
(delete 'move-development-files)))))))
,@(if (%current-target-system)
'("bash_cv_job_control_missing=no")
'())))
((#:phases phases)
`(modify-phases ,phases
;; No loadable modules.
(delete 'move-development-files))))))))
(define-public static-bash
;; Statically-linked Bash that contains nothing but the 'bash' binary and
@@ -263,7 +238,7 @@ without modification.")
(define-public bash-completion
(package
(name "bash-completion")
(version "2.7")
(version "2.4")
(source (origin
(method url-fetch)
(uri (string-append
@@ -271,7 +246,7 @@ without modification.")
version "/" name "-" version ".tar.xz"))
(sha256
(base32
"07j484vb3k90f4989xh1g1x99g01akrp69p3dml4lza27wnqkfj1"))
"1xlhd09sb2w3bw8qaypxgkr0782w082mcbx8zf7yzjgy0996pxy0"))
(patches
(search-patches "bash-completion-directories.patch"))))
(build-system gnu-build-system)
+30 -36
View File
@@ -1,8 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Rene Saavedra <rennes@openmailbox.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,38 +22,26 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages hurd))
#:use-module (gnu packages pkg-config))
(define-public libgc
(define-public libgc-7.2
(package
(name "libgc")
(version "7.6.0")
(version "7.2f")
(source (origin
(method url-fetch)
(uri (string-append "http://www.hboehm.info/gc/gc_source/gc-"
version ".tar.gz"))
(sha256
(base32
"143x7g0d0k6250ai6m2x3l4y352mzizi4wbgrmahxscv2aqjhjm1"))))
"119x7p1cqw40mpwj80xfq879l9m1dkc7vbc1f3bz3kvkf8bf6p16"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
(list
;; Install gc_cpp.h et al.
"--enable-cplusplus"
;; In GNU/Hurd systems during the 'Check' phase,
;; there is a deadlock caused by the 'gctest' test.
;; To disable the error set "--disable-gcj-support"
;; to configure script. See bug report and discussion:
;; <https://lists.opendylan.org/pipermail/bdwgc/2017-April/006275.html>
;; <https://lists.gnu.org/archive/html/bug-hurd/2017-01/msg00008.html>
,@(if (hurd-triplet? (or (%current-system)
(%current-target-system)))
'("--disable-gcj-support")
'()))))
(native-inputs `(("pkg-config" ,pkg-config)))
(inputs `(("libatomic-ops" ,libatomic-ops)))
;; Make it so that we don't rely on /proc. This is especially useful in
;; an initrd run before /proc is mounted.
'(#:configure-flags '("CPPFLAGS=-DUSE_LIBC_PRIVATES"
;; Install gc_cpp.h et al.
"--enable-cplusplus")))
(outputs '("out" "debug"))
(synopsis "The Boehm-Demers-Weiser conservative garbage collector
for C and C++")
@@ -78,20 +64,10 @@ C or C++ programs, though that is not its primary goal.")
(license (x11-style (string-append home-page "license.txt")))))
(define-public libgc/back-pointers
(package
(inherit libgc)
(name "libgc-back-pointers")
(arguments
`(#:make-flags
(list "CPPFLAGS=-DKEEP_BACK_PTRS=1")
,@(package-arguments libgc)))
(synopsis "The BDW garbage collector, with back-pointer tracking")))
(define-public libatomic-ops
(package
(name "libatomic-ops")
(version "7.4.4")
(version "7.4.2")
(source (origin
(method url-fetch)
(uri (string-append
@@ -99,7 +75,7 @@ C or C++ programs, though that is not its primary goal.")
version ".tar.gz"))
(sha256
(base32
"13vg5fqwil17zpf4hj4h8rh3blzmym693lkdjgvwpgni1mh0l8dz"))))
"1pdm0h1y7bgkczr8byg20r6bq15m5072cqm5pny4f9crc9gn3yh4"))))
(build-system gnu-build-system)
(outputs '("out" "debug"))
(synopsis "Accessing hardware atomic memory update operations")
@@ -112,3 +88,21 @@ lock-free code, experiment with thread programming paradigms, etc.")
;; Some source files are X11-style, others are GPLv2+.
(license gpl2+)))
(define-public libgc
(package (inherit libgc-7.2)
(version "7.4.2")
(source (origin
(method url-fetch)
(uri (string-append "http://www.hboehm.info/gc/gc_source/gc-"
version ".tar.gz"))
(sha256
(base32
"18mg28rr6kwr5clc65k4l4hkyy4kd16amx831sjf8q2lqkbhlck3"))))
;; New dependencies.
(native-inputs `(("pkg-config" ,pkg-config)))
(inputs `(("libatomic-ops" ,libatomic-ops)))
;; 'USE_LIBC_PRIVATES' is now the default.
(arguments '(#:configure-flags '("--enable-cplusplus")))))
+8 -115
View File
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Dave Love <fx@gnu.org>
;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,17 +22,12 @@
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages compression)
#:use-module (gnu packages linux)
#:use-module (gnu packages maths)
#:use-module (gnu packages mpi)
#:use-module (gnu packages python)
#:use-module (gnu packages storage)
#:use-module (ice-9 match))
#:use-module (gnu packages linux))
(define-public fio
(package
(name "fio")
(version "3.2")
(version "2.15")
(source (origin
(method url-fetch)
(uri (string-append
@@ -41,61 +35,22 @@
"fio-" version ".tar.bz2"))
(sha256
(base32
"1f5vina9bxn99drda8dhbxng8ypj4ny72xh6mp8rq955d0f8sq0z"))))
"1ggma9c48717z2wz8j9f7jcgb3xqk8qawjl6c9hnabxxry94y130"))))
(build-system gnu-build-system)
(arguments
'(#:test-target "test"
'(#:tests? #f ; No tests.
#:phases
(modify-phases %standard-phases
(add-after
'unpack 'patch-paths
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(gnuplot (string-append (assoc-ref inputs "gnuplot")
"/bin/gnuplot")))
(substitute* "tools/plot/fio2gnuplot"
(("/usr/share/fio") (string-append out "/share/fio"))
;; FIXME (upstream): The 'gnuplot' executable is used inline
;; in various os.system() calls mixed with *.gnuplot filenames.
(("; do gnuplot") (string-append "; do " gnuplot))
(("gnuplot mymath") (string-append gnuplot " mymath"))
(("gnuplot mygraph") (string-append gnuplot " mygraph")))
#t)))
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
;; The configure script doesn't understand some of the
;; GNU options, so we can't use #:configure-flags.
(let ((out (assoc-ref outputs "out")))
(zero? (system* "./configure"
(string-append "--prefix=" out))))))
;; The main `fio` executable is fairly small and self contained.
;; Moving the auxiliary python and gnuplot scripts to a separate
;; output saves almost 400 MiB on the closure.
(add-after 'install 'move-outputs
(lambda* (#:key outputs #:allow-other-keys)
(let ((oldbin (string-append (assoc-ref outputs "out") "/bin"))
(newbin (string-append (assoc-ref outputs "utils") "/bin")))
(mkdir-p newbin)
(for-each (lambda (file)
(let ((src (string-append oldbin "/" file))
(dst (string-append newbin "/" file)))
(link src dst)
(delete-file src)))
'("fio2gnuplot" "fiologparser_hist.py"
"fiologparser.py"))
;; Make sure numpy et.al is found.
(wrap-program (string-append newbin "/fiologparser_hist.py")
`("PYTHONPATH" ":" prefix (,(getenv "PYTHONPATH"))))
#t))))))
(outputs '("out" "utils"))
(string-append "--prefix=" out)))))))))
(inputs
`(("ceph" ,ceph "lib")
("libaio" ,libaio)
("gnuplot" ,gnuplot)
("zlib" ,zlib)
("python-numpy" ,python2-numpy)
("python-pandas" ,python2-pandas)
("python" ,python-2)))
`(("libaio" ,libaio)
("zlib" ,zlib)))
(home-page "https://github.com/axboe/fio")
(synopsis "Flexible I/O tester")
(description
@@ -106,65 +61,3 @@ is to write a job file matching the I/O load one wants to simulate.")
;; are covered by other licenses.
(license (list license:gpl2 license:gpl2+ license:bsd-2
license:public-domain))))
;; Parameterized in anticipation of m(va)pich support
(define (imb mpi)
(package
(name (string-append "imb-" (package-name mpi)))
(version "2017.2")
(source
(origin
(method url-fetch)
(uri (match (string-split version #\.)
((major minor)
(string-append
"https://software.intel.com/sites/default/files/managed/76/6c/IMB_"
major "_Update" minor ".tgz"))))
(sha256 (base32 "11nczxm686rsppmw9gjc2p2sxc0jniv5kv18yxm1lzp5qfh5rqyb"))))
(build-system gnu-build-system)
(inputs
`(("mpi" ,mpi)))
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'configure)
(delete 'check)
(replace 'build
(lambda* (#:key inputs #:allow-other-keys)
(let ((mpi-home (assoc-ref inputs "mpi")))
(zero?
;; Not safe for parallel build
(system* "make" "-C" "imb/src" "-f" "make_mpich" "SHELL=sh"
(string-append "MPI_HOME=" mpi-home))))))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(doc (string-append out "/share/doc/" ,name))
(bin (string-append out "/bin")))
(with-directory-excursion "imb/src"
(for-each
(lambda (file)
(install-file file bin))
'("IMB-IO" "IMB-EXT" "IMB-MPI1" "IMB-NBC" "IMB-RMA")))
(mkdir-p doc)
(with-directory-excursion "imb"
(copy-recursively "license" doc)))
#t)))))
(home-page "https://software.intel.com/en-us/articles/intel-mpi-benchmarks")
(synopsis "Intel MPI Benchmarks")
(description
"This package provides benchmarks for implementations of the @dfn{Message
Passing Interface} (MPI). It contains MPI performance measurements for
point-to-point and global communication, and file, operations for a range of
message sizes. The generated benchmark data fully characterize:
@itemize
@item
Performance of a cluster system, including node performance, network latency,
and throughput;
@item
Efficiency of the MPI implementation.
@end itemize")
(license license:cpl1.0)))
(define-public imb-openmpi (imb openmpi))
File diff suppressed because it is too large Load Diff
+1 -1
View File
@@ -44,7 +44,7 @@
("m4" ,m4)))
(inputs `(("flex" ,flex)))
(propagated-inputs `(("m4" ,m4)))
(home-page "https://www.gnu.org/software/bison/")
(home-page "http://www.gnu.org/software/bison/")
(synopsis "Parser generator")
(description
"GNU Bison is a general-purpose parser generator. It can build a
+21 -112
View File
@@ -2,11 +2,9 @@
;;; Copyright © 2014 Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Tomáš Čech <sleep_walker@gnu.org>
;;; Copyright © 2016, 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,14 +24,11 @@
(define-module (gnu packages bittorrent)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system python)
#:use-module (guix build-system glib-or-gtk)
#:use-module ((guix licenses) #:prefix l:)
#:use-module (gnu packages)
#:use-module (gnu packages adns)
#:use-module (gnu packages boost)
#:use-module (gnu packages check)
#:use-module (gnu packages compression)
#:use-module (gnu packages crypto)
@@ -74,24 +69,23 @@
"gui")) ; graphical user interface
(arguments
'(#:glib-or-gtk-wrap-excluded-outputs '("out")
#:phases
(modify-phases %standard-phases
(add-after 'install 'move-gui
(lambda* (#:key outputs #:allow-other-keys)
;; Move the GUI to its own output, so that "out" doesn't
;; depend on GTK+.
(let ((out (assoc-ref outputs "out"))
(gui (assoc-ref outputs "gui")))
(mkdir-p (string-append gui "/bin"))
(rename-file (string-append out "/bin/transmission-gtk")
(string-append gui
"/bin/transmission-gtk"))
#:phases (alist-cons-after
'install 'move-gui
(lambda* (#:key outputs #:allow-other-keys)
;; Move the GUI to its own output, so that "out" doesn't
;; depend on GTK+.
(let ((out (assoc-ref outputs "out"))
(gui (assoc-ref outputs "gui")))
(mkdir-p (string-append gui "/bin"))
(rename-file (string-append out "/bin/transmission-gtk")
(string-append gui
"/bin/transmission-gtk"))
;; Move the '.desktop' file as well.
(mkdir (string-append gui "/share"))
(rename-file (string-append out "/share/applications")
(string-append gui "/share/applications")))
#t)))))
;; Move the '.desktop' file as well.
(mkdir (string-append gui "/share"))
(rename-file (string-append out "/share/applications")
(string-append gui "/share/applications"))))
%standard-phases)))
(inputs
`(("inotify-tools" ,inotify-tools)
("libevent" ,libevent)
@@ -176,50 +170,6 @@ XML-RPC over SCGI.")
(home-page "https://github.com/rakshasa/rtorrent")
(license l:gpl2+)))
(define-public tremc
(let ((commit "9755b50e9444566cff02c977edafdbb3e9750cbb")
(revision "1"))
(package
(name "tremc")
(version (git-version "0.9.0" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/louipc/tremc.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"05259qss5jka5ygwrh7cngyp6cgazbynji5pshgfzrd2d43pyfq5"))))
(build-system python-build-system)
(arguments
`(#:tests? #f ; no test suite
#:phases
(modify-phases %standard-phases
;; The software is just a Python script that must be
;; copied into place.
(delete 'build)
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(man (string-append out "/share/man/man1"))
;; FIXME install zsh completions
(completions (string-append out "/etc/bash_completion.d")))
(install-file "tremc" bin)
(install-file "tremc.1" man)
(install-file
(string-append
"completion/bash/"
"transmission-remote-cli-bash-completion.sh")
completions)))))))
(synopsis "Console client for the Transmission BitTorrent daemon")
(description "Tremc is a console client, with a curses interface, for the
Transmission BitTorrent daemon.")
(home-page "https://github.com/louipc/tremc")
(license l:gpl3+))))
(define-public transmission-remote-cli
(package
(name "transmission-remote-cli")
@@ -257,16 +207,14 @@ Transmission BitTorrent daemon.")
completions)))))))
(synopsis "Console client for the Transmission BitTorrent daemon")
(description "Transmission-remote-cli is a console client, with a curses
interface, for the Transmission BitTorrent daemon. This package is no longer
maintained upstream.")
interface, for the Transmission BitTorrent daemon.")
(home-page "https://github.com/fagga/transmission-remote-cli")
(license l:gpl3+)
(properties `((superseded . ,tremc)))))
(license l:gpl3+)))
(define-public aria2
(package
(name "aria2")
(version "1.33.1")
(version "1.30.0")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/tatsuhiro-t/aria2/"
@@ -274,7 +222,7 @@ maintained upstream.")
name "-" version ".tar.xz"))
(sha256
(base32
"06syqxia701dk96rcbhnd4x0arjj6d22gm3aqksz38am9y2f8f95"))))
"1xiiqk4yiqr0c4hf05zkma9if13lp3wh37z1r0w60ahxs5k56v5z"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags (list "--enable-libaria2"
@@ -378,42 +326,3 @@ the distributed hash table (DHT) and Peer Exchange. Hashing is multi-threaded
and will take advantage of multiple processor cores where possible.")
(license (list l:public-domain ; sha1.*, used to build without OpenSSL
l:gpl2+)))) ; with permission to link with OpenSSL
(define-public libtorrent-rasterbar
(package
(name "libtorrent-rasterbar")
(version "1.1.5")
(source (origin
(method url-fetch)
(uri
(string-append
"https://github.com/arvidn/libtorrent/releases/download/libtorrent-"
(string-join (string-split version #\.) "_")
"/libtorrent-rasterbar-" version ".tar.gz"))
(sha256
(base32
"0c398b7hsa5dvj4m0jc8h7mn0m3nawmagb6c5c7ml5c9hc338c8h"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
(list (string-append "--with-boost-libdir="
(assoc-ref %build-inputs "boost")
"/lib")
"--enable-python-binding"
"--enable-tests")
#:make-flags (list
(string-append "LDFLAGS=-Wl,-rpath="
(assoc-ref %outputs "out") "/lib"))))
(inputs `(("boost" ,boost)
("openssl" ,openssl)))
(native-inputs `(("python" ,python-2)
("pkg-config" ,pkg-config)))
(home-page "http://www.rasterbar.com/products/libtorrent/")
(synopsis "Feature complete BitTorrent implementation")
(description
"libtorrent-rasterbar is a feature complete C++ BitTorrent implementation
focusing on efficiency and scalability. It runs on embedded devices as well as
desktops.")
(license l:bsd-2)))
+8 -11
View File
@@ -4,7 +4,6 @@
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,15 +27,14 @@
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages compression)
#:use-module (gnu packages icu4c)
#:use-module (gnu packages perl)
#:use-module (gnu packages python)
#:use-module (gnu packages shells))
#:use-module (gnu packages shells)
#:use-module (gnu packages perl))
(define-public boost
(package
(name "boost")
(version "1.64.0")
(version "1.61.0")
(source (origin
(method url-fetch)
(uri (string-append
@@ -45,10 +43,9 @@
".tar.bz2"))
(sha256
(base32
"0cikd35xfkpg9nnl76yqqnqxnf3hyfjjww8xjd4akflprsm5rk3v"))))
"0h5nk7pgxf7xsvvshj9qfpsfp9wx6gq9r78n3nx736pxq83bsix5"))))
(build-system gnu-build-system)
(inputs `(("icu4c" ,icu4c)
("zlib" ,zlib)))
(inputs `(("zlib" ,zlib)))
(native-inputs
`(("perl" ,perl)
("python" ,python-2)
@@ -112,14 +109,14 @@ across a broad spectrum of applications.")
(define-public mdds
(package
(name "mdds")
(version "1.2.2")
(version "0.12.1")
(source (origin
(method url-fetch)
(uri (string-append
"http://kohei.us/files/mdds/src/mdds-" version ".tar.bz2"))
"http://kohei.us/files/mdds/src/mdds_" version ".tar.bz2"))
(sha256
(base32
"17fcjhsq3bzqm7ba9sgp6my3y4226jnwai6q5jq3810i745p67hl"))))
"0gg8mb9kxh3wggh7njj1gf90xy27p0yq2cw88wqar9hhg2fmwmi3"))))
(build-system gnu-build-system)
(propagated-inputs
`(("boost" ,boost))) ; inclusion of header files
-491
View File
@@ -1,491 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016, 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2016, 2017 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; 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 (gnu packages bootloaders)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module ((gnu packages algebra) #:select (bc))
#:use-module (gnu packages assembly)
#:use-module (gnu packages disk)
#:use-module (gnu packages bison)
#:use-module (gnu packages cdrom)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages disk)
#:use-module (gnu packages flex)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages gettext)
#:use-module (gnu packages linux)
#:use-module (gnu packages man)
#:use-module (gnu packages mtools)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages perl)
#:use-module (gnu packages python)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages swig)
#:use-module (gnu packages virtualization)
#:use-module (guix build-system gnu)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26))
(define unifont
;; GNU Unifont, <http://gnu.org/s/unifont>.
;; GRUB needs it for its graphical terminal, gfxterm.
(origin
(method url-fetch)
(uri
"http://unifoundry.com/pub/unifont-7.0.06/font-builds/unifont-7.0.06.bdf.gz")
(sha256
(base32
"0p2vhnc18cnbmb39vq4m7hzv4mhnm2l0a2s7gx3ar277fwng3hys"))))
(define-public grub
(package
(name "grub")
(version "2.02")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/grub/grub-" version ".tar.xz"))
(sha256
(base32
"03vvdfhdmf16121v7xs8is2krwnv15wpkhkf16a4yf8nsfc3f2w1"))))
(build-system gnu-build-system)
(arguments
`(#:phases (modify-phases %standard-phases
(add-after 'unpack 'patch-stuff
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "grub-core/Makefile.in"
(("/bin/sh") (which "sh")))
;; Give the absolute file name of 'mdadm', used to
;; determine the root file system when it's a RAID
;; device. Failing to do that, 'grub-probe' silently
;; fails if 'mdadm' is not in $PATH.
(substitute* "grub-core/osdep/linux/getroot.c"
(("argv\\[0\\] = \"mdadm\"")
(string-append "argv[0] = \""
(assoc-ref inputs "mdadm")
"/sbin/mdadm\"")))
;; Make the font visible.
(copy-file (assoc-ref inputs "unifont") "unifont.bdf.gz")
(system* "gunzip" "unifont.bdf.gz")
#t))
(add-before 'check 'disable-flaky-test
(lambda _
;; This test is unreliable. For more information, see:
;; <https://bugs.gnu.org/26936>.
(substitute* "Makefile.in"
(("grub_cmd_date grub_cmd_set_date grub_cmd_sleep")
"grub_cmd_date grub_cmd_sleep"))
#t)))
;; Disable tests on ARM and AARCH64 platforms.
#:tests? ,(not (any (cute string-prefix? <> (or (%current-target-system)
(%current-system)))
'("arm" "aarch64")))))
(inputs
`(("gettext" ,gettext-minimal)
;; Depend on LVM2 for libdevmapper, used by 'grub-probe' and
;; 'grub-install' to recognize mapped devices (LUKS, etc.)
("lvm2" ,lvm2)
;; Depend on mdadm, which is invoked by 'grub-probe' and 'grub-install'
;; to determine whether the root file system is RAID.
("mdadm" ,mdadm)
("freetype" ,freetype)
;; ("libusb" ,libusb)
;; ("fuse" ,fuse)
("ncurses" ,ncurses)))
(native-inputs
`(("unifont" ,unifont)
("bison" ,bison)
;; Due to a bug in flex >= 2.6.2, GRUB must be built with an older flex:
;; <http://lists.gnu.org/archive/html/grub-devel/2017-02/msg00133.html>
;; TODO Try building with flex > 2.6.4.
("flex" ,flex-2.6.1)
("texinfo" ,texinfo)
("help2man" ,help2man)
;; Dependencies for the test suite. The "real" QEMU is needed here,
;; because several targets are used.
("parted" ,parted)
("qemu" ,qemu-minimal)
("xorriso" ,xorriso)))
(home-page "https://www.gnu.org/software/grub/")
(synopsis "GRand Unified Boot loader")
(description
"GRUB is a multiboot bootloader. It is used for initially loading the
kernel of an operating system and then transferring control to it. The kernel
then goes on to load the rest of the operating system. As a multiboot
bootloader, GRUB handles the presence of multiple operating systems installed
on the same computer; upon booting the computer, the user is presented with a
menu to select one of the installed operating systems.")
(license license:gpl3+)
(properties '((cpe-name . "grub2")))))
(define-public grub-efi
(package
(inherit grub)
(name "grub-efi")
(synopsis "GRand Unified Boot loader (UEFI version)")
(inputs
`(("efibootmgr" ,efibootmgr)
("mtools", mtools)
,@(package-inputs grub)))
(arguments
`(;; TODO: Tests need a UEFI firmware for qemu. There is one at
;; https://github.com/tianocore/edk2/tree/master/OvmfPkg .
;; Search for 'OVMF' in "tests/util/grub-shell.in".
,@(substitute-keyword-arguments (package-arguments grub)
((#:tests? _ #f) #f)
((#:configure-flags flags ''())
`(cons "--with-platform=efi" ,flags))
((#:phases phases)
`(modify-phases ,phases
(add-after 'patch-stuff 'use-absolute-efibootmgr-path
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "grub-core/osdep/unix/platform.c"
(("efibootmgr")
(string-append (assoc-ref inputs "efibootmgr")
"/sbin/efibootmgr")))
#t))
(add-after 'patch-stuff 'use-absolute-mtools-path
(lambda* (#:key inputs #:allow-other-keys)
(let ((mtools (assoc-ref inputs "mtools")))
(substitute* "util/grub-mkrescue.c"
(("\"mformat\"")
(string-append "\"" mtools
"/bin/mformat\"")))
(substitute* "util/grub-mkrescue.c"
(("\"mcopy\"")
(string-append "\"" mtools
"/bin/mcopy\"")))
#t))))))))))
;; Because grub searches hardcoded paths it's easiest to just build grub
;; again to make it find both grub-pc and grub-efi. There is a command
;; line argument which allows you to specify ONE platform - but
;; grub-mkrescue will use multiple platforms if they are available
;; in the installation directory (without command line argument).
(define-public grub-hybrid
(package
(inherit grub-efi)
(name "grub-hybrid")
(synopsis "GRand Unified Boot loader (hybrid version)")
(inputs
`(("grub" ,grub)
,@(package-inputs grub-efi)))
(arguments
(substitute-keyword-arguments (package-arguments grub-efi)
((#:modules modules `((guix build utils) (guix build gnu-build-system)))
`((ice-9 ftw) ,@modules))
((#:phases phases)
`(modify-phases ,phases
(add-after 'install 'install-non-efi
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((input-dir (string-append (assoc-ref inputs "grub")
"/lib/grub"))
(output-dir (string-append (assoc-ref outputs "out")
"/lib/grub")))
(for-each
(lambda (basename)
(if (not (string-prefix? "." basename))
(symlink (string-append input-dir "/" basename)
(string-append output-dir "/" basename))))
(scandir input-dir))
#t)))))))))
(define-public syslinux
(let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))
(package
(name "syslinux")
(version (git-version "6.04-pre" "1" commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/geneC/syslinux")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"0k8dvafd6410kqxf3kyr4y8jzmpmrih6wbjqg6gklak7945yflrc"))))
(build-system gnu-build-system)
(native-inputs
`(("nasm" ,nasm)
("perl" ,perl)
("python-2" ,python-2)))
(inputs
`(("libuuid" ,util-linux)
("mtools" ,mtools)))
(arguments
`(#:parallel-build? #f
#:make-flags
(list (string-append "BINDIR=" %output "/bin")
(string-append "SBINDIR=" %output "/sbin")
(string-append "LIBDIR=" %output "/lib")
(string-append "INCDIR=" %output "/include")
(string-append "DATADIR=" %output "/share")
(string-append "MANDIR=" %output "/share/man")
"PERL=perl"
"bios")
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-files
(lambda* (#:key inputs #:allow-other-keys)
(substitute* (find-files "." "Makefile.*|ppmtolss16")
(("/bin/pwd") (which "pwd"))
(("/bin/echo") (which "echo"))
(("/usr/bin/perl") (which "perl")))
(let ((mtools (assoc-ref inputs "mtools")))
(substitute* (find-files "." "\\.c$")
(("mcopy")
(string-append mtools "/bin/mcopy"))
(("mattrib")
(string-append mtools "/bin/mattrib"))))
#t))
(delete 'configure)
(add-before 'build 'set-permissions
(lambda _
(zero? (system* "chmod" "a+w" "utils/isohybrid.in"))))
(replace 'check
(lambda _
(setenv "CC" "gcc")
(substitute* "tests/unittest/include/unittest/unittest.h"
;; Don't look up headers under /usr.
(("/usr/include/") ""))
(zero? (system* "make" "unittest")))))))
(home-page "http://www.syslinux.org")
(synopsis "Lightweight Linux bootloader")
(description "Syslinux is a lightweight Linux bootloader.")
(license (list license:gpl2+
license:bsd-3 ; gnu-efi/*
license:bsd-4 ; gnu-efi/inc/* gnu-efi/lib/*
;; Also contains:
license:expat license:isc license:zlib)))))
(define-public dtc
(package
(name "dtc")
(version "1.4.5")
(source (origin
(method url-fetch)
(uri (string-append
"mirror://kernel.org/software/utils/dtc/"
"dtc-" version ".tar.xz"))
(sha256
(base32
"08gnl39i4xy3dm8iqwlz2ygx0ml1bgc5kpiys5ll1wvah1j72b04"))
;; Fix build and tests on 32 bits platforms.
;; Will probably be fixed in 1.4.6 release.
(patches (search-patches "dtc-format-modifier.patch"
"dtc-32-bits-check.patch"))))
(build-system gnu-build-system)
(native-inputs
`(("bison" ,bison)
("flex" ,flex)
("swig" ,swig)))
(inputs
`(("python-2" ,python-2)))
(arguments
`(#:make-flags
(list "CC=gcc"
(string-append "PREFIX=" (assoc-ref %outputs "out"))
(string-append "SETUP_PREFIX=" (assoc-ref %outputs "out"))
"INSTALL=install")
#:phases
(modify-phases %standard-phases
(delete 'configure))))
(home-page "https://www.devicetree.org")
(synopsis "Compiles device tree source files")
(description "@command{dtc} compiles
@uref{http://elinux.org/Device_Tree_Usage, device tree source files} to device
tree binary files. These are board description files used by Linux and BSD.")
(license license:gpl2+)))
(define u-boot
(package
(name "u-boot")
(version "2017.11")
(source (origin
(method url-fetch)
(uri (string-append
"ftp://ftp.denx.de/pub/u-boot/"
"u-boot-" version ".tar.bz2"))
(sha256
(base32
"01bcsah5imy6m3fbjwhqywxg0pfk5fl8ks9ylb7kv3zmrb9qy0ba"))))
(native-inputs
`(("bc" ,bc)
("dtc" ,dtc)
("python-2" ,python-2)))
(build-system gnu-build-system)
(home-page "http://www.denx.de/wiki/U-Boot/")
(synopsis "ARM bootloader")
(description "U-Boot is a bootloader used mostly for ARM boards. It
also initializes the boards (RAM etc).")
(license license:gpl2+)))
(define (make-u-boot-package board triplet)
"Returns a u-boot package for BOARD cross-compiled for TRIPLET."
(let ((same-arch? (if (string-prefix? (%current-system)
(gnu-triplet->nix-system triplet))
`#t
`#f)))
(package
(inherit u-boot)
(name (string-append "u-boot-" (string-downcase board)))
(native-inputs
`(,@(if (not same-arch?)
`(("cross-gcc" ,(cross-gcc triplet))
("cross-binutils" ,(cross-binutils triplet)))
'())
,@(package-native-inputs u-boot)))
(arguments
`(#:modules ((ice-9 ftw) (guix build utils) (guix build gnu-build-system))
#:test-target "test"
#:make-flags
(list "HOSTCC=gcc"
,@(if (not same-arch?)
`((string-append "CROSS_COMPILE=" ,triplet "-"))
'()))
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key outputs make-flags #:allow-other-keys)
(let ((config-name (string-append ,board "_defconfig")))
(if (file-exists? (string-append "configs/" config-name))
(zero? (apply system* "make" `(,@make-flags ,config-name)))
(begin
(display "Invalid board name. Valid board names are:")
(let ((suffix-len (string-length "_defconfig")))
(scandir "configs"
(lambda (file-name)
(when (string-suffix? "_defconfig" file-name)
(format #t
"- ~A\n"
(string-drop-right file-name
suffix-len))))))
#f)))))
(replace 'install
(lambda* (#:key outputs make-flags #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(libexec (string-append out "/libexec"))
(uboot-files (append
(find-files "." ".*\\.(bin|efi|img|spl)$")
(find-files "." "^MLO$"))))
(mkdir-p libexec)
(for-each
(lambda (file)
(let ((target-file (string-append libexec "/" file)))
(mkdir-p (dirname target-file))
(copy-file file target-file)))
uboot-files))))))))))
(define-public u-boot-vexpress
(make-u-boot-package "vexpress_ca9x4" "arm-linux-gnueabihf"))
(define-public u-boot-malta
(make-u-boot-package "malta" "mips64el-linux-gnuabi64"))
(define-public u-boot-beagle-bone-black
(make-u-boot-package "am335x_boneblack" "arm-linux-gnueabihf"))
(define-public u-boot-odroid-c2
(make-u-boot-package "odroid-c2" "aarch64-linux-gnu"))
(define-public os-prober
(package
(name "os-prober")
(version "1.76")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://debian/pool/main/o/os-prober/os-prober_"
version ".tar.xz"))
(sha256
(base32
"1vb45i76bqivlghrq7m3n07qfmmq4wxrkplqx8gywj011rhq19fk"))))
(build-system gnu-build-system)
(arguments
`(#:modules ((guix build gnu-build-system)
(guix build utils)
(ice-9 regex) ; for string-match
(srfi srfi-26)) ; for cut
#:make-flags (list "CC=gcc")
#:tests? #f ; no tests
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
(substitute* (find-files ".")
(("/usr") (assoc-ref outputs "out")))
(substitute* (find-files "." "50mounted-tests$")
(("mkdir") "mkdir -p"))
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(define (find-files-non-recursive directory)
(find-files directory
(lambda (file stat)
(string-match (string-append "^" directory "/[^/]*$")
file))
#:directories? #t))
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(lib (string-append out "/lib"))
(share (string-append out "/share")))
(for-each (cut install-file <> bin)
(list "linux-boot-prober" "os-prober"))
(install-file "newns" (string-append lib "/os-prober"))
(install-file "common.sh" (string-append share "/os-prober"))
(install-file "os-probes/mounted/powerpc/20macosx"
(string-append lib "/os-probes/mounted"))
(for-each
(lambda (directory)
(for-each
(lambda (file)
(let ((destination (string-append lib "/" directory
"/" (basename file))))
(mkdir-p (dirname destination))
(copy-recursively file destination)))
(append (find-files-non-recursive (string-append directory "/common"))
(find-files-non-recursive (string-append directory "/x86")))))
(list "os-probes" "os-probes/mounted" "os-probes/init"
"linux-boot-probes" "linux-boot-probes/mounted"))
#t))))))
(home-page "https://joeyh.name/code/os-prober")
(synopsis "Detect other operating systems")
(description "os-prober probes disks on the system for other operating
systems so that they can be added to the bootloader. It also works out how to
boot existing GNU/Linux systems and detects what distribution is installed in
order to add a suitable bootloader menu entry.")
(license license:gpl2+)))
+21 -57
View File
@@ -1,7 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,8 +28,7 @@
#:use-module ((guix store) #:select (add-to-store add-text-to-store))
#:use-module ((guix derivations) #:select (derivation))
#:use-module ((guix utils) #:select (gnu-triplet->nix-system))
#:use-module ((guix build utils) #:select (elf-file?))
#:use-module (guix memoization)
#:use-module (guix combinators)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
@@ -133,36 +131,36 @@ successful, or false to signal an error."
(license gpl3+)))
(define package-with-bootstrap-guile
(mlambda (p)
(memoize
(lambda (p)
"Return a variant of P such that all its origins are fetched with
%BOOTSTRAP-GUILE."
(define rewritten-input
(match-lambda
((name (? origin? o))
`(,name ,(bootstrap-origin o)))
((name (? package? p) sub-drvs ...)
`(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
(x x)))
((name (? origin? o))
`(,name ,(bootstrap-origin o)))
((name (? package? p) sub-drvs ...)
`(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
(x x)))
(package (inherit p)
(source (match (package-source p)
((? origin? o) (bootstrap-origin o))
(s s)))
(inputs (map rewritten-input
(package-inputs p)))
(native-inputs (map rewritten-input
(package-native-inputs p)))
(propagated-inputs (map rewritten-input
(package-propagated-inputs p)))
(replacement (and=> (package-replacement p)
package-with-bootstrap-guile)))))
(source (match (package-source p)
((? origin? o) (bootstrap-origin o))
(s s)))
(inputs (map rewritten-input
(package-inputs p)))
(native-inputs (map rewritten-input
(package-native-inputs p)))
(propagated-inputs (map rewritten-input
(package-propagated-inputs p)))
(replacement (and=> (package-replacement p)
package-with-bootstrap-guile))))))
(define* (glibc-dynamic-linker
#:optional (system (or (and=> (%current-target-system)
gnu-triplet->nix-system)
(%current-system))))
"Return the name of Glibc's dynamic linker for SYSTEM."
;; See the 'SYSDEP_KNOWN_INTERPRETER_NAMES' cpp macro in libc.
(cond ((string=? system "x86_64-linux") "/lib/ld-linux-x86-64.so.2")
((string=? system "i686-linux") "/lib/ld-linux.so.2")
((string=? system "armhf-linux") "/lib/ld-linux-armhf.so.3")
@@ -170,9 +168,6 @@ successful, or false to signal an error."
((string=? system "i586-gnu") "/lib/ld.so.1")
((string=? system "i686-gnu") "/lib/ld.so.1")
((string=? system "aarch64-linux") "/lib/ld-linux-aarch64.so.1")
((string=? system "powerpc-linux") "/lib/ld.so.1")
((string=? system "powerpc64le-linux") "/lib/ld64.so.2")
((string=? system "alpha-linux") "/lib/ld-linux.so.2")
;; XXX: This one is used bare-bones, without a libc, so add a case
;; here just so we can keep going.
@@ -181,7 +176,6 @@ successful, or false to signal an error."
((string=? system "avr") "no-ld.so")
((string=? system "propeller-elf") "no-ld.so")
((string=? system "i686-mingw") "no-ld.so")
((string=? system "vc4-elf") "no-ld.so")
(else (error "dynamic linker name not known for this system"
system))))
@@ -208,8 +202,6 @@ successful, or false to signal an error."
(guile (->store (match system
("armhf-linux"
"guile-2.0.11.tar.xz")
("aarch64-linux"
"guile-2.0.14.tar.xz")
(_
"guile-2.0.9.tar.xz"))))
;; The following code, run by the bootstrap guile after it is
@@ -298,8 +290,7 @@ $out/bin/guile --version~%"
;; This is where the initial binaries come from.
'("ftp://alpha.gnu.org/gnu/guix/bootstrap"
"http://alpha.gnu.org/gnu/guix/bootstrap"
"http://www.fdn.fr/~lcourtes/software/guix/packages"
"http://flashner.co.il/guix/bootstrap"))
"http://www.fdn.fr/~lcourtes/software/guix/packages"))
(define %bootstrap-coreutils&co
(package-from-tarball "bootstrap-binaries"
@@ -310,8 +301,6 @@ $out/bin/guile --version~%"
(match system
("armhf-linux"
"/20150101/static-binaries.tar.xz")
("aarch64-linux"
"/20170217/static-binaries.tar.xz")
(_
"/20131110/static-binaries.tar.xz")))
%bootstrap-base-urls))
@@ -326,9 +315,6 @@ $out/bin/guile --version~%"
("armhf-linux"
(base32
"0gf0fn2kbpxkjixkmx5f4z6hv6qpmgixl69zgg74dbsfdfj8jdv5"))
("aarch64-linux"
(base32
"18dfiq6c6xhsdpbidigw6480wh0vdgsxqq3xindq4lpdgqlccpfh"))
("mips64el-linux"
(base32
"072y4wyfsj1bs80r6vbybbafy8ya4vfy7qj25dklwk97m6g71753"))))))
@@ -339,13 +325,6 @@ $out/bin/guile --version~%"
(chmod "bin" #o755)
(patch-shebang "bin/egrep" path)
(patch-shebang "bin/fgrep" path)
;; Starting with grep@2.25 'egrep' and 'fgrep' are shell files
;; that call 'grep'. If the bootstrap 'egrep' and 'fgrep'
;; are not binaries then patch them to execute 'grep' via its
;; absolute file name instead of searching for it in $PATH.
(if (not (elf-file? "bin/egrep"))
(substitute* '("bin/egrep" "bin/fgrep")
(("^exec grep") (string-append (getcwd) "/bin/grep"))))
(chmod "bin" #o555)
#t)))
@@ -358,8 +337,6 @@ $out/bin/guile --version~%"
(match system
("armhf-linux"
"/20150101/binutils-2.25.tar.xz")
("aarch64-linux"
"/20170217/binutils-2.27.tar.xz")
(_
"/20131110/binutils-2.23.2.tar.xz")))
%bootstrap-base-urls))
@@ -374,9 +351,6 @@ $out/bin/guile --version~%"
("armhf-linux"
(base32
"1v7dj6bzn6m36f20gw31l99xaabq4xrhrx3gwqkhhig0mdlmr69q"))
("aarch64-linux"
(base32
"111s7ilfiby033rczc71797xrmaa3qlv179wdvsaq132pd51xv3n"))
("mips64el-linux"
(base32
"1x8kkhcxmfyzg1ddpz2pxs6fbdl6412r7x0nzbmi5n7mj8zw2gy7"))))))
@@ -424,8 +398,6 @@ $out/bin/guile --version~%"
(match (%current-system)
("armhf-linux"
"/20150101/glibc-2.20.tar.xz")
("aarch64-linux"
"/20170217/glibc-2.25.tar.xz")
(_
"/20131110/glibc-2.18.tar.xz")))
%bootstrap-base-urls))
@@ -440,9 +412,6 @@ $out/bin/guile --version~%"
("armhf-linux"
(base32
"18cmgvpllqfpn6khsmivqib7ys8ymnq0hdzi3qp24prik0ykz8gn"))
("aarch64-linux"
(base32
"07nx3x8598i2924rjnlrncg6rm61c9bmcczbbcpbx0fb742nvv5c"))
("mips64el-linux"
(base32
"0k97a3whzx3apsi9n2cbsrr79ad6lh00klxph9hw4fqyp1abkdsg")))))))))
@@ -507,8 +476,6 @@ exec ~a/bin/.gcc-wrapped -B~a/lib \
(match (%current-system)
("armhf-linux"
"/20150101/gcc-4.8.4.tar.xz")
("aarch64-linux"
"/20170217/gcc-5.4.0.tar.xz")
(_
"/20131110/gcc-4.8.2.tar.xz")))
%bootstrap-base-urls))
@@ -523,9 +490,6 @@ exec ~a/bin/.gcc-wrapped -B~a/lib \
("armhf-linux"
(base32
"0ghz825yzp43fxw53kd6afm8nkz16f7dxi9xi40bfwc8x3nbbr8v"))
("aarch64-linux"
(base32
"1ar3vdzyqbfm0z36kmvazvfswxhcihlacl2dzdjgiq25cqnq9ih1"))
("mips64el-linux"
(base32
"1m5miqkyng45l745n0sfafdpjkqv9225xf44jqkygwsipj2cv9ks")))))))))
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
-146
View File
@@ -1,146 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Corentin Bocquillon <corentin@nybble.fr>
;;;
;;; 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 (gnu packages build-tools)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (gnu packages)
#:use-module (gnu packages compression)
#:use-module (gnu packages python)
#:use-module (gnu packages ninja)
#:use-module (guix build-system gnu)
#:use-module (guix build-system python))
(define-public bam
(package
(name "bam")
(version "0.4.0")
(source (origin
(method url-fetch)
(uri (string-append "http://github.com/downloads/matricks/"
"bam/bam-" version ".tar.bz2"))
(sha256
(base32
"0z90wvyd4nfl7mybdrv9dsd4caaikc6fxw801b72gqi1m9q0c0sn"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'configure)
(replace 'build
(lambda _
(zero? (system* "bash" "make_unix.sh"))))
(replace 'check
(lambda _
(zero? (system* "python" "scripts/test.py"))))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((bin (string-append (assoc-ref outputs "out") "/bin")))
(mkdir-p bin)
(install-file "bam" bin)
#t))))))
(native-inputs
`(("python" ,python-2)))
(home-page "https://matricks.github.io/bam/")
(synopsis "Fast and flexible build system")
(description "Bam is a fast and flexible build system. Bam uses Lua to
describe the build process. It takes its inspiration for the script files
from scons. While scons focuses on being 100% correct when building, bam
makes a few sacrifices to acquire fast full and incremental build times.")
(license license:bsd-3)))
(define-public meson
(package
(name "meson")
(version "0.43.0")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/mesonbuild/meson/"
"releases/download/" version "/meson-"
version ".tar.gz"))
(sha256
(base32
"0h3k0m45004ay1hzz9r66fkl1kwizaigxahyrlabyw0d1slyq4y5"))))
(build-system python-build-system)
(inputs `(("ninja", ninja)))
(propagated-inputs `(("python" ,python)))
(home-page "https://mesonbuild.com/")
(synopsis "Build system designed to be fast and user-friendly")
(description
"The Meson build system is focused on user-friendliness and speed.
It can compile code written in C, C++, Fortran, Java, Rust, and other
languages. Meson provides features comparable to those of the
Autoconf/Automake/make combo. Build specifications, also known as @dfn{Meson
files}, are written in a custom domain-specific language (DSL) that resembles
Python.")
(license license:asl2.0)))
(define-public meson-for-build
(package
(inherit meson)
(name "meson-for-build")
(version "0.42.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/mesonbuild/meson/"
"archive/" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1494hdnd40g2v6pky34j0f2iwc6kwn51vck37qwz7nl2xr17b18q"))
(patches (search-patches "meson-for-build-rpath.patch"))))
;; People should probably install "meson", not "meson-for-build".
(properties `((hidden? . #t)))))
(define-public premake4
(package
(name "premake")
(version "4.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/premake/Premake/"
version "/premake-" version "-src.zip"))
(sha256
(base32
"1017rd0wsjfyq2jvpjjhpszaa7kmig6q1nimw76qx3cjz2868lrn"))))
(build-system gnu-build-system)
(native-inputs
`(("unzip" ,unzip))) ; for unpacking the source
(arguments
`(#:make-flags '("CC=gcc")
#:tests? #f ; No test suite
#:phases
(modify-phases %standard-phases
(delete 'configure)
(add-after 'unpack 'enter-source
(lambda _ (chdir "build/gmake.unix") #t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(install-file "../../bin/release/premake4"
(string-append (assoc-ref outputs "out") "/bin"))
#t)))))
(synopsis "Portable software build tool")
(description "@code{premake4} is a command line utility that reads a
scripted definition of a software project and outputs @file{Makefile}s or
other lower-level build files.")
(home-page "https://premake.github.io")
(license license:bsd-3)))
+26 -26
View File
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,13 +24,13 @@
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module (gnu packages compression)
#:use-module (gnu packages perl))
#:use-module (gnu packages perl)
#:use-module (gnu packages zip))
(define-public busybox
(package
(name "busybox")
(version "1.26.2")
(version "1.26.0")
(source (origin
(method url-fetch)
(uri (string-append
@@ -38,44 +38,44 @@
version ".tar.bz2"))
(sha256
(base32
"05mg6rh5smkzfwqfcazkpwy6h6555llsazikqnvwkaf17y8l8gns"))))
"0k0g3hk58m99c2sfq97ngnixb2rv2wzyhv3z00lxaw78bqvjglis"))))
(build-system gnu-build-system)
(arguments
'(#:phases
`(#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda _ (zero? (system* "make" "defconfig"))))
(replace 'check
(lambda _
(substitute* '("testsuite/du/du-s-works"
"testsuite/du/du-works")
(substitute* '("testsuite/du/du-s-works"
"testsuite/du/du-works")
(("/bin") "/etc")) ; there is no /bin but there is a /etc
;; There is no /usr/bin or /bin - replace it with /gnu/store
(substitute* "testsuite/cpio.tests"
;; There is no /usr/bin or /bin - replace it with /gnu/store
(substitute* "testsuite/cpio.tests"
(("/usr/bin") (%store-directory))
(("usr") (car (filter (negate string-null?)
(string-split (%store-directory) #\/)))))
(string-split (%store-directory) #\/)))))
(substitute* "testsuite/date/date-works-1"
(substitute* "testsuite/date/date-works-1"
(("/bin/date") (which "date")))
;; The pidof tests assume that pid 1 is called "init" but that is not
;; true in guix build environment
(substitute* "testsuite/pidof.tests"
;; The pidof tests assume that pid 1 is called "init" but that is not
;; true in guix build environment
(substitute* "testsuite/pidof.tests"
(("-s init") "-s $(cat /proc/1/comm)"))
;; This test cannot possibly pass.
;; It is trying to test that "which ls" returns "/bin/ls" when PATH is not set.
;; However, this relies on /bin/ls existing. Which it does not in guix.
(delete-file "testsuite/which/which-uses-default-path")
(rmdir "testsuite/which")
(zero? (system* "make"
;; "V=1"
"SKIP_KNOWN_BUGS=1"
"SKIP_INTERNET_TESTS=1"
"check"))))
;; This test cannot possibly pass.
;; It is trying to test that "which ls" returns "/bin/ls" when PATH is not set.
;; However, this relies on /bin/ls existing. Which it does not in guix.
(delete-file "testsuite/which/which-uses-default-path")
(rmdir "testsuite/which")
(zero? (system* "make"
;; "V=1"
"SKIP_KNOWN_BUGS=1"
"SKIP_INTERNET_TESTS=1"
"check"))))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
+2 -5
View File
@@ -28,8 +28,7 @@
#:use-module (gnu packages flex)
#:use-module (gnu packages perl)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages guile)
#:use-module (srfi srfi-1))
#:use-module (gnu packages guile))
(define-public tcc
(package
@@ -63,8 +62,7 @@
"/lib"))
#:test-target "test"))
;; Fails to build on MIPS: "Unsupported CPU"
(supported-systems (fold delete %supported-systems
'("mips64el-linux" "aarch64-linux")))
(supported-systems (delete "mips64el-linux" %supported-systems))
(synopsis "Tiny and fast C compiler")
(description
"TCC, also referred to as \"TinyCC\", is a small and fast C compiler
@@ -159,7 +157,6 @@ standard.")
"PCC is a portable C compiler. The project goal is to write a C99
compiler while still keeping it small, simple, fast and understandable.")
(home-page "http://pcc.ludd.ltu.se")
(supported-systems (delete "aarch64-linux" %supported-systems))
;; PCC incorporates code under various BSD licenses; for new code bsd-2 is
;; preferred. See http://pcc.ludd.ltu.se/licenses/ for more details.
(license (list license:bsd-2 license:bsd-3))))
+4 -17
View File
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2017 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,13 +22,12 @@
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages ncurses))
(define-public calcurse
(package
(name "calcurse")
(version "4.2.2")
(version "4.0.0")
(source
(origin
(method url-fetch)
@@ -37,25 +35,14 @@
version ".tar.gz"))
(sha256
(base32
"0il0y06akdqgy0f9p40m4x6arn66nh7sr1w1i41bszycs7div266"))))
"0d33cpkbhyidvm3xx6iw9ljqdvl6477c2kcwix3bs63nj0ch06v2"))))
(build-system gnu-build-system)
(inputs `(("ncurses" ,ncurses)))
(native-inputs `(("tzdata" ,tzdata-2017a)))
(arguments
;; The ical tests all want to create a ".calcurse" directory, and may
;; fail with "cannot create directory '.calcurse': File exists" if run
;; concurently.
`(#:parallel-tests? #f
;; Since this tzdata is only used for tests and not referenced by the
;; built package, used the "fixed" obsolete version of tzdata and ensure
;; it does not sneak in to the closure.
#:disallowed-references (,tzdata-2017a)
#:phases (modify-phases %standard-phases
(add-before 'check 'check-setup
(lambda* (#:key inputs #:allow-other-keys)
(setenv "TZDIR" ;for test/ical-007.sh
(string-append (assoc-ref inputs "tzdata")
"/share/zoneinfo")))))))
'(#:parallel-tests? #f))
(home-page "http://www.calcurse.org")
(synopsis "Text-based calendar and scheduling")
(description

Some files were not shown because too many files have changed in this diff Show More