forked from tribes/guix
Compare commits
6 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 0602d92bb0 | |||
| ca9050d517 | |||
| 0c8491cbbe | |||
| c490a0b037 | |||
| ea7b5a8f3d | |||
| 2c13d74181 |
+1
-12
@@ -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
@@ -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
|
||||
|
||||
@@ -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>
|
||||
|
||||
@@ -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, it’s OK to commit,
|
||||
if you’re 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 didn’t receive any reply
|
||||
after two weeks, and if you’re confident, it’s OK to commit.
|
||||
|
||||
That last part is subject to being adjusted, allowing individuals to commit
|
||||
directly on non-controversial changes on parts they’re 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
@@ -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,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
|
||||
|
||||
@@ -1,6 +0,0 @@
|
||||
(public-key
|
||||
(ecc
|
||||
(curve Ed25519)
|
||||
(q #8D156F295D24B0D9A86FA5741A840FF2D24F60F7B6C4134814AD55625971B394#)
|
||||
)
|
||||
)
|
||||
+16
-120
@@ -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
|
||||
|
||||
@@ -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
@@ -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:
|
||||
|
||||
@@ -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
@@ -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)
|
||||
|
||||
@@ -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:
|
||||
@@ -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)))
|
||||
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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
@@ -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))))))
|
||||
|
||||
@@ -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))))
|
||||
@@ -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
@@ -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)))
|
||||
|
||||
@@ -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)))
|
||||
@@ -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)))
|
||||
@@ -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
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
+1
-3
@@ -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
@@ -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
|
||||
@@ -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
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
@@ -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
|
||||
|
||||
@@ -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)))
|
||||
@@ -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)))
|
||||
@@ -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
|
||||
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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"))
|
||||
|
||||
|
||||
@@ -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)))))
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
+136
-70
@@ -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)))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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))))
|
||||
@@ -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
File diff suppressed because it is too large
Load Diff
@@ -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
@@ -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
@@ -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")
|
||||
|
||||
@@ -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
@@ -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 sound’s
|
||||
waveform until they line up with the proper sounds.")
|
||||
(license license:gpl3+))))
|
||||
|
||||
@@ -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
@@ -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
@@ -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"))
|
||||
|
||||
@@ -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+)))
|
||||
|
||||
@@ -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+)))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
File diff suppressed because it is too large
Load Diff
@@ -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
@@ -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,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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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))
|
||||
|
||||
+892
-4040
File diff suppressed because it is too large
Load Diff
@@ -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
@@ -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
@@ -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
|
||||
|
||||
@@ -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
@@ -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.
@@ -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
@@ -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
@@ -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))))
|
||||
|
||||
@@ -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
Reference in New Issue
Block a user