From 5ae7b708bbcd34f089216cfc958153cdd7e86cc3 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 25 Jan 2014 17:18:06 +0100 Subject: gnu: parallel: Update to 20140122. * gnu/packages/parallel.scm (parallel): Update to 20140122. --- gnu/packages/parallel.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/parallel.scm b/gnu/packages/parallel.scm index 9ce24a3cbf..684ef1821e 100644 --- a/gnu/packages/parallel.scm +++ b/gnu/packages/parallel.scm @@ -27,7 +27,7 @@ (define-module (gnu packages parallel) (define-public parallel (package (name "parallel") - (version "20131222") + (version "20140122") (source (origin (method url-fetch) @@ -35,7 +35,7 @@ (define-public parallel version ".tar.bz2")) (sha256 (base32 - "08ggxb4id263623mr14clafsdl1n1zhfx13z3mn6kqbd4d6vwwk7")))) + "17y72p7qwr7n0qy9nzxwhcn3q47829fd0d69gql2x6szlsxkk0xi")))) (build-system gnu-build-system) (inputs `(("perl" ,perl))) (home-page "http://www.gnu.org/software/parallel/") -- cgit v1.2.3 From fe9aeab9dd1bd8de7e72e830cd6bc55d7051637b Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 25 Jan 2014 19:01:23 +0100 Subject: gnu: lightning: Update to 2.0.3. * gnu/packages/lightning.scm (lightning): Update to 2.0.3. --- gnu/packages/lightning.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/lightning.scm b/gnu/packages/lightning.scm index 8ec433e0b8..75681bf866 100644 --- a/gnu/packages/lightning.scm +++ b/gnu/packages/lightning.scm @@ -25,14 +25,14 @@ (define-module (gnu packages lightning) (define-public lightning (package (name "lightning") - (version "2.0.2") + (version "2.0.3") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/lightning/lightning-" version ".tar.gz")) (sha256 (base32 - "100ya7dx12403gimif7p2q7ahd8vxqrxpxqzqr1zqci825nb0b43")))) + "1mbbqia7ypvyrl15b15h0wxqbr153j7vlapjsv57lid88rr7c7ia")))) (build-system gnu-build-system) (synopsis "Library for generating assembly code at runtime") (description -- cgit v1.2.3 From daaa00c82ae6d3aa15cd3c9af653a14a700092c4 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 25 Jan 2014 19:06:02 +0100 Subject: gnu: global: Update to 6.2.10. * gnu/packages/global.scm (global): Update to 6.2.10. --- gnu/packages/global.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/global.scm b/gnu/packages/global.scm index 6244e2461e..01674f69c6 100644 --- a/gnu/packages/global.scm +++ b/gnu/packages/global.scm @@ -28,14 +28,14 @@ (define-module (gnu packages global) (define-public global ; a global variable (package (name "global") - (version "6.2.9") + (version "6.2.10") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/global/global-" version ".tar.gz")) (sha256 (base32 - "00y38kp0zbpjl9c9phldy7j2ihqc54qn4cdgk0azbjdsv75k3n6q")))) + "15nvz8g9b3s4i4fsa9ynrr8y517nfpy62agcvsl9rlz3j23b5b7f")))) (build-system gnu-build-system) (inputs `(("ncurses" ,ncurses) ("libtool" ,libtool))) -- cgit v1.2.3 From 1ca03c048bdb3365e35144c60df9aac77e3a446c Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sat, 25 Jan 2014 19:08:13 +0100 Subject: gnu: apl: Update to 1.2. * gnu/packages/apl.scm (apl): Update to 1.2. --- gnu/packages/apl.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/apl.scm b/gnu/packages/apl.scm index a2ef71f37f..17da73bd92 100644 --- a/gnu/packages/apl.scm +++ b/gnu/packages/apl.scm @@ -28,14 +28,14 @@ (define-module (gnu packages apl) (define-public apl (package (name "apl") - (version "1.1") + (version "1.2") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/apl/apl-" version ".tar.gz")) (sha256 (base32 - "1myinxa0m3y4fanpxflfakfk3m1s8641wdlbwbs0vg5yp10xm0m3")))) + "0v9jn4hrg4w3hyw4lsj8cys9aqsmrc1x4k0g5f67psgzgd45a4xb")))) (build-system gnu-build-system) (home-page "http://www.gnu.org/software/apl/") (inputs -- cgit v1.2.3 From 22f33e6112c2e58cf2f544296d6173b9b7ad49cb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 25 Jan 2014 22:16:52 +0100 Subject: gnu: sdl: Explicitly link against libXext. * gnu/packages/sdl.scm (sdl): Add #:configure-flags to 'arguments'. Move PKG-CONFIG to 'native-inputs'. --- gnu/packages/sdl.scm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/gnu/packages/sdl.scm b/gnu/packages/sdl.scm index 25ae1b0721..d86ecde38e 100644 --- a/gnu/packages/sdl.scm +++ b/gnu/packages/sdl.scm @@ -55,14 +55,21 @@ (define sdl (base32 "005d993xcac8236fpvd1iawkz4wqjybkpn8dbwaliqz5jfkidlyn")))) (build-system gnu-build-system) - (arguments '(#:tests? #f)) ; no check target + (arguments + '(;; Explicitly link against Xext because SDL tries to dlopen it and + ;; doesn't go very far otherwise (see + ;; + ;; for details.) + #:configure-flags '("LDFLAGS=-lXext") + + #:tests? #f)) ; no check target (propagated-inputs ;; SDL headers include X11 headers. `(("libx11" ,libx11))) + (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("libxrandr" ,libxrandr) ("mesa" ,mesa) ("alsa-lib" ,alsa-lib) - ("pkg-config" ,pkg-config) ("pulseaudio" ,pulseaudio))) (synopsis "Cross platform game development library") (description "Simple DirectMedia Layer is a cross-platform development -- cgit v1.2.3 From 566146abba4626bc02816118dd80bae68b8497d5 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 26 Jan 2014 13:03:20 +0100 Subject: gnu: lapack: Update to 3.5.0. * gnu/packages/maths.scm (lapack): Update to 3.5.0. --- gnu/packages/maths.scm | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index 640d502783..8844b4c7ba 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -163,7 +163,7 @@ (define-public pspp (define-public lapack (package (name "lapack") - (version "3.4.2") + (version "3.5.0") (source (origin (method url-fetch) @@ -171,16 +171,7 @@ (define-public lapack version ".tgz")) (sha256 (base32 - "1w7sf8888m7fi2kyx1fzgbm22193l8c2d53m8q1ibhvfy6m5v9k0")) - (snippet - ;; Remove non-free files. - ;; See . - '(for-each (lambda (file) - (format #t "removing '~a'~%" file) - (delete-file file)) - '("lapacke/example/example_DGESV_rowmajor.c" - "lapacke/example/example_ZGESV_rowmajor.c" - "DOCS/psfig.tex"))))) + "0lk3f97i9imqascnlf6wr5mjpyxqcdj73pgj97dj2mgvyg9z1n4s")))) (build-system cmake-build-system) (home-page "http://www.netlib.org/lapack/") (inputs `(("fortran" ,gfortran-4.8) -- cgit v1.2.3 From 70d1ce9afcd7454fc749cbfe0e0851d3e3e0312b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 26 Jan 2014 15:53:34 +0100 Subject: build: Set 'NIX_LIBEXEC_DIR' in 'pre-inst-env'. Reported by Nikita Karetnikov . * test-env.in: Move 'NIX_LIBEXEC_DIR' setting to... * pre-inst-env.in: ... here. --- pre-inst-env.in | 5 ++++- test-env.in | 7 ++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/pre-inst-env.in b/pre-inst-env.in index e90e1b0ac4..cd4ee01497 100644 --- a/pre-inst-env.in +++ b/pre-inst-env.in @@ -45,7 +45,10 @@ NIX_ROOT_FINDER="$abs_top_builddir/nix/scripts/list-runtime-roots" NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary" NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper" NIX_BUILD_HOOK="$abs_top_builddir/nix/scripts/offload" -export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS NIX_BUILD_HOOK +NIX_LIBEXEC_DIR="@abs_top_builddir@/nix/scripts" # for 'guix-authenticate' + +export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS \ + NIX_BUILD_HOOK NIX_LIBEXEC_DIR # The 'guix-register' program. GUIX_REGISTER="$abs_top_builddir/guix-register" diff --git a/test-env.in b/test-env.in index df73ecdc7a..9b5817f4ee 100644 --- a/test-env.in +++ b/test-env.in @@ -1,7 +1,7 @@ #!/bin/sh # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013 Ludovic Courtès +# Copyright © 2012, 2013, 2014 Ludovic Courtès # # This file is part of GNU Guix. # @@ -53,9 +53,6 @@ then chmod 400 "$NIX_CONF_DIR/signing-key.sec" fi - # For 'guix-authenticate'. - NIX_LIBEXEC_DIR="@abs_top_builddir@/nix/scripts" - # A place to store data of the substituter. GUIX_BINARY_SUBSTITUTE_URL="file://$NIX_STATE_DIR/substituter-data" rm -rf "$NIX_STATE_DIR/substituter-data" @@ -67,7 +64,7 @@ then export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR \ NIX_LOCALSTATE_DIR NIX_LOG_DIR NIX_STATE_DIR NIX_DB_DIR \ NIX_ROOT_FINDER NIX_SETUID_HELPER GUIX_BINARY_SUBSTITUTE_URL \ - NIX_CONF_DIR NIX_LIBEXEC_DIR XDG_CACHE_HOME + NIX_CONF_DIR XDG_CACHE_HOME # Do that because store.scm calls `canonicalize-path' on it. mkdir -p "$NIX_STORE_DIR" -- cgit v1.2.3 From 73fed4f868b9b0e9e34442917a48686630c7c56e Mon Sep 17 00:00:00 2001 From: John Darrington Date: Sun, 26 Jan 2014 10:09:21 +0100 Subject: gnu: Add gnuplot MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/maths.scm (gnuplot): New variable Signed-off-by: Ludovic Courtès --- gnu/packages/maths.scm | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index 8844b4c7ba..a916eb3f66 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -29,12 +29,14 @@ (define-module (gnu packages maths) #:use-module (gnu packages fontutils) #:use-module (gnu packages gettext) #:use-module (gnu packages gcc) + #:use-module (gnu packages gd) #:use-module (gnu packages gtk) #:use-module (gnu packages multiprecision) #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) #:use-module (gnu packages readline) + #:use-module (gnu packages texlive) #:use-module (gnu packages xml)) (define-public units @@ -193,3 +195,34 @@ (define-public lapack problems in numerical linear algebra.") (license (license:bsd-style "file://LICENSE" "See LICENSE in the distribution.")))) + +(define-public gnuplot + (package + (name "gnuplot") + (version "4.6.3") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/gnuplot/gnuplot/" + version "/gnuplot-" version ".tar.gz")) + (sha256 + (base32 + "1xd7gqdhlk7k1p9yyqf9vkk811nadc7m4si0q3nb6cpv4pxglpyz")))) + (build-system gnu-build-system) + (inputs `(("readline" ,readline) + ("cairo" ,cairo) + ("pango" ,pango) + ("gd" ,gd))) + (native-inputs `(("texlive" ,texlive) + ("pkg-config" ,pkg-config))) + (home-page "http://www.gnuplot.info") + (synopsis "Command-line driven graphing utility") + (description "Gnuplot is a portable command-line driven graphing +utility. It was originally created to allow scientists and students to +visualize mathematical functions and data interactively, but has grown to +support many non-interactive uses such as web scripting. It is also used as a +plotting engine by third-party applications like Octave.") + ;; X11 Style with the additional restriction that derived works may only be + ;; distributed as patches to the original. + (license (license:fsf-free + "http://gnuplot.cvs.sourceforge.net/gnuplot/gnuplot/Copyright")))) -- cgit v1.2.3 From 829c095dae47a18f17edc2a87d7910d59cc770bc Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 26 Jan 2014 23:25:55 +0100 Subject: gnu: qemu: Add note about 9p. * gnu/packages/qemu.scm (qemu/smb-shares): Add comment. --- gnu/packages/qemu.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/gnu/packages/qemu.scm b/gnu/packages/qemu.scm index 4212d74821..0c90d95129 100644 --- a/gnu/packages/qemu.scm +++ b/gnu/packages/qemu.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -132,6 +132,9 @@ (define-public qemu-headless (define-public qemu/smb-shares ;; A patched QEMU where `-net smb' yields two shares instead of one: one for ;; the store, and another one for exchanges with the host. + + ;; TODO: Use 9p/-virtfs instead of this SMB hack: + ;; . (package (inherit qemu-headless) (name "qemu-with-multiple-smb-shares") (source (origin (inherit (package-source qemu-headless)) -- cgit v1.2.3 From 5d80dd0823bab8483b31aea341d2ecabf54c3a23 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 26 Jan 2014 23:52:59 +0100 Subject: gnu: Add asciidoc. * gnu/packages/asciidoc.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. --- gnu-system.am | 1 + gnu/packages/asciidoc.scm | 52 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+) create mode 100644 gnu/packages/asciidoc.scm diff --git a/gnu-system.am b/gnu-system.am index a49b482549..473346c6ee 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -29,6 +29,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/algebra.scm \ gnu/packages/apl.scm \ gnu/packages/apr.scm \ + gnu/packages/asciidoc.scm \ gnu/packages/aspell.scm \ gnu/packages/attr.scm \ gnu/packages/autogen.scm \ diff --git a/gnu/packages/asciidoc.scm b/gnu/packages/asciidoc.scm new file mode 100644 index 0000000000..5bc5cfa7f9 --- /dev/null +++ b/gnu/packages/asciidoc.scm @@ -0,0 +1,52 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu packages asciidoc) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (gnu packages python) + #:use-module (guix build-system gnu) + #:autoload (gnu packages zip) (unzip)) + +(define-public asciidoc + (package + (name "asciidoc") + (version "8.6.9") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/asciidoc/asciidoc-" + version ".tar.gz")) + (sha256 + (base32 + "1w71nk527lq504njmaf0vzr93pgahkgzzxzglrq6bay8cw2rvnvq")))) + (build-system gnu-build-system) + (arguments '(#:tests? #f)) ; no 'check' target + (inputs `(("python" ,python-2))) + (home-page "http://www.methods.co.nz/asciidoc/") + (synopsis "Text-based document generation system") + (description + "AsciiDoc is a text document format for writing notes, documentation, +articles, books, ebooks, slideshows, web pages, man pages and blogs. +AsciiDoc files can be translated to many formats including HTML, PDF, +EPUB, man page. + +AsciiDoc is highly configurable: both the AsciiDoc source file syntax and +the backend output markups (which can be almost any type of SGML/XML +markup) can be customized and extended by the user.") + (license gpl2+))) -- cgit v1.2.3 From 7c0dbe780a09d2938af34f49ae40ce6def92064a Mon Sep 17 00:00:00 2001 From: Sree Harsha Totakura Date: Mon, 27 Jan 2014 17:45:21 +0100 Subject: gnu: linux: Add iotop-0.6. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/linux.scm (iotop): New variable. Signed-off-by: Ludovic Courtès --- gnu/packages/linux.scm | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 5e80a5837d..82d1d44269 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -30,6 +30,7 @@ (define-module (gnu packages linux) #:use-module (gnu packages bdb) #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) + #:use-module (gnu packages python) #:use-module (gnu packages algebra) #:use-module (gnu packages gettext) #:use-module (gnu packages pulseaudio) @@ -38,7 +39,8 @@ (define-module (gnu packages linux) #:use-module (gnu packages autotools) #:use-module (guix packages) #:use-module (guix download) - #:use-module (guix build-system gnu)) + #:use-module (guix build-system gnu) + #:use-module (guix build-system python)) (define-public (system->linux-architecture arch) "Return the Linux architecture name for ARCH, a Guix system name such as @@ -840,3 +842,28 @@ (define-public aumix "Aumix adjusts an audio mixer from X, the console, a terminal, the command line or a script.") (license gpl2+))) + +(define-public iotop + (package + (name "iotop") + (version "0.6") + (source + (origin + (method url-fetch) + (uri (string-append "http://guichaz.free.fr/iotop/files/iotop-" + version ".tar.gz")) + (sha256 (base32 + "1kp8mqg2pbxq4xzpianypadfxcsyfgwcaqgqia6h9fsq6zyh4z0s")))) + (build-system python-build-system) + (arguments + ;; The setup.py script expects python-2 + `(#:python ,python-2 + ;; There are currently no checks in the package + #:tests? #f)) + (native-inputs `(("python" ,python-2))) + (home-page "http://guichaz.free.fr/iotop/") + (synopsis + "Displays the IO activity of running processes") + (description + "Iotop is a Python program with a top like user interface to show the +processes currently causing I/O.") -- cgit v1.2.3 From 35cebf0166864f3cc519d9aed0d794d7bddf29df Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 27 Jan 2014 19:02:51 +0100 Subject: gnu: iotop: Fix typos. * gnu/packages/linux.scm (iotop): Fix typos introduced by myself. --- gnu/packages/linux.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 82d1d44269..7808cb108c 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -856,9 +856,9 @@ (define-public iotop "1kp8mqg2pbxq4xzpianypadfxcsyfgwcaqgqia6h9fsq6zyh4z0s")))) (build-system python-build-system) (arguments - ;; The setup.py script expects python-2 + ;; The setup.py script expects python-2. `(#:python ,python-2 - ;; There are currently no checks in the package + ;; There are currently no checks in the package. #:tests? #f)) (native-inputs `(("python" ,python-2))) (home-page "http://guichaz.free.fr/iotop/") @@ -867,3 +867,4 @@ (define-public iotop (description "Iotop is a Python program with a top like user interface to show the processes currently causing I/O.") + (license gpl2+))) -- cgit v1.2.3 From a76611c4359ca4d92483e500f2ce95053222661b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 27 Jan 2014 21:32:59 +0100 Subject: offload: Do not try to retrieve anything upon build failure. * guix/scripts/offload.scm (offload): Add 'log-port' keyword parameter. Handle log display here. Return the result of (close-pipe pipe). (process-request): Adjust 'offload' call site accordingly. Call 'retrieve-files' only when 'offload' returns zero; exit when 'offload' returns non-zero. --- guix/scripts/offload.scm | 45 ++++++++++++++++++++++++++++----------------- 1 file changed, 28 insertions(+), 17 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index d919ede3c7..1f68160785 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -170,9 +170,9 @@ (define (remote-pipe machine mode command) (define* (offload drv machine #:key print-build-trace? (max-silent-time 3600) - (build-timeout 7200)) + (build-timeout 7200) (log-port (current-output-port))) "Perform DRV on MACHINE, assuming DRV and its prerequisites are available -there. Return a read pipe from where to read the build log." +there, and write the build log to LOG-PORT. Return the exit status." (format (current-error-port) "offloading '~a' to '~a'...~%" (derivation-file-name drv) (build-machine-name machine)) (format (current-error-port) "@ build-remote ~a ~a~%" @@ -185,7 +185,13 @@ (define* (offload drv machine ,(format #f "--max-silent-time=~a" max-silent-time) ,(derivation-file-name drv))))) - pipe)) + (let loop ((line (read-line pipe))) + (unless (eof-object? line) + (display line log-port) + (newline log-port) + (loop (read-line pipe)))) + + (close-pipe pipe))) (define (send-files files machine) "Send the subset of FILES that's missing to MACHINE's store. Return #t on @@ -291,20 +297,25 @@ (define* (process-request wants-local? system drv features (outputs (string-tokenize (read-line)))) (when (send-files (cons (derivation-file-name drv) inputs) machine) - (let ((log (offload drv machine - #:print-build-trace? print-build-trace? - #:max-silent-time max-silent-time - #:build-timeout build-timeout))) - (let loop ((line (read-line log))) - (if (eof-object? line) - (close-pipe log) - (begin - (display line) (newline) - (loop (read-line log)))))) - (retrieve-files outputs machine))) - (format (current-error-port) "done with offloaded '~a'~%" - (derivation-file-name drv)) - (kill pid SIGTERM)) + (let ((status (offload drv machine + #:print-build-trace? print-build-trace? + #:max-silent-time max-silent-time + #:build-timeout build-timeout))) + (kill pid SIGTERM) + (if (zero? status) + (begin + (retrieve-files outputs machine) + (format (current-error-port) + "done with offloaded '~a'~%" + (derivation-file-name drv))) + (begin + (format (current-error-port) + "derivation '~a' offloaded to '~a' failed \ +with exit code ~a~%" + (derivation-file-name drv) + (build-machine-name machine) + (status:exit-val status)) + (primitive-exit (status:exit-val status)))))))) (#f (display "# decline\n"))) (display "# decline\n")))) -- cgit v1.2.3 From f06afd4da2be6571e7a78e9745907ee9afc57967 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 27 Jan 2014 23:31:28 +0100 Subject: download: Add archive.apache.org to the Apache mirrors. * guix/download.scm (%mirrors)[apache]: Add archive.apache.org as a last resort. --- guix/download.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/guix/download.scm b/guix/download.scm index 8a3e9fd06a..2cc8a4a5b8 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; Copyright © 2013 Andreas Enge ;;; ;;; This file is part of GNU Guix. @@ -108,7 +108,10 @@ (define %mirrors "ftp://gd.tuwien.ac.at/pub/infosys/servers/http/apache/dist/" "http://apache.belnet.be/" "http://mirrors.ircam.fr/pub/apache/" - "http://apache-mirror.rbc.ru/pub/apache/") + "http://apache-mirror.rbc.ru/pub/apache/" + + ;; As a last resort, try the archive. + "http://archive.apache.org/dist/") (xorg ; from http://www.x.org/wiki/Releases/Download "http://www.x.org/releases/" ; main mirrors "ftp://mirror.csclub.uwaterloo.ca/x.org/" ; North America -- cgit v1.2.3 From b0dd47a8d0c39dabf6d23aa24bf6a4ae650bd006 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 28 Jan 2014 23:38:19 +0100 Subject: gnu: qemu-initrd: Adjust to allow booting with a non-empty /root. * gnu/packages/linux-initrd.scm (qemu-initrd): Use 'mkdir-p' instead of 'mkdir' for /root/xchg and /root/{share,lib}. When TO-LOAD is a symlink, resolve it. (gnu-system-initrd): Fix typo in message. --- gnu/packages/linux-initrd.scm | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm index 0134e89da8..5495e16e30 100644 --- a/gnu/packages/linux-initrd.scm +++ b/gnu/packages/linux-initrd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -280,7 +280,7 @@ (define-public qemu-initrd (mount "none" "/root" "tmpfs")) (mount-essential-file-systems #:root "/root") - (mkdir "/root/xchg") + (mkdir-p "/root/xchg") (mkdir-p "/root/nix/store") (unless (file-exists? "/root/dev") @@ -294,8 +294,8 @@ (define-public qemu-initrd ;; Copy the directories that contain .scm and .go files so that the ;; child process in the chroot can load modules (we would bind-mount ;; them but for some reason that fails with EINVAL -- XXX). - (mkdir "/root/share") - (mkdir "/root/lib") + (mkdir-p "/root/share") + (mkdir-p "/root/lib") (mount "none" "/root/share" "tmpfs") (mount "none" "/root/lib" "tmpfs") (copy-recursively "/share" "/root/share" @@ -305,9 +305,17 @@ (define-public qemu-initrd (if to-load - (begin + (letrec ((resolve + (lambda (file) + ;; If FILE is a symlink to an absolute file name, + ;; resolve it as if we were under /root. + (let ((st (lstat file))) + (if (eq? 'symlink (stat:type st)) + (let ((target (readlink file))) + (resolve (string-append "/root" target))) + file))))) (format #t "loading boot file '~a'...\n" to-load) - (compile-file (string-append "/root/" to-load) + (compile-file (resolve (string-append "/root/" to-load)) #:output-file "/root/loader.go" #:opts %auto-compilation-options) (match (primitive-fork) @@ -392,7 +400,7 @@ (define-public gnu-system-initrd (sleep 2) (reboot)) (begin - (display "no init file passed via '--exec'\n") + (display "no init file passed via '--load'\n") (display "entering a warm and cozy REPL\n") ((@ (system repl repl) start-repl)))))) #:name "qemu-system-initrd" -- cgit v1.2.3 From 413d5351aa3dd3e122f807cb944405c156d254e3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 29 Jan 2014 13:04:48 +0100 Subject: monads: Add 'imported-modules' and 'compiled-modules'. * guix/monads.scm (package-file): Fix typo. (imported-modules, compiled-modules): New procedures. --- guix/monads.scm | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/guix/monads.scm b/guix/monads.scm index 410fdbecb2..ad80a0698d 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -57,7 +57,9 @@ (define-module (guix monads) package->derivation built-derivations derivation-expression - lower-inputs)) + lower-inputs) + #:replace (imported-modules + compiled-modules)) ;;; Commentary: ;;; @@ -310,7 +312,7 @@ (define* (text-file name text) (define* (package-file package #:optional file #:key (system (%current-system)) (output "out")) - "Return as a monadic value in the absolute file name of FILE within the + "Return as a monadic value the absolute file name of FILE within the OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the OUTPUT directory of PACKAGE." (lambda (store) @@ -342,6 +344,12 @@ (define derivation-expression (define package->derivation (store-lift package-derivation)) +(define imported-modules + (store-lift (@ (guix derivations) imported-modules))) + +(define compiled-modules + (store-lift (@ (guix derivations) compiled-modules))) + (define built-derivations (store-lift build-derivations)) -- cgit v1.2.3 From 735c6dd7faec036adbfa44d927c823ffa9ea1243 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 29 Jan 2014 13:04:00 +0100 Subject: gnu: Lower initrd makers from packages to monadic procedures. * gnu/packages/linux-initrd.scm: Remove. * gnu/system/linux-initrd.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Adjust accordingly. * gnu/system.scm (): Change default 'initrd' value to (gnu-system-initrd). (operating-system-derivation): Bind 'operating-system-initrd'. Pass 'menu-entry' an initrd file name instead of a package. * gnu/system/grub.scm (grub-configuration-file): Expect 'initrd' to be file name. --- gnu-system.am | 2 +- gnu/packages/linux-initrd.scm | 411 ------------------------------------------ gnu/system.scm | 15 +- gnu/system/grub.scm | 7 +- gnu/system/linux-initrd.scm | 360 ++++++++++++++++++++++++++++++++++++ gnu/system/vm.scm | 17 +- 6 files changed, 381 insertions(+), 431 deletions(-) delete mode 100644 gnu/packages/linux-initrd.scm create mode 100644 gnu/system/linux-initrd.scm diff --git a/gnu-system.am b/gnu-system.am index 473346c6ee..1f7327e865 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -128,7 +128,6 @@ GNU_SYSTEM_MODULES = \ gnu/packages/libunwind.scm \ gnu/packages/lightning.scm \ gnu/packages/linux.scm \ - gnu/packages/linux-initrd.scm \ gnu/packages/lout.scm \ gnu/packages/lsh.scm \ gnu/packages/lsof.scm \ @@ -221,6 +220,7 @@ GNU_SYSTEM_MODULES = \ gnu/system/dmd.scm \ gnu/system/grub.scm \ gnu/system/linux.scm \ + gnu/system/linux-initrd.scm \ gnu/system/shadow.scm \ gnu/system/vm.scm diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm deleted file mode 100644 index 5495e16e30..0000000000 --- a/gnu/packages/linux-initrd.scm +++ /dev/null @@ -1,411 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès -;;; -;;; 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 . - -(define-module (gnu packages linux-initrd) - #:use-module (guix utils) - #:use-module (guix licenses) - #:use-module (guix build-system) - #:use-module ((guix derivations) - #:select (imported-modules compiled-modules %guile-for-build)) - #:use-module (gnu packages) - #:use-module (gnu packages cpio) - #:use-module (gnu packages compression) - #:use-module (gnu packages linux) - #:use-module (gnu packages guile) - #:use-module ((gnu packages make-bootstrap) - #:select (%guile-static-stripped)) - #:use-module (guix packages) - #:use-module (guix download) - #:use-module (guix build-system trivial)) - - -;;; Commentary: -;;; -;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in -;;; particular initrd's that run Guile. -;;; -;;; Code: - - -(define-syntax-rule (raw-build-system (store system name inputs) body ...) - "Lift BODY to a package build system." - ;; TODO: Generalize. - (build-system - (name "raw") - (description "Raw build system") - (build (lambda* (store name source inputs #:key system #:allow-other-keys) - (parameterize ((%guile-for-build (package-derivation store - guile-2.0))) - body ...))))) - -(define (module-package modules) - "Return a package that contains all of MODULES, a list of Guile module -names." - (package - (name "guile-modules") - (version "0") - (source #f) - (build-system (raw-build-system (store system name inputs) - (imported-modules store modules - #:name name - #:system system))) - (synopsis "Set of Guile modules") - (description synopsis) - (license gpl3+) - (home-page "http://www.gnu.org/software/guix/"))) - -(define (compiled-module-package modules) - "Return a package that contains the .go files corresponding to MODULES, a -list of Guile module names." - (package - (name "guile-compiled-modules") - (version "0") - (source #f) - (build-system (raw-build-system (store system name inputs) - (compiled-modules store modules - #:name name - #:system system))) - (synopsis "Set of compiled Guile modules") - (description synopsis) - (license gpl3+) - (home-page "http://www.gnu.org/software/guix/"))) - -(define* (expression->initrd exp - #:key - (guile %guile-static-stripped) - (cpio cpio) - (gzip gzip) - (name "guile-initrd") - (system (%current-system)) - (modules '()) - (linux #f) - (linux-modules '())) - "Return a package that contains a Linux initrd (a gzipped cpio archive) -containing GUILE and that evaluates EXP upon booting. LINUX-MODULES is a list -of `.ko' file names to be copied from LINUX into the initrd. MODULES is a -list of Guile module names to be embedded in the initrd." - - ;; General Linux overview in `Documentation/early-userspace/README' and - ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. - - (define builder - `(begin - (use-modules (guix build utils) - (ice-9 pretty-print) - (ice-9 popen) - (ice-9 match) - (ice-9 ftw) - (srfi srfi-26) - (system base compile) - (rnrs bytevectors) - ((system foreign) #:select (sizeof))) - - (let ((guile (assoc-ref %build-inputs "guile")) - (cpio (string-append (assoc-ref %build-inputs "cpio") - "/bin/cpio")) - (gzip (string-append (assoc-ref %build-inputs "gzip") - "/bin/gzip")) - (modules (assoc-ref %build-inputs "modules")) - (gos (assoc-ref %build-inputs "modules/compiled")) - (scm-dir (string-append "share/guile/" (effective-version))) - (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a" - (effective-version) - (if (eq? (native-endianness) (endianness little)) - "LE" - "BE") - (sizeof '*) - (effective-version))) - (out (assoc-ref %outputs "out"))) - (mkdir out) - (mkdir "contents") - (with-directory-excursion "contents" - (copy-recursively guile ".") - (call-with-output-file "init" - (lambda (p) - (format p "#!/bin/guile -ds~%!#~%" guile) - (pretty-print ',exp p))) - (chmod "init" #o555) - (chmod "bin/guile" #o555) - - ;; Copy Guile modules. - (chmod scm-dir #o777) - (copy-recursively modules scm-dir - #:follow-symlinks? #t) - (copy-recursively gos (string-append "lib/guile/" - (effective-version) "/ccache") - #:follow-symlinks? #t) - - ;; Compile `init'. - (mkdir-p go-dir) - (set! %load-path (cons modules %load-path)) - (set! %load-compiled-path (cons gos %load-compiled-path)) - (compile-file "init" - #:opts %auto-compilation-options - #:output-file (string-append go-dir "/init.go")) - - ;; Copy Linux modules. - (let* ((linux (assoc-ref %build-inputs "linux")) - (module-dir (and linux - (string-append linux "/lib/modules")))) - (mkdir "modules") - ,@(map (lambda (module) - `(match (find-files module-dir ,module) - ((file) - (format #t "copying '~a'...~%" file) - (copy-file file (string-append "modules/" - ,module))) - (() - (error "module not found" ,module module-dir)) - ((_ ...) - (error "several modules by that name" - ,module module-dir)))) - linux-modules)) - - ;; Reset the timestamps of all the files that will make it in the - ;; initrd. - (for-each (cut utime <> 0 0 0 0) - (find-files "." ".*")) - - (system* cpio "--version") - (let ((pipe (open-pipe* OPEN_WRITE cpio "-o" - "-O" (string-append out "/initrd") - "-H" "newc" "--null"))) - (define print0 - (let ((len (string-length "./"))) - (lambda (file) - (format pipe "~a\0" (string-drop file len))))) - - ;; Note: as per `ramfs-rootfs-initramfs.txt', always add - ;; directory entries before the files that are inside of it: "The - ;; Linux kernel cpio extractor won't create files in a directory - ;; that doesn't exist, so the directory entries must go before - ;; the files that go in those directories." - (file-system-fold (const #t) - (lambda (file stat result) ; leaf - (print0 file)) - (lambda (dir stat result) ; down - (unless (string=? dir ".") - (print0 dir))) - (const #f) ; up - (const #f) ; skip - (const #f) - #f - ".") - - (and (zero? (close-pipe pipe)) - (with-directory-excursion out - (and (zero? (system* gzip "--best" "initrd")) - (rename-file "initrd.gz" "initrd"))))))))) - - (package - (name name) - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:modules ((guix build utils)) - #:builder ,builder)) - (inputs `(("guile" ,guile) - ("cpio" ,cpio) - ("gzip" ,gzip) - ("modules" ,(module-package modules)) - ("modules/compiled" ,(compiled-module-package modules)) - ,@(if linux - `(("linux" ,linux)) - '()))) - (synopsis "An initial RAM disk (initrd) for the Linux kernel") - (description - "An initial RAM disk (initrd), really a gzipped cpio archive, for use by -the Linux kernel.") - (license gpl3+) - (home-page "http://www.gnu.org/software/guix/"))) - -(define-public qemu-initrd - (expression->initrd - '(begin - (use-modules (srfi srfi-1) - (srfi srfi-26) - (ice-9 match) - ((system base compile) #:select (compile-file)) - (guix build utils) - (guix build linux-initrd)) - - (display "Welcome, this is GNU's early boot Guile.\n") - (display "Use '--repl' for an initrd REPL.\n\n") - - (mount-essential-file-systems) - (let* ((args (linux-command-line)) - (option (lambda (opt) - (let ((opt (string-append opt "="))) - (and=> (find (cut string-prefix? opt <>) - args) - (lambda (arg) - (substring arg (+ 1 (string-index arg #\=)))))))) - (to-load (option "--load")) - (root (option "--root"))) - - (when (member "--repl" args) - ((@ (system repl repl) start-repl))) - - (display "loading CIFS and companion modules...\n") - (for-each (compose load-linux-module* - (cut string-append "/modules/" <>)) - (list "md4.ko" "ecb.ko" "cifs.ko")) - - (unless (configure-qemu-networking) - (display "network interface is DOWN\n")) - - ;; Make /dev nodes. - (make-essential-device-nodes) - - ;; Prepare the real root file system under /root. - (unless (file-exists? "/root") - (mkdir "/root")) - (if root - (mount root "/root" "ext3") - (mount "none" "/root" "tmpfs")) - (mount-essential-file-systems #:root "/root") - - (mkdir-p "/root/xchg") - (mkdir-p "/root/nix/store") - - (unless (file-exists? "/root/dev") - (mkdir "/root/dev") - (make-essential-device-nodes #:root "/root")) - - ;; Mount the host's store and exchange directory. - (mount-qemu-smb-share "/store" "/root/nix/store") - (mount-qemu-smb-share "/xchg" "/root/xchg") - - ;; Copy the directories that contain .scm and .go files so that the - ;; child process in the chroot can load modules (we would bind-mount - ;; them but for some reason that fails with EINVAL -- XXX). - (mkdir-p "/root/share") - (mkdir-p "/root/lib") - (mount "none" "/root/share" "tmpfs") - (mount "none" "/root/lib" "tmpfs") - (copy-recursively "/share" "/root/share" - #:log (%make-void-port "w")) - (copy-recursively "/lib" "/root/lib" - #:log (%make-void-port "w")) - - - (if to-load - (letrec ((resolve - (lambda (file) - ;; If FILE is a symlink to an absolute file name, - ;; resolve it as if we were under /root. - (let ((st (lstat file))) - (if (eq? 'symlink (stat:type st)) - (let ((target (readlink file))) - (resolve (string-append "/root" target))) - file))))) - (format #t "loading boot file '~a'...\n" to-load) - (compile-file (resolve (string-append "/root/" to-load)) - #:output-file "/root/loader.go" - #:opts %auto-compilation-options) - (match (primitive-fork) - (0 - (chroot "/root") - (load-compiled "/loader.go") - - ;; TODO: Remove /lib, /share, and /loader.go. - ) - (pid - (format #t "boot file loaded under PID ~a~%" pid) - (let ((status (waitpid pid))) - (reboot))))) - (begin - (display "no boot file passed via '--load'\n") - (display "entering a warm and cozy REPL\n") - ((@ (system repl repl) start-repl)))))) - #:name "qemu-initrd" - #:modules '((guix build utils) - (guix build linux-initrd)) - #:linux linux-libre - #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko"))) - -(define-public gnu-system-initrd - ;; Initrd for the GNU system itself, with nothing QEMU-specific. - (expression->initrd - '(begin - (use-modules (srfi srfi-1) - (srfi srfi-26) - (ice-9 match) - (guix build utils) - (guix build linux-initrd)) - - (display "Welcome, this is GNU's early boot Guile.\n") - (display "Use '--repl' for an initrd REPL.\n\n") - - (mount-essential-file-systems) - (let* ((args (linux-command-line)) - (option (lambda (opt) - (let ((opt (string-append opt "="))) - (and=> (find (cut string-prefix? opt <>) - args) - (lambda (arg) - (substring arg (+ 1 (string-index arg #\=)))))))) - (to-load (option "--load")) - (root (option "--root"))) - - (when (member "--repl" args) - ((@ (system repl repl) start-repl))) - - ;; Make /dev nodes. - (make-essential-device-nodes) - - ;; Prepare the real root file system under /root. - (mkdir-p "/root") - (if root - ;; Assume ROOT has a usable /dev tree. - (mount root "/root" "ext3") - (begin - (mount "none" "/root" "tmpfs") - (make-essential-device-nodes #:root "/root"))) - - (mount-essential-file-systems #:root "/root") - - (mkdir-p "/root/tmp") - (mount "none" "/root/tmp" "tmpfs") - - ;; XXX: We don't copy our fellow Guile modules to /root (see - ;; 'qemu-initrd'), so if TO-LOAD tries to load a module (which can - ;; happen if it throws, to display the exception!), then we're - ;; screwed. Hopefully TO-LOAD is a simple expression that just does - ;; '(execlp ...)'. - - (if to-load - (begin - (format #t "loading '~a'...\n" to-load) - (chroot "/root") - (primitive-load to-load) - (format (current-error-port) - "boot program '~a' terminated, rebooting~%" - to-load) - (sleep 2) - (reboot)) - (begin - (display "no init file passed via '--load'\n") - (display "entering a warm and cozy REPL\n") - ((@ (system repl repl) start-repl)))))) - #:name "qemu-system-initrd" - #:modules '((guix build linux-initrd) - (guix build utils)) - #:linux linux-libre)) - -;;; linux-initrd.scm ends here diff --git a/gnu/system.scm b/gnu/system.scm index 6fd753f8fd..5fb4a7483e 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,7 +22,6 @@ (define-module (gnu system) #:use-module (guix records) #:use-module (guix packages) #:use-module (guix derivations) - #:use-module (gnu packages linux-initrd) #:use-module (gnu packages base) #:use-module (gnu packages bash) #:use-module (gnu packages admin) @@ -31,6 +30,7 @@ (define-module (gnu system) #:use-module (gnu system grub) #:use-module (gnu system shadow) #:use-module (gnu system linux) + #:use-module (gnu system linux-initrd) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -58,8 +58,8 @@ (define-record-type* operating-system (default grub)) (bootloader-entries operating-system-bootloader-entries ; list (default '())) - (initrd operating-system-initrd - (default gnu-system-initrd)) + (initrd operating-system-initrd ; monadic derivation + (default (gnu-system-initrd))) (host-name operating-system-host-name) ; string @@ -321,8 +321,9 @@ (define (operating-system-derivation os) "--config" ,dmd-conf)))) (kernel -> (operating-system-kernel os)) (kernel-dir (package-file kernel)) - (initrd -> (operating-system-initrd os)) - (initrd-file (package-file initrd)) + (initrd (operating-system-initrd os)) + (initrd-file -> (string-append (derivation->output-path initrd) + "/initrd")) (entries -> (list (menu-entry (label (string-append "GNU system with " @@ -331,7 +332,7 @@ (define (operating-system-derivation os) (linux kernel) (linux-arguments `("--root=/dev/vda1" ,(string-append "--load=" boot))) - (initrd initrd)))) + (initrd initrd-file)))) (grub.cfg (grub-configuration-file entries)) (extras (links (delete-duplicates (append (append-map service-inputs services) diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 86fa9b504d..5dc0b85ff2 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -41,7 +41,7 @@ (define-record-type* (linux menu-entry-linux) (linux-arguments menu-entry-linux-arguments (default '())) - (initrd menu-entry-initrd)) + (initrd menu-entry-initrd)) ; file name of the initrd (define* (grub-configuration-file entries #:key (default-entry 1) (timeout 5) @@ -66,10 +66,7 @@ (define entry->text (match-lambda (($ label linux arguments initrd) (mlet %store-monad ((linux (package-file linux "bzImage" - #:system system)) - (initrd (package-file initrd "initrd" #:system system))) - ;; XXX: Assume that INITRD is a directory containing an 'initrd' file. (return (format #f "menuentry ~s { linux ~a ~a initrd ~a diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm new file mode 100644 index 0000000000..a28b913c3e --- /dev/null +++ b/gnu/system/linux-initrd.scm @@ -0,0 +1,360 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu system linux-initrd) + #:use-module (guix monads) + #:use-module (guix utils) + #:use-module (gnu packages cpio) + #:use-module (gnu packages compression) + #:use-module (gnu packages linux) + #:use-module (gnu packages guile) + #:use-module ((gnu packages make-bootstrap) + #:select (%guile-static-stripped)) + #:export (expression->initrd + qemu-initrd + gnu-system-initrd)) + + +;;; Commentary: +;;; +;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in +;;; particular initrd's that run Guile. +;;; +;;; Code: + + +(define* (expression->initrd exp + #:key + (guile %guile-static-stripped) + (cpio cpio) + (gzip gzip) + (name "guile-initrd") + (system (%current-system)) + (modules '()) + (linux #f) + (linux-modules '())) + "Return a package that contains a Linux initrd (a gzipped cpio archive) +containing GUILE and that evaluates EXP upon booting. LINUX-MODULES is a list +of `.ko' file names to be copied from LINUX into the initrd. MODULES is a +list of Guile module names to be embedded in the initrd." + + ;; General Linux overview in `Documentation/early-userspace/README' and + ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. + + (define builder + `(begin + (use-modules (guix build utils) + (ice-9 pretty-print) + (ice-9 popen) + (ice-9 match) + (ice-9 ftw) + (srfi srfi-26) + (system base compile) + (rnrs bytevectors) + ((system foreign) #:select (sizeof))) + + (let ((guile (assoc-ref %build-inputs "guile")) + (cpio (string-append (assoc-ref %build-inputs "cpio") + "/bin/cpio")) + (gzip (string-append (assoc-ref %build-inputs "gzip") + "/bin/gzip")) + (modules (assoc-ref %build-inputs "modules")) + (gos (assoc-ref %build-inputs "modules/compiled")) + (scm-dir (string-append "share/guile/" (effective-version))) + (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a" + (effective-version) + (if (eq? (native-endianness) (endianness little)) + "LE" + "BE") + (sizeof '*) + (effective-version))) + (out (assoc-ref %outputs "out"))) + (mkdir out) + (mkdir "contents") + (with-directory-excursion "contents" + (copy-recursively guile ".") + (call-with-output-file "init" + (lambda (p) + (format p "#!/bin/guile -ds~%!#~%" guile) + (pretty-print ',exp p))) + (chmod "init" #o555) + (chmod "bin/guile" #o555) + + ;; Copy Guile modules. + (chmod scm-dir #o777) + (copy-recursively modules scm-dir + #:follow-symlinks? #t) + (copy-recursively gos (string-append "lib/guile/" + (effective-version) "/ccache") + #:follow-symlinks? #t) + + ;; Compile `init'. + (mkdir-p go-dir) + (set! %load-path (cons modules %load-path)) + (set! %load-compiled-path (cons gos %load-compiled-path)) + (compile-file "init" + #:opts %auto-compilation-options + #:output-file (string-append go-dir "/init.go")) + + ;; Copy Linux modules. + (let* ((linux (assoc-ref %build-inputs "linux")) + (module-dir (and linux + (string-append linux "/lib/modules")))) + (mkdir "modules") + ,@(map (lambda (module) + `(match (find-files module-dir ,module) + ((file) + (format #t "copying '~a'...~%" file) + (copy-file file (string-append "modules/" + ,module))) + (() + (error "module not found" ,module module-dir)) + ((_ ...) + (error "several modules by that name" + ,module module-dir)))) + linux-modules)) + + ;; Reset the timestamps of all the files that will make it in the + ;; initrd. + (for-each (cut utime <> 0 0 0 0) + (find-files "." ".*")) + + (system* cpio "--version") + (let ((pipe (open-pipe* OPEN_WRITE cpio "-o" + "-O" (string-append out "/initrd") + "-H" "newc" "--null"))) + (define print0 + (let ((len (string-length "./"))) + (lambda (file) + (format pipe "~a\0" (string-drop file len))))) + + ;; Note: as per `ramfs-rootfs-initramfs.txt', always add + ;; directory entries before the files that are inside of it: "The + ;; Linux kernel cpio extractor won't create files in a directory + ;; that doesn't exist, so the directory entries must go before + ;; the files that go in those directories." + (file-system-fold (const #t) + (lambda (file stat result) ; leaf + (print0 file)) + (lambda (dir stat result) ; down + (unless (string=? dir ".") + (print0 dir))) + (const #f) ; up + (const #f) ; skip + (const #f) + #f + ".") + + (and (zero? (close-pipe pipe)) + (with-directory-excursion out + (and (zero? (system* gzip "--best" "initrd")) + (rename-file "initrd.gz" "initrd"))))))))) + + (mlet* %store-monad + ((source (imported-modules modules)) + (compiled (compiled-modules modules)) + (inputs (lower-inputs + `(("guile" ,guile) + ("cpio" ,cpio) + ("gzip" ,gzip) + ("modules" ,source) + ("modules/compiled" ,compiled) + ,@(if linux + `(("linux" ,linux)) + '()))))) + (derivation-expression name builder + #:modules '((guix build utils)) + #:inputs inputs))) + +(define (qemu-initrd) + "Return a monadic derivation that builds an initrd for use in a QEMU guest +where the store is shared with the host." + (expression->initrd + '(begin + (use-modules (srfi srfi-1) + (srfi srfi-26) + (ice-9 match) + ((system base compile) #:select (compile-file)) + (guix build utils) + (guix build linux-initrd)) + + (display "Welcome, this is GNU's early boot Guile.\n") + (display "Use '--repl' for an initrd REPL.\n\n") + + (mount-essential-file-systems) + (let* ((args (linux-command-line)) + (option (lambda (opt) + (let ((opt (string-append opt "="))) + (and=> (find (cut string-prefix? opt <>) + args) + (lambda (arg) + (substring arg (+ 1 (string-index arg #\=)))))))) + (to-load (option "--load")) + (root (option "--root"))) + + (when (member "--repl" args) + ((@ (system repl repl) start-repl))) + + (display "loading CIFS and companion modules...\n") + (for-each (compose load-linux-module* + (cut string-append "/modules/" <>)) + (list "md4.ko" "ecb.ko" "cifs.ko")) + + (unless (configure-qemu-networking) + (display "network interface is DOWN\n")) + + ;; Make /dev nodes. + (make-essential-device-nodes) + + ;; Prepare the real root file system under /root. + (unless (file-exists? "/root") + (mkdir "/root")) + (if root + (mount root "/root" "ext3") + (mount "none" "/root" "tmpfs")) + (mount-essential-file-systems #:root "/root") + + (mkdir-p "/root/xchg") + (mkdir-p "/root/nix/store") + + (unless (file-exists? "/root/dev") + (mkdir "/root/dev") + (make-essential-device-nodes #:root "/root")) + + ;; Mount the host's store and exchange directory. + (mount-qemu-smb-share "/store" "/root/nix/store") + (mount-qemu-smb-share "/xchg" "/root/xchg") + + ;; Copy the directories that contain .scm and .go files so that the + ;; child process in the chroot can load modules (we would bind-mount + ;; them but for some reason that fails with EINVAL -- XXX). + (mkdir-p "/root/share") + (mkdir-p "/root/lib") + (mount "none" "/root/share" "tmpfs") + (mount "none" "/root/lib" "tmpfs") + (copy-recursively "/share" "/root/share" + #:log (%make-void-port "w")) + (copy-recursively "/lib" "/root/lib" + #:log (%make-void-port "w")) + + + (if to-load + (letrec ((resolve + (lambda (file) + ;; If FILE is a symlink to an absolute file name, + ;; resolve it as if we were under /root. + (let ((st (lstat file))) + (if (eq? 'symlink (stat:type st)) + (let ((target (readlink file))) + (resolve (string-append "/root" target))) + file))))) + (format #t "loading boot file '~a'...\n" to-load) + (compile-file (resolve (string-append "/root/" to-load)) + #:output-file "/root/loader.go" + #:opts %auto-compilation-options) + (match (primitive-fork) + (0 + (chroot "/root") + (load-compiled "/loader.go") + + ;; TODO: Remove /lib, /share, and /loader.go. + ) + (pid + (format #t "boot file loaded under PID ~a~%" pid) + (let ((status (waitpid pid))) + (reboot))))) + (begin + (display "no boot file passed via '--load'\n") + (display "entering a warm and cozy REPL\n") + ((@ (system repl repl) start-repl)))))) + #:name "qemu-initrd" + #:modules '((guix build utils) + (guix build linux-initrd)) + #:linux linux-libre + #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko"))) + +(define (gnu-system-initrd) + "Initrd for the GNU system itself, with nothing QEMU-specific." + (expression->initrd + '(begin + (use-modules (srfi srfi-1) + (srfi srfi-26) + (ice-9 match) + (guix build utils) + (guix build linux-initrd)) + + (display "Welcome, this is GNU's early boot Guile.\n") + (display "Use '--repl' for an initrd REPL.\n\n") + + (mount-essential-file-systems) + (let* ((args (linux-command-line)) + (option (lambda (opt) + (let ((opt (string-append opt "="))) + (and=> (find (cut string-prefix? opt <>) + args) + (lambda (arg) + (substring arg (+ 1 (string-index arg #\=)))))))) + (to-load (option "--load")) + (root (option "--root"))) + + (when (member "--repl" args) + ((@ (system repl repl) start-repl))) + + ;; Make /dev nodes. + (make-essential-device-nodes) + + ;; Prepare the real root file system under /root. + (mkdir-p "/root") + (if root + ;; Assume ROOT has a usable /dev tree. + (mount root "/root" "ext3") + (begin + (mount "none" "/root" "tmpfs") + (make-essential-device-nodes #:root "/root"))) + + (mount-essential-file-systems #:root "/root") + + (mkdir-p "/root/tmp") + (mount "none" "/root/tmp" "tmpfs") + + ;; XXX: We don't copy our fellow Guile modules to /root (see + ;; 'qemu-initrd'), so if TO-LOAD tries to load a module (which can + ;; happen if it throws, to display the exception!), then we're + ;; screwed. Hopefully TO-LOAD is a simple expression that just does + ;; '(execlp ...)'. + + (if to-load + (begin + (format #t "loading '~a'...\n" to-load) + (chroot "/root") + (primitive-load to-load) + (format (current-error-port) + "boot program '~a' terminated, rebooting~%" + to-load) + (sleep 2) + (reboot)) + (begin + (display "no init file passed via '--load'\n") + (display "entering a warm and cozy REPL\n") + ((@ (system repl repl) start-repl)))))) + #:name "qemu-system-initrd" + #:modules '((guix build linux-initrd) + (guix build utils)) + #:linux linux-libre)) + +;;; linux-initrd.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index e75c09d859..fa93654144 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -35,7 +35,6 @@ (define-module (gnu system vm) #:use-module (gnu packages zile) #:use-module (gnu packages grub) #:use-module (gnu packages linux) - #:use-module (gnu packages linux-initrd) #:use-module (gnu packages package-management) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) @@ -43,6 +42,7 @@ (define-module (gnu system vm) #:use-module (gnu system shadow) #:use-module (gnu system linux) + #:use-module (gnu system linux-initrd) #:use-module (gnu system grub) #:use-module (gnu system dmd) #:use-module (gnu system) @@ -67,7 +67,7 @@ (define* (expression->derivation-in-linux-vm name exp (system (%current-system)) (inputs '()) (linux linux-libre) - (initrd qemu-initrd) + initrd (qemu qemu/smb-shares) (env-vars '()) (modules '()) @@ -78,10 +78,10 @@ (define* (expression->derivation-in-linux-vm name exp (references-graphs #f) (disk-image-size (* 100 (expt 2 20)))) - "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD. In the -virtual machine, EXP has access to all of INPUTS from the store; it should put -its output files in the `/xchg' directory, which is copied to the derivation's -output when the VM terminates. + "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a +derivation). In the virtual machine, EXP has access to all of INPUTS from the +store; it should put its output files in the `/xchg' directory, which is +copied to the derivation's output when the VM terminates. When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of DISK-IMAGE-SIZE bytes and return it. @@ -178,6 +178,9 @@ (define builder (user-builder (text-file "builder-in-linux-vm" (object->string exp*))) (coreutils -> (car (assoc-ref %final-inputs "coreutils"))) + (initrd (if initrd + (return initrd) + (qemu-initrd))) ; default initrd (inputs (lower-inputs `(("qemu" ,qemu) ("linux" ,linux) ("initrd" ,initrd) -- cgit v1.2.3 From d4254711821f7df93e33aa4a3f6484b901c7b5e3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 29 Jan 2014 21:57:56 +0100 Subject: gnu: linux-initrd: Factorize boot code. * guix/build/linux-initrd.scm (boot-system): New procedure. * gnu/system/linux-initrd.scm (qemu-initrd): Add keyword parameters 'guile-modules-in-chroot?' and 'mounts'. Change builder to simply call 'boot-system'. (gnu-system-initrd): Change to a simple call to 'qemu-initrd'. * gnu/system/vm.scm (expression->derivation-in-linux-vm): Call 'qemu-initrd' with #:guile-modules-in-chroot?. --- gnu/system/linux-initrd.scm | 192 +++++++------------------------------------- gnu/system/vm.scm | 4 +- guix/build/linux-initrd.scm | 121 +++++++++++++++++++++++++++- 3 files changed, 152 insertions(+), 165 deletions(-) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index a28b913c3e..ea9d708dac 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -19,6 +19,8 @@ (define-module (gnu system linux-initrd) #:use-module (guix monads) #:use-module (guix utils) + #:use-module ((guix store) + #:select (%store-prefix)) #:use-module (gnu packages cpio) #:use-module (gnu packages compression) #:use-module (gnu packages linux) @@ -181,180 +183,46 @@ (define print0 #:modules '((guix build utils)) #:inputs inputs))) -(define (qemu-initrd) +(define* (qemu-initrd #:key + guile-modules-in-chroot? + (mounts `((cifs "/store" ,(%store-prefix)) + (cifs "/xchg" "/xchg")))) "Return a monadic derivation that builds an initrd for use in a QEMU guest -where the store is shared with the host." - (expression->initrd - '(begin - (use-modules (srfi srfi-1) - (srfi srfi-26) - (ice-9 match) - ((system base compile) #:select (compile-file)) - (guix build utils) - (guix build linux-initrd)) - - (display "Welcome, this is GNU's early boot Guile.\n") - (display "Use '--repl' for an initrd REPL.\n\n") - - (mount-essential-file-systems) - (let* ((args (linux-command-line)) - (option (lambda (opt) - (let ((opt (string-append opt "="))) - (and=> (find (cut string-prefix? opt <>) - args) - (lambda (arg) - (substring arg (+ 1 (string-index arg #\=)))))))) - (to-load (option "--load")) - (root (option "--root"))) - - (when (member "--repl" args) - ((@ (system repl repl) start-repl))) - - (display "loading CIFS and companion modules...\n") - (for-each (compose load-linux-module* - (cut string-append "/modules/" <>)) - (list "md4.ko" "ecb.ko" "cifs.ko")) - - (unless (configure-qemu-networking) - (display "network interface is DOWN\n")) +where the store is shared with the host. MOUNTS is a list of file systems to +be mounted atop the root file system, where each item has the form: - ;; Make /dev nodes. - (make-essential-device-nodes) + (FILE-SYSTEM-TYPE SOURCE TARGET) - ;; Prepare the real root file system under /root. - (unless (file-exists? "/root") - (mkdir "/root")) - (if root - (mount root "/root" "ext3") - (mount "none" "/root" "tmpfs")) - (mount-essential-file-systems #:root "/root") +When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in +the new root. This is necessary is the file specified as '--load' needs +access to these modules (which is the case if it wants to even just print an +exception and backtrace!)." + (define cifs-modules + ;; Modules needed to mount CIFS file systems. + '("md4.ko" "ecb.ko" "cifs.ko")) - (mkdir-p "/root/xchg") - (mkdir-p "/root/nix/store") + (define linux-modules + ;; Modules added to the initrd and loaded from the initrd. + (if (assoc-ref mounts 'cifs) + cifs-modules + '())) - (unless (file-exists? "/root/dev") - (mkdir "/root/dev") - (make-essential-device-nodes #:root "/root")) - - ;; Mount the host's store and exchange directory. - (mount-qemu-smb-share "/store" "/root/nix/store") - (mount-qemu-smb-share "/xchg" "/root/xchg") - - ;; Copy the directories that contain .scm and .go files so that the - ;; child process in the chroot can load modules (we would bind-mount - ;; them but for some reason that fails with EINVAL -- XXX). - (mkdir-p "/root/share") - (mkdir-p "/root/lib") - (mount "none" "/root/share" "tmpfs") - (mount "none" "/root/lib" "tmpfs") - (copy-recursively "/share" "/root/share" - #:log (%make-void-port "w")) - (copy-recursively "/lib" "/root/lib" - #:log (%make-void-port "w")) - - - (if to-load - (letrec ((resolve - (lambda (file) - ;; If FILE is a symlink to an absolute file name, - ;; resolve it as if we were under /root. - (let ((st (lstat file))) - (if (eq? 'symlink (stat:type st)) - (let ((target (readlink file))) - (resolve (string-append "/root" target))) - file))))) - (format #t "loading boot file '~a'...\n" to-load) - (compile-file (resolve (string-append "/root/" to-load)) - #:output-file "/root/loader.go" - #:opts %auto-compilation-options) - (match (primitive-fork) - (0 - (chroot "/root") - (load-compiled "/loader.go") + (expression->initrd + `(begin + (use-modules (guix build linux-initrd)) - ;; TODO: Remove /lib, /share, and /loader.go. - ) - (pid - (format #t "boot file loaded under PID ~a~%" pid) - (let ((status (waitpid pid))) - (reboot))))) - (begin - (display "no boot file passed via '--load'\n") - (display "entering a warm and cozy REPL\n") - ((@ (system repl repl) start-repl)))))) + (boot-system #:mounts ',mounts + #:linux-modules ',linux-modules + #:qemu-guest-networking? #t + #:guile-modules-in-chroot? ',guile-modules-in-chroot?)) #:name "qemu-initrd" #:modules '((guix build utils) (guix build linux-initrd)) #:linux linux-libre - #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko"))) + #:linux-modules linux-modules)) (define (gnu-system-initrd) "Initrd for the GNU system itself, with nothing QEMU-specific." - (expression->initrd - '(begin - (use-modules (srfi srfi-1) - (srfi srfi-26) - (ice-9 match) - (guix build utils) - (guix build linux-initrd)) - - (display "Welcome, this is GNU's early boot Guile.\n") - (display "Use '--repl' for an initrd REPL.\n\n") - - (mount-essential-file-systems) - (let* ((args (linux-command-line)) - (option (lambda (opt) - (let ((opt (string-append opt "="))) - (and=> (find (cut string-prefix? opt <>) - args) - (lambda (arg) - (substring arg (+ 1 (string-index arg #\=)))))))) - (to-load (option "--load")) - (root (option "--root"))) - - (when (member "--repl" args) - ((@ (system repl repl) start-repl))) - - ;; Make /dev nodes. - (make-essential-device-nodes) - - ;; Prepare the real root file system under /root. - (mkdir-p "/root") - (if root - ;; Assume ROOT has a usable /dev tree. - (mount root "/root" "ext3") - (begin - (mount "none" "/root" "tmpfs") - (make-essential-device-nodes #:root "/root"))) - - (mount-essential-file-systems #:root "/root") - - (mkdir-p "/root/tmp") - (mount "none" "/root/tmp" "tmpfs") - - ;; XXX: We don't copy our fellow Guile modules to /root (see - ;; 'qemu-initrd'), so if TO-LOAD tries to load a module (which can - ;; happen if it throws, to display the exception!), then we're - ;; screwed. Hopefully TO-LOAD is a simple expression that just does - ;; '(execlp ...)'. - - (if to-load - (begin - (format #t "loading '~a'...\n" to-load) - (chroot "/root") - (primitive-load to-load) - (format (current-error-port) - "boot program '~a' terminated, rebooting~%" - to-load) - (sleep 2) - (reboot)) - (begin - (display "no init file passed via '--load'\n") - (display "entering a warm and cozy REPL\n") - ((@ (system repl repl) start-repl)))))) - #:name "qemu-system-initrd" - #:modules '((guix build linux-initrd) - (guix build utils)) - #:linux linux-libre)) + (qemu-initrd #:guile-modules-in-chroot? #f)) ;;; linux-initrd.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index fa93654144..151535303a 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -178,9 +178,9 @@ (define builder (user-builder (text-file "builder-in-linux-vm" (object->string exp*))) (coreutils -> (car (assoc-ref %final-inputs "coreutils"))) - (initrd (if initrd + (initrd (if initrd ; use the default initrd? (return initrd) - (qemu-initrd))) ; default initrd + (qemu-initrd #:guile-modules-in-chroot? #t))) (inputs (lower-inputs `(("qemu" ,qemu) ("linux" ,linux) ("initrd" ,initrd) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index ae18a16e11..039a60acf3 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -19,6 +19,12 @@ (define-module (guix build linux-initrd) #:use-module (rnrs io ports) #:use-module (system foreign) + #: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 (guix build utils) #:export (mount-essential-file-systems linux-command-line make-essential-device-nodes @@ -26,7 +32,8 @@ (define-module (guix build linux-initrd) mount-qemu-smb-share bind-mount load-linux-module* - device-number)) + device-number + boot-system)) ;;; Commentary: ;;; @@ -151,4 +158,116 @@ (define (device-number major minor) the last argument of `mknod'." (+ (* major 256) minor)) +(define* (boot-system #:key + (linux-modules '()) + qemu-guest-networking? + guile-modules-in-chroot? + (mounts '())) + "This procedure is meant to be called from an initrd. Boot a system by +first loading LINUX-MODULES, then setting up QEMU guest networking if +QEMU-GUEST-NETWORKING? is true, mounting the file systems specified in MOUNTS, +and finally booting into the new root if any. The initrd supports kernel +command-line options '--load', '--root', and '--repl'. + +MOUNTS must be a list of elements of the form: + + (FILE-SYSTEM-TYPE SOURCE TARGET) + +When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in +the new root." + (define (resolve file) + ;; If FILE is a symlink to an absolute file name, resolve it as if we were + ;; under /root. + (let ((st (lstat file))) + (if (eq? 'symlink (stat:type st)) + (let ((target (readlink file))) + (resolve (string-append "/root" target))) + file))) + + (display "Welcome, this is GNU's early boot Guile.\n") + (display "Use '--repl' for an initrd REPL.\n\n") + + (mount-essential-file-systems) + (let* ((args (linux-command-line)) + (option (lambda (opt) + (let ((opt (string-append opt "="))) + (and=> (find (cut string-prefix? opt <>) + args) + (lambda (arg) + (substring arg (+ 1 (string-index arg #\=)))))))) + (to-load (option "--load")) + (root (option "--root"))) + + (when (member "--repl" args) + (start-repl)) + + (display "loading kernel modules...\n") + (for-each (compose load-linux-module* + (cut string-append "/modules/" <>)) + linux-modules) + + (when qemu-guest-networking? + (unless (configure-qemu-networking) + (display "network interface is DOWN\n"))) + + ;; Make /dev nodes. + (make-essential-device-nodes) + + ;; Prepare the real root file system under /root. + (unless (file-exists? "/root") + (mkdir "/root")) + (if root + (mount root "/root" "ext3") + (mount "none" "/root" "tmpfs")) + (mount-essential-file-systems #:root "/root") + + (unless (file-exists? "/root/dev") + (mkdir "/root/dev") + (make-essential-device-nodes #:root "/root")) + + ;; Mount the specified file systems. + (for-each (match-lambda + (('cifs source target) + (let ((target (string-append "/root/" target))) + (mkdir-p target) + (mount-qemu-smb-share source target))) + ;; TODO: Add 9p. + ) + mounts) + + (when guile-modules-in-chroot? + ;; Copy the directories that contain .scm and .go files so that the + ;; child process in the chroot can load modules (we would bind-mount + ;; them but for some reason that fails with EINVAL -- XXX). + (mkdir-p "/root/share") + (mkdir-p "/root/lib") + (mount "none" "/root/share" "tmpfs") + (mount "none" "/root/lib" "tmpfs") + (copy-recursively "/share" "/root/share" + #:log (%make-void-port "w")) + (copy-recursively "/lib" "/root/lib" + #:log (%make-void-port "w"))) + + (if to-load + (begin + (format #t "loading '~a'...\n" to-load) + (chroot "/root") + ;; TODO: Remove /lib, /share, and /loader.go. + (catch #t + (lambda () + (primitive-load to-load)) + (lambda args + (format (current-error-port) "'~a' raised an exception: ~s~%" + to-load args) + (start-repl))) + (format (current-error-port) + "boot program '~a' terminated, rebooting~%" + to-load) + (sleep 2) + (reboot)) + (begin + (display "no boot file passed via '--load'\n") + (display "entering a warm and cozy REPL\n") + (start-repl))))) + ;;; linux-initrd.scm ends here -- cgit v1.2.3 From 610b5cd8a11b075aae7fc179e232b6133ae863a4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 29 Jan 2014 22:37:53 +0100 Subject: gnu: libgcrypt: Upgrade to 1.6.1. * gnu/packages/gnupg.scm (libgcrypt): Upgrade to 1.6.1. --- gnu/packages/gnupg.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index ed5209edc4..82293fbabd 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -65,14 +65,14 @@ (define-public libgpg-error (define-public libgcrypt (package (name "libgcrypt") - (version "1.6.0") + (version "1.6.1") (source (origin (method url-fetch) (uri (string-append "mirror://gnupg/libgcrypt/libgcrypt-" version ".tar.bz2")) (sha256 (base32 - "024plbybsmnxbp39hs92lp6dzvkz2cb70nv69qrwr55d02350bb6")))) + "0w10vhpj1r5nq7qm6jp21p1v1vhf37701cw8yilygzzqd7mfzhx1")))) (build-system gnu-build-system) (propagated-inputs `(("libgpg-error" ,libgpg-error))) -- cgit v1.2.3 From a85cb4864382e0e97fca86589ff94af5d3fcb679 Mon Sep 17 00:00:00 2001 From: Sree Harsha Totakura Date: Wed, 29 Jan 2014 13:59:11 +0100 Subject: gnu: gnunet: Add gnurl 7.34.0. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/gnunet.scm (gnurl): New variable. Thanks to Zerwas for the initial recipe. Co-authored-by: Ludovic Courtès Signed-off-by: Ludovic Courtès --- gnu/packages/gnunet.scm | 61 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/gnu/packages/gnunet.scm b/gnu/packages/gnunet.scm index 52a434a61c..6af9063f19 100644 --- a/gnu/packages/gnunet.scm +++ b/gnu/packages/gnunet.scm @@ -25,11 +25,15 @@ (define-module (gnu packages gnunet) #:use-module (gnu packages glib) #:use-module (gnu packages gnupg) #:use-module (gnu packages gnutls) + #:use-module (gnu packages groff) #:use-module (gnu packages gstreamer) + #:use-module (gnu packages libidn) #:use-module (gnu packages libjpeg) #:use-module (gnu packages libtiff) #:use-module (gnu packages openssl) #:use-module (gnu packages pkg-config) + #:use-module (gnu packages perl) + #:use-module (gnu packages python) #:use-module (gnu packages video) #:use-module (gnu packages xiph) #:use-module ((guix licenses) @@ -123,3 +127,60 @@ (define-public libmicrohttpd and support for SSL3 and TLS.") (license license:lgpl2.1+) (home-page "http://www.gnu.org/software/libmicrohttpd/"))) + +(define-public gnurl + (package + (name "gnurl") + (version "7.34.0") + (source (origin + (method url-fetch) + (uri (string-append "https://gnunet.org/sites/default/files/gnurl-" + version ".tar.bz2")) + (sha256 + (base32 + "0kpi9wx9lg938b982smjg54acdwswdshs2bzf10sj5r6zmb05ygp")))) + (build-system gnu-build-system) + (inputs `(("gnutls" ,gnutls) + ("libidn" ,libidn) + ("zlib" ,zlib))) + (native-inputs + `(("perl" ,perl) + ("groff" ,groff) + ("python" ,python-2))) + (arguments + `(#:configure-flags '("--enable-ipv6" "--with-gnutls" "--without-libssh2" + "--without-libmetalink" "--without-winidn" + "--without-librtmp" "--without-nghttp2" + "--without-nss" "--without-cyassl" + "--without-polarssl" "--without-ssl" + "--without-winssl" "--without-darwinssl" + "--disable-sspi" "--disable-ntlm-wb" + "--disable-ldap" "--disable-rtsp" "--disable-dict" + "--disable-telnet" "--disable-tftp" "--disable-pop3" + "--disable-imap" "--disable-smtp" "--disable-gopher" + "--disable-file" "--disable-ftp") + #:test-target "test" + #:parallel-tests? #f + ;; We have to patch runtests.pl in tests/ directory and add a failing + ;; test due to curl->gnurl name change to tests/data/DISABLED + #:phases + (alist-cons-before + 'check 'patch-runtests + (lambda _ + (with-directory-excursion "tests" + (substitute* "runtests.pl" + (("/bin/sh") + (which "sh"))) + (let* ((port (open-file "data/DISABLED" "a"))) + (newline port) + (display "1022" port) + (close port)))) + %standard-phases))) + (synopsis "Microfork of cURL with support for the HTTP/HTTPS/GnuTLS subset of cURL") + (description + "Gnurl is a microfork of cURL, a command line tool for transferring data +with URL syntax. While cURL supports many crypto backends, libgnurl only +supports HTTPS, HTTPS and GnuTLS.") + (license (license:bsd-style "file://COPYING" + "See COPYING in the distribution.")) + (home-page "https://gnunet.org/gnurl"))) -- cgit v1.2.3 From 7b99ba4acdbce6d0b134a8bd8eb555d00edeb0a5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 29 Jan 2014 23:34:47 +0100 Subject: gnu: linux-libre: Upgrade to 3.13. * gnu/packages/linux.scm (linux-libre): Upgrade to 3.13. --- gnu/packages/linux.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 7808cb108c..b79318f23a 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -148,7 +148,7 @@ (define-public module-init-tools (license gpl2+))) (define-public linux-libre - (let* ((version "3.12") + (let* ((version "3.13") (build-phase '(lambda* (#:key system #:allow-other-keys #:rest args) (let ((arch (car (string-split system #\-)))) @@ -194,7 +194,7 @@ (define-public linux-libre (uri (linux-libre-urls version)) (sha256 (base32 - "0drjxm9h2k9bik2mhrqqqi6cm5rn2db647wf0zvb58xldj0zmhb6")))) + "15pdizzxnnvpxmdb1lbi01kpingmdvj17b01vzbyjymi4vwfws3f")))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl) ("bc" ,bc) -- cgit v1.2.3 From f914963e47baa70ea931c04b7ca348884a41786e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 29 Jan 2014 23:42:36 +0100 Subject: gnu: linux-libre: Build virtio modules. * gnu/packages/linux.scm (linux-libre): Build modules matching CONFIG.*VIRTIO. --- gnu/packages/linux.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index b79318f23a..8fe91b4e9f 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -163,7 +163,11 @@ (define-public linux-libre (format #t "enabling additional modules...~%") (substitute* ".config" (("^# CONFIG_CIFS.*$") - "CONFIG_CIFS=m\n")) + "CONFIG_CIFS=m\n") + (("^# CONFIG_([[:graph:]]*)VIRTIO([[:graph:]]*) .*$" + _ before after) + (string-append "CONFIG_" before "VIRTIO" + after "=m\n"))) (zero? (system* "make" "oldconfig"))) ;; Call the default `build' phase so `-j' is correctly -- cgit v1.2.3 From 668c06acfc29f1063559c37ef184f436a7b7a8e8 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Thu, 30 Jan 2014 14:22:49 +0100 Subject: gnu: Add GNU Octave. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/maths.scm (octave): New variable. Signed-off-by: Ludovic Courtès --- gnu/packages/maths.scm | 65 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 64 insertions(+), 1 deletion(-) diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index a916eb3f66..f5bd1d12d4 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov +;;; Copyright © 2014 John Darrington ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,16 +27,24 @@ (define-module (gnu packages maths) #:use-module (guix build-system cmake) #:use-module (guix build-system gnu) #:use-module (gnu packages compression) + #:use-module (gnu packages curl) + #:use-module (gnu packages fltk) #:use-module (gnu packages fontutils) #:use-module (gnu packages gettext) #:use-module (gnu packages gcc) #:use-module (gnu packages gd) + #:use-module (gnu packages ghostscript) #:use-module (gnu packages gtk) + #:use-module (gnu packages less) + #:use-module (gnu packages xorg) + #:use-module (gnu packages gl) #:use-module (gnu packages multiprecision) + #: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 readline) + #:use-module (gnu packages texinfo) #:use-module (gnu packages texlive) #:use-module (gnu packages xml)) @@ -225,4 +234,58 @@ (define-public gnuplot ;; X11 Style with the additional restriction that derived works may only be ;; distributed as patches to the original. (license (license:fsf-free - "http://gnuplot.cvs.sourceforge.net/gnuplot/gnuplot/Copyright")))) + "http://gnuplot.cvs.sourceforge.net/gnuplot/gnuplot/Copyright")))) + +;; For a fully featured Octave, users are strongly recommended also to install +;; the following packages: texinfo, less, ghostscript, gnuplot. +(define-public octave + (package + (name "octave") + (version "3.8.0") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/octave/octave-" + version ".tar.gz")) + (sha256 + (base32 + "0ks9pr154syw0vb3jn6xsnrkkrbvf9y7i7gaxa28rz6ngxbxvq9l")))) + (build-system gnu-build-system) + (inputs + `(("lapack" ,lapack) + ("readline" ,readline) + ("glpk" ,glpk) + ("curl" ,curl) + ("pcre" ,pcre) + ("fltk" ,fltk) + ("fontconfig" ,fontconfig) + ("freetype" ,freetype) + ("libxft" ,libxft) + ("mesa" ,mesa) + ("zlib" ,zlib))) + (native-inputs + `(("gfortran" ,gfortran-4.8) + ("pkg-config" ,pkg-config) + ("perl" ,perl) + ;; The following inputs are not actually used in the build process. However, the + ;; ./configure gratuitously tests for their existence and assumes that programs not + ;; present at build time are also not, and can never be, available at run time! + ;; If these inputs are therefore not present, support for them will be built out. + ;; However, Octave will still run without them, albeit without the features they + ;; provide. + ("less" ,less) + ("texinfo" ,texinfo) + ("ghostscript" ,ghostscript) + ("gnuplot" ,gnuplot))) + (arguments + `(#:configure-flags (list (string-append "--with-shell=" + (assoc-ref %build-inputs "bash") + "/bin/sh")))) + (home-page "http://www.gnu.org/software/octave/") + (synopsis "High-level language for numerical computation") + (description "GNU Octave is a high-level interpreted language that is specialized +for numerical computations. It can be used for both linear and non-linear +applications and it provides great support for visualizing results. Work may +be performed both at the interactive command-line as well as via script +files.") + (license license:gpl3+))) -- cgit v1.2.3 From a7d46f12ac4f87ff3981a8f8ee14d700799d49ef Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 30 Jan 2014 23:32:22 +0100 Subject: gnu: vm: Run QEMU with '-enable-kvm'. * gnu/system/vm.scm (expression->derivation-in-linux-vm): Pass QEMU '-enable-kvm'. --- gnu/system/vm.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 151535303a..bd7718a14a 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -154,7 +154,7 @@ (define builder (#f '()))) (and (zero? - (system* qemu "-nographic" "-no-reboot" + (system* qemu "-enable-kvm" "-nographic" "-no-reboot" "-net" "nic,model=e1000" "-net" (string-append "user,smb=" (getcwd)) "-kernel" linux @@ -188,6 +188,7 @@ (define builder ("builder" ,user-builder) ,@inputs)))) (derivation-expression name builder + ;; TODO: Require the "kvm" feature. #:system system #:inputs inputs #:env-vars env-vars -- cgit v1.2.3 From 882f034fa88361c703f382f08e158e15ce330c1d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 31 Jan 2014 00:24:26 +0100 Subject: gnu: linux-libre: Build more virtio modules. * gnu/packages/linux.scm (linux-libre): Append CONFIG_NET_9P_VIRTIO and CONFIG_VIRTIO_{NET,BLK,BALLOON} to '.config'. --- gnu/packages/linux.scm | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 8fe91b4e9f..553120ca2b 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -168,6 +168,17 @@ (define-public linux-libre _ before after) (string-append "CONFIG_" before "VIRTIO" after "=m\n"))) + + ;; XXX: For some reason, some virtio modules need to be + ;; explicitly added. + (let ((port (open-file ".config" "a"))) + (display (string-append "CONFIG_NET_9P_VIRTIO=m\n" + "CONFIG_VIRTIO_NET=m\n" + "CONFIG_VIRTIO_BLK=m\n" + "CONFIG_VIRTIO_BALLOON=m\n") + port) + (close-port port)) + (zero? (system* "make" "oldconfig"))) ;; Call the default `build' phase so `-j' is correctly -- cgit v1.2.3 From 83b9e6a1854d4fb86f0269afac33200dce996f06 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 31 Jan 2014 01:40:02 +0100 Subject: gnu: linux-initrd: Start a REPL when the root could not be mounted. * guix/build/linux-initrd.scm (boot-system): Catch errors when mounting ROOT and call 'start-repl' upon error. --- guix/build/linux-initrd.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index 039a60acf3..69cb58763f 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -217,7 +217,13 @@ (define (resolve file) (unless (file-exists? "/root") (mkdir "/root")) (if root - (mount root "/root" "ext3") + (catch #t + (lambda () + (mount root "/root" "ext3")) + (lambda args + (format (current-error-port) "exception while mounting '~a': ~s~%" + root args) + (start-repl))) (mount "none" "/root" "tmpfs")) (mount-essential-file-systems #:root "/root") -- cgit v1.2.3 From fc4bc4b6debecf9acc7e86ecb519c03b5b598bc4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 31 Jan 2014 01:43:16 +0100 Subject: gnu: linux-initrd: Properly distinguish between /dev/sda* and /dev/vda*. * guix/build/linux-initrd.scm (make-essential-device-nodes): Rename devices with major = 8 to /dev/sda*. Make /dev/vda* devices. * gnu/system/vm.scm (qemu-image): Change '/dev/vda' to '/dev/sda'. * gnu/system.scm (operating-system-derivation): Likewise. --- gnu/system.scm | 2 +- gnu/system/vm.scm | 8 ++++---- guix/build/linux-initrd.scm | 13 +++++++++---- 3 files changed, 14 insertions(+), 9 deletions(-) diff --git a/gnu/system.scm b/gnu/system.scm index 5fb4a7483e..e9ecfd2732 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -330,7 +330,7 @@ (define (operating-system-derivation os) (package-full-name kernel) " (technology preview)")) (linux kernel) - (linux-arguments `("--root=/dev/vda1" + (linux-arguments `("--root=/dev/sda1" ,(string-append "--load=" boot))) (initrd initrd-file)))) (grub.cfg (grub-configuration-file entries)) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index bd7718a14a..5407522652 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -294,18 +294,18 @@ (define (graph-from-file file) (assoc-ref %build-inputs "gawk") "/bin")) (display "creating partition table...\n") - (and (zero? (system* parted "/dev/vda" "mklabel" "msdos" + (and (zero? (system* parted "/dev/sda" "mklabel" "msdos" "mkpart" "primary" "ext2" "1MiB" ,(format #f "~aB" (- disk-image-size (* 5 (expt 2 20)))))) (begin (display "creating ext3 partition...\n") - (and (zero? (system* mkfs "-F" "/dev/vda1")) + (and (zero? (system* mkfs "-F" "/dev/sda1")) (let ((store (string-append "/fs" ,%store-directory))) (display "mounting partition...\n") (mkdir "/fs") - (mount "/dev/vda1" "/fs" "ext3") + (mount "/dev/sda1" "/fs" "ext3") (mkdir-p "/fs/boot/grub") (symlink grub.cfg "/fs/boot/grub/grub.cfg") @@ -379,7 +379,7 @@ (define (graph-from-file file) (and (zero? (system* grub "--no-floppy" "--boot-directory" "/fs/boot" - "/dev/vda")) + "/dev/sda")) (zero? (system* umount "/fs")) (reboot)))))))) #:system system diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index 69cb58763f..b9fc9b1523 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -81,10 +81,15 @@ (define (scope dir) (unless (file-exists? (scope "dev")) (mkdir (scope "dev"))) - ;; Make the device nodes for QEMU's hard disk and partitions. - (mknod (scope "dev/vda") 'block-special #o644 (device-number 8 0)) - (mknod (scope "dev/vda1") 'block-special #o644 (device-number 8 1)) - (mknod (scope "dev/vda2") 'block-special #o644 (device-number 8 2)) + ;; Make the device nodes for SCSI disks. + (mknod (scope "dev/sda") 'block-special #o644 (device-number 8 0)) + (mknod (scope "dev/sda1") 'block-special #o644 (device-number 8 1)) + (mknod (scope "dev/sda2") 'block-special #o644 (device-number 8 2)) + + ;; The virtio (para-virtualized) block devices, as supported by QEMU/KVM. + (mknod (scope "dev/vda") 'block-special #o644 (device-number 252 0)) + (mknod (scope "dev/vda1") 'block-special #o644 (device-number 252 1)) + (mknod (scope "dev/vda2") 'block-special #o644 (device-number 252 2)) ;; TTYs. (mknod (scope "dev/tty") 'char-special #o600 -- cgit v1.2.3 From 217b862f0e8dfac18874f9c6ec8cafdb2471b4fb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 31 Jan 2014 12:01:23 +0100 Subject: gnu: linux-initrd: Match kernel module file names exactly. * gnu/system/linux-initrd.scm (expression->initrd)[string->regexp]: New procedure. Use it in the call to 'find-files'. --- gnu/system/linux-initrd.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index ea9d708dac..408fb9f211 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -27,6 +27,7 @@ (define-module (gnu system linux-initrd) #:use-module (gnu packages guile) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) + #:use-module (ice-9 regex) #:export (expression->initrd qemu-initrd gnu-system-initrd)) @@ -58,6 +59,10 @@ (define* (expression->initrd exp ;; General Linux overview in `Documentation/early-userspace/README' and ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. + (define (string->regexp str) + ;; Return a regexp that matches STR exactly. + (string-append "^" (regexp-quote str) "$")) + (define builder `(begin (use-modules (guix build utils) @@ -119,7 +124,8 @@ (define builder (string-append linux "/lib/modules")))) (mkdir "modules") ,@(map (lambda (module) - `(match (find-files module-dir ,module) + `(match (find-files module-dir + ,(string->regexp module)) ((file) (format #t "copying '~a'...~%" file) (copy-file file (string-append "modules/" -- cgit v1.2.3 From 4919d68432c69d386300053b0de178f9efb0334f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 31 Jan 2014 12:21:10 +0100 Subject: gnu: linux-initrd: Recognize 9p file systems. * gnu/system/linux-initrd.scm (qemu-initrd)[virtio-9p-modules]: New variable. [linux-modules]: Append VIRTIO-9P-MODULES when a 9p file system is in MOUNTS. * guix/build/linux-initrd.scm (mount-qemu-9p): New procedure. (boot-system): Recognize '9p' in MOUNTS, and use 'mount-qemu-9p'. --- gnu/system/linux-initrd.scm | 15 ++++++++++++--- guix/build/linux-initrd.scm | 18 ++++++++++++++++-- 2 files changed, 28 insertions(+), 5 deletions(-) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 408fb9f211..1cc1d3b147 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -207,11 +207,20 @@ (define cifs-modules ;; Modules needed to mount CIFS file systems. '("md4.ko" "ecb.ko" "cifs.ko")) + (define virtio-9p-modules + ;; Modules for the 9p paravirtualized file system. + '("9pnet.ko" "9p.ko" "9pnet_virtio.ko")) + (define linux-modules ;; Modules added to the initrd and loaded from the initrd. - (if (assoc-ref mounts 'cifs) - cifs-modules - '())) + `("virtio.ko" "virtio_ring.ko" "virtio_pci.ko" + "virtio_balloon.ko" "virtio_blk.ko" "virtio_net.ko" + ,@(if (assoc-ref mounts 'cifs) + cifs-modules + '()) + ,@(if (assoc-ref mounts '9p) + virtio-9p-modules + '()))) (expression->initrd `(begin diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index b9fc9b1523..7b22354f70 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -30,6 +30,7 @@ (define-module (guix build linux-initrd) make-essential-device-nodes configure-qemu-networking mount-qemu-smb-share + mount-qemu-9p bind-mount load-linux-module* device-number @@ -145,6 +146,17 @@ (define (mount-qemu-smb-share share mount-point) (mount (string-append "//" server share) mount-point "cifs" 0 (string->pointer "guest,sec=none")))) +(define (mount-qemu-9p source mount-point) + "Mount QEMU's 9p file system from SOURCE at MOUNT-POINT. + +This uses the 'virtio' transport, which requires the various virtio Linux +modules to be loaded." + + (format #t "mounting QEMU's 9p share '~a'...\n" source) + (let ((server "10.0.2.4")) + (mount source mount-point "9p" 0 + (string->pointer "trans=virtio")))) + (define (bind-mount source target) "Bind-mount SOURCE at TARGET." (define MS_BIND 4096) ; from libc's @@ -242,8 +254,10 @@ (define (resolve file) (let ((target (string-append "/root/" target))) (mkdir-p target) (mount-qemu-smb-share source target))) - ;; TODO: Add 9p. - ) + (('9p source target) + (let ((target (string-append "/root/" target))) + (mkdir-p target) + (mount-qemu-9p source target)))) mounts) (when guile-modules-in-chroot? -- cgit v1.2.3 From 70b33d81cfe4f2192a2167a82e55aabc4401c8a6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 31 Jan 2014 14:23:54 +0100 Subject: gnu: linux: Really build 9p/virtio modules. * gnu/packages/linux.scm (linux-libre): Add CONFIG_NET_9P and CONFIG_9P_FS. --- gnu/packages/linux.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 553120ca2b..b88ecfcac0 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -173,6 +173,8 @@ (define-public linux-libre ;; explicitly added. (let ((port (open-file ".config" "a"))) (display (string-append "CONFIG_NET_9P_VIRTIO=m\n" + "CONFIG_NET_9P=m\n" + "CONFIG_9P_FS=m\n" "CONFIG_VIRTIO_NET=m\n" "CONFIG_VIRTIO_BLK=m\n" "CONFIG_VIRTIO_BALLOON=m\n") -- cgit v1.2.3 From 44ddf33ed5b86fd79921aba5572a82c2a940808c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 31 Jan 2014 14:26:30 +0100 Subject: gnu: linux-initrd: Allow the root file system to be volatile. * gnu/system/linux-initrd.scm (qemu-initrd): Add 'volatile-root?' parameter. * guix/build/linux-initrd.scm (boot-system): Likewise. Honor it. --- gnu/system/linux-initrd.scm | 9 +++++++-- guix/build/linux-initrd.scm | 35 +++++++++++++++++++++++++++++++++-- 2 files changed, 40 insertions(+), 4 deletions(-) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 1cc1d3b147..9520473d01 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -191,6 +191,7 @@ (define print0 (define* (qemu-initrd #:key guile-modules-in-chroot? + volatile-root? (mounts `((cifs "/store" ,(%store-prefix)) (cifs "/xchg" "/xchg")))) "Return a monadic derivation that builds an initrd for use in a QEMU guest @@ -202,7 +203,10 @@ (define* (qemu-initrd #:key When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in the new root. This is necessary is the file specified as '--load' needs access to these modules (which is the case if it wants to even just print an -exception and backtrace!)." +exception and backtrace!). + +When VOLATILE-ROOT? is true, the root file system is writable but any changes +to it are lost." (define cifs-modules ;; Modules needed to mount CIFS file systems. '("md4.ko" "ecb.ko" "cifs.ko")) @@ -229,7 +233,8 @@ (define linux-modules (boot-system #:mounts ',mounts #:linux-modules ',linux-modules #:qemu-guest-networking? #t - #:guile-modules-in-chroot? ',guile-modules-in-chroot?)) + #:guile-modules-in-chroot? ',guile-modules-in-chroot? + #:volatile-root? ',volatile-root?)) #:name "qemu-initrd" #:modules '((guix build utils) (guix build linux-initrd)) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index 7b22354f70..d317f850f2 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -24,6 +24,7 @@ (define-module (guix build linux-initrd) #: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) #:export (mount-essential-file-systems linux-command-line @@ -179,6 +180,7 @@ (define* (boot-system #:key (linux-modules '()) qemu-guest-networking? guile-modules-in-chroot? + volatile-root? (mounts '())) "This procedure is meant to be called from an initrd. Boot a system by first loading LINUX-MODULES, then setting up QEMU guest networking if @@ -191,7 +193,10 @@ (define* (boot-system #:key (FILE-SYSTEM-TYPE SOURCE TARGET) When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in -the new root." +the new root. + +When VOLATILE-ROOT? is true, the root file system is writable but any changes +to it are lost." (define (resolve file) ;; If FILE is a symlink to an absolute file name, resolve it as if we were ;; under /root. @@ -201,6 +206,8 @@ (define (resolve file) (resolve (string-append "/root" target))) file))) + (define MS_RDONLY 1) + (display "Welcome, this is GNU's early boot Guile.\n") (display "Use '--repl' for an initrd REPL.\n\n") @@ -236,12 +243,36 @@ (define (resolve file) (if root (catch #t (lambda () - (mount root "/root" "ext3")) + (if volatile-root? + (begin + ;; XXX: For lack of a union file system... + (mkdir-p "/real-root") + (mount root "/real-root" "ext3" MS_RDONLY) + (mount "none" "/root" "tmpfs") + + ;; XXX: 'copy-recursively' cannot deal with device nodes, so + ;; explicitly avoid /dev. + (for-each (lambda (file) + (unless (string=? "dev" file) + (copy-recursively (string-append "/real-root/" + file) + (string-append "/root/" + file) + #:log (%make-void-port + "w")))) + (scandir "/real-root" + (lambda (file) + (not (member file '("." "..")))))) + + ;; TODO: Unmount /real-root. + ) + (mount root "/root" "ext3"))) (lambda args (format (current-error-port) "exception while mounting '~a': ~s~%" root args) (start-repl))) (mount "none" "/root" "tmpfs")) + (mount-essential-file-systems #:root "/root") (unless (file-exists? "/root/dev") -- cgit v1.2.3 From fd3bfc44ff65e166d1c515721c7870391dceb799 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 31 Jan 2014 14:36:48 +0100 Subject: gnu: vm: Add support for running a VM that shares its store with the host. * gnu/system/vm.scm (qemu-image): Check whether GUIX is #f. (operating-system-build-gid, operating-system-default-contents): New procedures. (system-qemu-image): Use 'operating-system-build-gid'. (system-qemu-image/shared-store, system-qemu-image/shared-store-script): New procedures. * gnu/system.scm: Add missing exports. --- gnu/system.scm | 10 +++++ gnu/system/vm.scm | 125 ++++++++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 113 insertions(+), 22 deletions(-) diff --git a/gnu/system.scm b/gnu/system.scm index e9ecfd2732..afea976165 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -38,6 +38,16 @@ (define-module (gnu system) operating-system? operating-system-services operating-system-packages + operating-system-bootloader-entries + operating-system-host-name + operating-system-kernel + operating-system-initrd + operating-system-users + operating-system-groups + operating-system-packages + operating-system-timezone + operating-system-locale + operating-system-services operating-system-derivation)) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 5407522652..f36cfd0318 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -53,7 +53,9 @@ (define-module (gnu system vm) #:export (expression->derivation-in-linux-vm qemu-image - system-qemu-image)) + system-qemu-image + system-qemu-image/shared-store + system-qemu-image/shared-store-script)) ;;; Commentary: @@ -323,8 +325,9 @@ (define (graph-from-file file) ;; Optionally, register the inputs in the image's store. (let* ((guix (assoc-ref %build-inputs "guix")) - (register (string-append guix - "/sbin/guix-register"))) + (register (and guix + (string-append guix + "/sbin/guix-register")))) ,@(if initialize-store? (match inputs-to-copy (((graph-files . _) ...) @@ -441,6 +444,35 @@ (define %demo-operating-system tzdata guix)))) +(define (operating-system-build-gid os) + "Return as a monadic value the group id for build users of OS, or #f." + (anym %store-monad + (lambda (service) + (and (equal? '(guix-daemon) + (service-provision service)) + (match (service-user-groups service) + ((group) + (user-group-id group))))) + (operating-system-services os))) + +(define (operating-system-default-contents os) + "Return a list of directives suitable for 'system-qemu-image' describing the +basic contents of the root file system of OS." + (mlet* %store-monad ((os-drv (operating-system-derivation os)) + (os-dir -> (derivation->output-path os-drv)) + (build-user-gid (operating-system-build-gid os))) + (return `((directory "/nix/store" 0 ,(or build-user-gid 0)) + (directory "/etc") + (directory "/var/log") ; for dmd + (directory "/var/run/nscd") + (directory "/var/nix/gcroots") + ("/var/nix/gcroots/system" -> ,os-dir) + (directory "/tmp") + (directory "/var/nix/profiles/per-user/root" 0 0) + (directory "/var/nix/profiles/per-user/guest" + 1000 100) + (directory "/home/guest" 1000 100))))) + (define* (system-qemu-image #:optional (os %demo-operating-system) #:key (disk-image-size (* 900 (expt 2 20)))) "Return the derivation of a QEMU image of DISK-IMAGE-SIZE bytes of the GNU @@ -449,29 +481,78 @@ (define* (system-qemu-image #:optional (os %demo-operating-system) ((os-drv (operating-system-derivation os)) (os-dir -> (derivation->output-path os-drv)) (grub.cfg -> (string-append os-dir "/grub.cfg")) - (build-user-gid (anym %store-monad ; XXX - (lambda (service) - (and (equal? '(guix-daemon) - (service-provision service)) - (match (service-user-groups service) - ((group) - (user-group-id group))))) - (operating-system-services os))) - (populate -> `((directory "/nix/store" 0 ,build-user-gid) - (directory "/etc") - (directory "/var/log") ; for dmd - (directory "/var/run/nscd") - (directory "/var/nix/gcroots") - ("/var/nix/gcroots/system" -> ,os-dir) - (directory "/tmp") - (directory "/var/nix/profiles/per-user/root" 0 0) - (directory "/var/nix/profiles/per-user/guest" - 1000 100) - (directory "/home/guest" 1000 100)))) + (populate (operating-system-default-contents os))) (qemu-image #:grub-configuration grub.cfg #:populate populate #:disk-image-size disk-image-size #:initialize-store? #t #:inputs-to-copy `(("system" ,os-drv))))) +(define* (system-qemu-image/shared-store + #:optional (os %demo-operating-system) + #:key (disk-image-size (* 15 (expt 2 20)))) + "Return a derivation that builds a QEMU image of OS that shares its store +with the host." + (mlet* %store-monad + ((os-drv (operating-system-derivation os)) + (os-dir -> (derivation->output-path os-drv)) + (grub.cfg -> (string-append os-dir "/grub.cfg")) + (populate (operating-system-default-contents os))) + ;; TODO: Initialize the database so Guix can be used in the guest. + (qemu-image #:grub-configuration grub.cfg + #:populate populate + #:disk-image-size disk-image-size))) + +(define* (system-qemu-image/shared-store-script + #:optional (os %demo-operating-system) + #:key + (qemu (package (inherit qemu) + ;; FIXME/TODO: Use 9p instead of this hack. + (source (package-source qemu/smb-shares)))) + (graphic? #t)) + "Return a derivation that builds a script to run a virtual machine image of +OS that shares its store with the host." + (let* ((initrd (qemu-initrd #:mounts `((cifs "/store" ,(%store-prefix))) + #:volatile-root? #t)) + (os (operating-system (inherit os) (initrd initrd)))) + (define builder + (mlet %store-monad ((image (system-qemu-image/shared-store os)) + (qemu (package-file qemu + "bin/qemu-system-x86_64")) + (bash (package-file bash "bin/sh")) + (kernel (package-file (operating-system-kernel os) + "bzImage")) + (initrd initrd) + (os-drv (operating-system-derivation os))) + (return `(let ((out (assoc-ref %outputs "out"))) + (call-with-output-file out + (lambda (port) + (display + (string-append "#!" ,bash " +# TODO: -virtfs local,path=XXX,security_model=none,mount_tag=store +exec " ,qemu " -enable-kvm -no-reboot -net nic,model=virtio \ + -net user,smb=$PWD \ + -kernel " ,kernel " -initrd " + ,(string-append (derivation->output-path initrd) "/initrd") " \ +-append \"" ,(if graphic? "" "console=ttyS0 ") +"--load=" ,(derivation->output-path os-drv) "/boot --root=/dev/vda1\" \ + -drive file=" ,(derivation->output-path image) + ",if=virtio,cache=writeback,werror=report,readonly\n") + port))) + (chmod out #o555) + #t)))) + + (mlet %store-monad ((image (system-qemu-image/shared-store os)) + (initrd initrd) + (qemu (package->derivation qemu)) + (bash (package->derivation bash)) + (os (operating-system-derivation os)) + (builder builder)) + (derivation-expression "run-vm.sh" builder + #:inputs `(("qemu" ,qemu) + ("image" ,image) + ("bash" ,bash) + ("initrd" ,initrd) + ("os" ,os)))))) + ;;; vm.scm ends here -- cgit v1.2.3 From e420308f292cc55bbc21d0907a3a02779b4527e1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 31 Jan 2014 18:22:04 +0100 Subject: gnu: xorg-server: Use /var as $localstatedir. * gnu/packages/xorg.scm (xorg-server): Pass --localstatedir=/var. In 'configure' phase, patch 'hw/xfree86/Makefile.in'. --- gnu/packages/xorg.scm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index 6c17170eef..fbb6367d05 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -4377,7 +4377,10 @@ (define-public xorg-server ; the compiled keyboard maps go? (string-append "--with-xkb-bin-directory=" (assoc-ref %build-inputs "xkbcomp") - "/bin")) + "/bin") + + ;; For the log file, etc. + "--localstatedir=/var") #:phases (alist-replace 'configure @@ -4385,6 +4388,12 @@ (define-public xorg-server (let ((configure (assoc-ref %standard-phases 'configure))) (substitute* (find-files "." "\\.c$") (("/bin/sh") (which "sh"))) + + ;; Don't try to 'mkdir /var'. + (substitute* "hw/xfree86/Makefile.in" + (("mkdir(.*)logdir.*") + "true\n")) + (apply configure args))) %standard-phases))) (home-page "http://www.x.org/wiki/") -- cgit v1.2.3 From c04c6ff64c1dd3f9cbd1d32763d46b480e56eb59 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 1 Feb 2014 01:07:14 +0100 Subject: gnu: linux-initrd: Make /dev/{mem,kmem}. * guix/build/linux-initrd.scm (make-essential-device-nodes): Make dev/{mem,kmem}. --- guix/build/linux-initrd.scm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index d317f850f2..ac7806cc3b 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -93,6 +93,10 @@ (define (scope dir) (mknod (scope "dev/vda1") 'block-special #o644 (device-number 252 1)) (mknod (scope "dev/vda2") 'block-special #o644 (device-number 252 2)) + ;; Memory (used by Xorg's VESA driver.) + (mknod (scope "dev/mem") 'char-special #o640 (device-number 1 1)) + (mknod (scope "dev/kmem") 'char-special #o640 (device-number 1 2)) + ;; TTYs. (mknod (scope "dev/tty") 'char-special #o600 (device-number 5 0)) -- cgit v1.2.3 From 53bd729e8cb834fd8d907c58dd54698f71298744 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 1 Feb 2014 01:58:37 +0100 Subject: gnu: Add preliminary Xorg service. * gnu/system/dmd.scm (xorg-service): New procedure. --- gnu/system/dmd.scm | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 94 insertions(+), 1 deletion(-) diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm index 2143b00426..505c4c9afb 100644 --- a/gnu/system/dmd.scm +++ b/gnu/system/dmd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,6 +29,10 @@ (define-module (gnu system dmd) #:select (guix)) #:use-module ((gnu packages linux) #:select (net-tools)) + #:use-module (gnu packages xorg) + #:use-module (gnu packages bash) + #:use-module (gnu packages gl) + #:use-module (gnu system shadow) ; for user accounts/groups #:use-module (gnu system linux) ; for PAM services #:use-module (ice-9 match) @@ -54,6 +58,7 @@ (define-module (gnu system dmd) nscd-service guix-service static-networking-service + xorg-service dmd-configuration-file)) @@ -265,6 +270,94 @@ (define* (static-networking-service interface ip `(("net-tools" ,net-tools)) '()))))))) +(define (xorg-service) + "Return a service that starts the Xorg graphical display server." + (define (xserver.conf) + (mlet %store-monad ((fonts (package-file font-adobe75dpi + "lib/X11/fonts")) + (xorg (package-file xorg-server + "lib/xorg/modules")) + (vesa (package-file xf86-video-vesa + "lib/xorg/modules/drivers")) + (kbd (package-file xf86-input-keyboard + "lib/xorg/modules/input")) + (mouse (package-file xf86-input-mouse + "lib/xorg/modules/input"))) + (text-file "xserver.conf" ; let's go! + (string-append " +Section \"Files\" + FontPath \"" fonts "\" + ModulePath \"" vesa "\" + ModulePath \"" mouse "\" + ModulePath \"" kbd "\" + ModulePath \"" xorg "\" + ModulePath \"" xorg "/extensions\" + ModulePath \"" xorg "/multimedia\" +EndSection + +Section \"ServerFlags\" + Option \"AllowMouseOpenFail\" \"on"" +EndSection + +Section \"Monitor\" + Identifier \"Monitor[0]\" +EndSection + +Section \"InputClass\" + Identifier \"Generic keyboard\" + MatchIsKeyboard \"on\" + Option \"XkbRules\" \"base\" + Option \"XkbModel\" \"pc104\" +EndSection + +Section \"ServerLayout\" + Identifier \"Layout\" + Screen \"Screen-vesa\" +EndSection + +Section \"Device\" + Identifier \"Device-vesa\" + Driver \"vesa\" +EndSection + +Section \"Screen\" + Identifier \"Screen-vesa\" + Device \"Device-vesa\" +EndSection")))) + + (mlet %store-monad ((xorg-bin (package-file xorg-server "bin/X")) + (dri (package-file mesa "lib/dri")) + (xkbcomp-bin (package-file xkbcomp "bin")) + (xkb-dir (package-file xkeyboard-config + "share/X11/xkb")) + (sh (package-file bash "bin/sh")) + (config (xserver.conf))) + (return + (service + (documentation "The X11 graphic server") + (provision '(xorg-server)) + (requirement '(host-name)) + (start `(make-forkexec-constructor + ;; XXX: 'make-forkexec-constructor' should allow use to specify + ;; env vars. + ,sh "-c" ,(string-append "XORG_DRI_DRIVER_PATH=" dri " " + "XKB_BINDIR=" xkbcomp-bin " " + xorg-bin " -ac -logverbose -verbose " + "-xkbdir " xkb-dir " " + "-config " config " " + "-nolisten tcp :0 vt7"))) + (stop `(make-kill-destructor)) + (respawn? #f) + (inputs `(("xorg" ,xorg-server) + ("mesa" ,mesa) + ("xkbcomp" ,xkbcomp) + ("xkeyboard-config" ,xkeyboard-config) + ("vesa" ,xf86-video-vesa) + ("mouse" ,xf86-input-mouse) + ("kbd" ,xf86-input-keyboard) + ("fonts" ,font-adobe75dpi) + ("bash" ,bash))))))) + (define (dmd-configuration-file services etc) "Return the dmd configuration file for SERVICES, that initializes /etc from -- cgit v1.2.3 From 1c2215108b4f0cd849da08cd8d2896680958d8c8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 1 Feb 2014 02:22:23 +0100 Subject: gnu: linux-initrd: Build /dev/input devices. * guix/build/linux-initrd.scm (make-essential-device-nodes): Make dev/input devices. --- guix/build/linux-initrd.scm | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index ac7806cc3b..5bf20fa6df 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -97,6 +97,13 @@ (define (scope dir) (mknod (scope "dev/mem") 'char-special #o640 (device-number 1 1)) (mknod (scope "dev/kmem") 'char-special #o640 (device-number 1 2)) + ;; Inputs (used by Xorg.) + (unless (file-exists? (scope "dev/input")) + (mkdir (scope "dev/input"))) + (mknod (scope "dev/input/mice") 'char-special #o640 (device-number 13 63)) + (mknod (scope "dev/input/mouse0") 'char-special #o640 (device-number 13 32)) + (mknod (scope "dev/input/event0") 'char-special #o640 (device-number 13 64)) + ;; TTYs. (mknod (scope "dev/tty") 'char-special #o600 (device-number 5 0)) -- cgit v1.2.3 From 92cb2e28884ab6ecc5c113ef54eb5aeebae9bb2b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 2 Feb 2014 01:32:50 +0100 Subject: offload: Have 'build-machines' honor its argument. * guix/scripts/offload.scm (build-machines): Honor FILE. --- guix/scripts/offload.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 1f68160785..00a145e5e9 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -108,7 +108,7 @@ (define* (build-machines #:optional (file %machine-file)) (save-module-excursion (lambda () (set-current-module %user-module) - (primitive-load %machine-file)))) + (primitive-load file)))) (lambda args (match args (('system-error . _) @@ -117,10 +117,10 @@ (define* (build-machines #:optional (file %machine-file)) (if (= ENOENT err) '() (leave (_ "failed to open machine file '~a': ~a~%") - %machine-file (strerror err))))) + file (strerror err))))) (_ (leave (_ "failed to load machine file '~a': ~s~%") - %machine-file args)))))) + file args)))))) (define (open-ssh-gateway machine) "Initiate an SSH connection gateway to MACHINE, and return the PID of the -- cgit v1.2.3 From f6a9d0484c6cdd1554f6ce0e7372ec8b7f2a52ca Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 2 Feb 2014 01:34:33 +0100 Subject: gnu: vm: Add /run/current-system and /bin/sh. * gnu/system/vm.scm (operating-system-default-contents): Populate /run/current-system and create /bin/sh. * gnu/system.scm (operating-system-profile-derivation, operating-system-profile-directory): New procedures. (operating-system-derivation): Use it. --- gnu/system.scm | 17 +++++++++++++---- gnu/system/vm.scm | 13 +++++++++---- 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/gnu/system.scm b/gnu/system.scm index afea976165..514e67ab9a 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -49,6 +49,7 @@ (define-module (gnu system) operating-system-locale operating-system-services + operating-system-profile-directory operating-system-derivation)) ;;; Commentary: @@ -284,6 +285,17 @@ (define* (etc-directory #:key ("pam.d" ,pam.d)) #:name "etc"))) +(define (operating-system-profile-derivation os) + "Return a derivation that builds the default profile of OS." + ;; TODO: Replace with a real profile with a manifest. + (union (operating-system-packages os) + #:name "default-profile")) + +(define (operating-system-profile-directory os) + "Return the directory name of the default profile of OS." + (mlet %store-monad ((drv (operating-system-profile-derivation os))) + (return (derivation->output-path drv)))) + (define (operating-system-derivation os) "Return a derivation that builds OS." (mlet* %store-monad @@ -310,11 +322,8 @@ (define (operating-system-derivation os) services)))) (groups -> (append (operating-system-groups os) (append-map service-user-groups services))) - (packages -> (operating-system-packages os)) - ;; TODO: Replace with a real profile with a manifest. - (profile-drv (union packages - #:name "default-profile")) + (profile-drv (operating-system-profile-derivation os)) (profile -> (derivation->output-path profile-drv)) (etc-drv (etc-directory #:accounts accounts #:groups groups #:pam-services pam-services diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index f36cfd0318..00edc8e40b 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -458,15 +458,20 @@ (define (operating-system-build-gid os) (define (operating-system-default-contents os) "Return a list of directives suitable for 'system-qemu-image' describing the basic contents of the root file system of OS." - (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (os-dir -> (derivation->output-path os-drv)) - (build-user-gid (operating-system-build-gid os))) - (return `((directory "/nix/store" 0 ,(or build-user-gid 0)) + (mlet* %store-monad ((os-drv (operating-system-derivation os)) + (os-dir -> (derivation->output-path os-drv)) + (build-gid (operating-system-build-gid os)) + (profile (operating-system-profile-directory os))) + (return `((directory "/nix/store" 0 ,(or build-gid 0)) (directory "/etc") (directory "/var/log") ; for dmd (directory "/var/run/nscd") (directory "/var/nix/gcroots") ("/var/nix/gcroots/system" -> ,os-dir) + (directory "/run") + ("/run/current-system" -> ,profile) + (directory "/bin") + ("/bin/sh" -> "/run/current-system/bin/sh") (directory "/tmp") (directory "/var/nix/profiles/per-user/root" 0 0) (directory "/var/nix/profiles/per-user/guest" -- cgit v1.2.3 From ba6f8e423e582ad1fc1b164317d158e3e1c0f6af Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 2 Feb 2014 20:38:03 +0100 Subject: gnu: Add xterm. * gnu/packages/xorg.scm (xterm): New variable. --- gnu/packages/xorg.scm | 44 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index fbb6367d05..abcbfba88a 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -38,7 +38,8 @@ (define-module (gnu packages xorg) #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) - #:use-module (gnu packages xml)) + #:use-module (gnu packages xml) + #:use-module (gnu packages ncurses)) @@ -4709,3 +4710,44 @@ (define-public libxaw3d (synopsis "xorg implementation of the X Window System") (description "X.org provides an implementation of the X Window System") (license license:x11))) + +(define-public xterm + (package + (name "xterm") + (version "301") + (source (origin + (method url-fetch) + (uri ; XXX: constant URL! + "http://invisible-island.net/datafiles/release/xterm.tar.gz") + (sha256 + (base32 + "040rarvv18zg0lk7qy0m3n7gv10mh40jic708wvng01z4rlbpfhz")))) + (build-system gnu-build-system) + (arguments + '(#:configure-flags '("--enable-wide-chars" "--enable-256-color" + "--enable-load-vt-fonts" "--enable-i18n" + "--enable-doublechars" "--enable-luit" + "--enable-mini-luit") + #:tests? #f)) + (native-inputs + `(("pkg-config" ,pkg-config))) + (inputs + `(("luit" ,luit) + ("libXft" ,libxft) + ("fontconfig" ,fontconfig) + ("freetype" ,freetype) + ("ncurses" ,ncurses) + ("libICE" ,libice) + ("libSM" ,libsm) + ("libX11" ,libx11) + ("libXext" ,libxext) + ("libXt" ,libxt) + ("xproto" ,xproto) + ("libXaw" ,libxaw))) + (home-page "http://invisible-island.net/xterm") + (synopsis "Terminal emulator for the X Window System") + (description + "The xterm program is a terminal emulator for the X Window System. It +provides DEC VT102/VT220 (VTxxx) and Tektronix 4014 compatible terminals for +programs that cannot use the window system directly.") + (license license:x11))) -- cgit v1.2.3 From 682b6599d775d0d6a594d84a38170bbd80fa6306 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 2 Feb 2014 20:41:53 +0100 Subject: gnu: vm: Create all the user directories. * gnu/system/vm.scm (operating-system-default-contents)[user-directories]: New procedure. Use it to create each user's home and GC root directories. --- gnu/system/vm.scm | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 00edc8e40b..1bdd2c6e92 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -458,6 +458,16 @@ (define (operating-system-build-gid os) (define (operating-system-default-contents os) "Return a list of directives suitable for 'system-qemu-image' describing the basic contents of the root file system of OS." + (define (user-directories user) + (let ((home (user-account-home-directory user)) + ;; XXX: Deal with automatically allocated ids. + (uid (or (user-account-uid user) 0)) + (gid (or (user-account-gid user) 0)) + (root (string-append "/var/nix/profiles/per-user/" + (user-account-name user)))) + `((directory ,root ,uid ,gid) + (directory ,home ,uid ,gid)))) + (mlet* %store-monad ((os-drv (operating-system-derivation os)) (os-dir -> (derivation->output-path os-drv)) (build-gid (operating-system-build-gid os)) @@ -471,12 +481,12 @@ (define (operating-system-default-contents os) (directory "/run") ("/run/current-system" -> ,profile) (directory "/bin") - ("/bin/sh" -> "/run/current-system/bin/sh") + ("/bin/sh" -> "/run/current-system/bin/bash") (directory "/tmp") (directory "/var/nix/profiles/per-user/root" 0 0) - (directory "/var/nix/profiles/per-user/guest" - 1000 100) - (directory "/home/guest" 1000 100))))) + + ,@(append-map user-directories + (operating-system-users os)))))) (define* (system-qemu-image #:optional (os %demo-operating-system) #:key (disk-image-size (* 900 (expt 2 20)))) -- cgit v1.2.3 From 9c0864434082f1caee55c799999018618afd639d Mon Sep 17 00:00:00 2001 From: John Darrington Date: Sun, 2 Feb 2014 11:27:36 +0100 Subject: gnu: gtkmm-2 New variable MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/gtk.scm (gtkmm-2): New variable. Signed-off-by: Ludovic Courtès --- gnu/packages/gtk.scm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm index fcfbcc47ce..2a01f891b2 100644 --- a/gnu/packages/gtk.scm +++ b/gnu/packages/gtk.scm @@ -590,3 +590,22 @@ (define-public gtkmm in code or with the Glade User Interface designer, using libglademm. There's extensive documentation, including API reference and a tutorial.") (license license:lgpl2.1+))) + + +(define-public gtkmm-2 + (package (inherit gtkmm) + (version "2.24.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/gtkmm/" + (string-take version 4) "/gtkmm-" + version ".tar.xz")) + (sha256 + (base32 + "0gcm91sc1a05c56kzh74l370ggj0zz8nmmjvjaaxgmhdq8lpl369")))) + (propagated-inputs + `(("pangomm" ,pangomm) + ("cairomm" ,cairomm) + ("atkmm" ,atkmm) + ("gtk+" ,gtk+-2) + ("glibmm" ,glibmm))))) -- cgit v1.2.3 From 67995f4beaeb97a10c455d265acc7a209fcc5312 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Sun, 2 Feb 2014 11:26:04 +0100 Subject: gnu: file: Upgrade to 5.16. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/file.scm (file): Upgrade to 5.16. Signed-off-by: Ludovic Courtès --- gnu/packages/file.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/file.scm b/gnu/packages/file.scm index 63a9df4a9a..707d03ffd9 100644 --- a/gnu/packages/file.scm +++ b/gnu/packages/file.scm @@ -26,13 +26,13 @@ (define-module (gnu packages file) (define-public file (package (name "file") - (version "5.12") + (version "5.16") (source (origin (method url-fetch) (uri (string-append "ftp://ftp.astron.com/pub/file/file-" version ".tar.gz")) (sha256 (base32 - "08ix4xrvan0k80n0l5lqfmc4azjv5lyhvhwdxny4r09j5smhv78r")))) + "0qcj72mp8fzvh29h70mksxynax9mk5c6p8gzqw5qlyn34rvsrg28")))) (build-system gnu-build-system) (native-inputs ;; This package depends upon a native install of itself. -- cgit v1.2.3 From 45adbd624f920d315259b102b923728d655a1efa Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 3 Feb 2014 23:12:54 +0100 Subject: monads: Add 'text-file*'. * guix/monads.scm (text-file*): New procedure. * tests/monads.scm ("text-file*"): New test. * doc/guix.texi (The Store Monad): Change example since the previous one would erroneously fail to retain a reference to Coreutils. Document 'text-file*'. --- doc/guix.texi | 48 ++++++++++++++++++++++++++++++++++++------------ guix/monads.scm | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++++- tests/monads.scm | 26 +++++++++++++++++++++++++- 3 files changed, 113 insertions(+), 14 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 91fa07f1a8..28b1cb8bd7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1590,23 +1590,22 @@ in a monad---values that carry this additional context---are called Consider this ``normal'' procedure: @example -(define (profile.sh store) - ;; Return the name of a shell script in the store that - ;; initializes the 'PATH' environment variable. - (let* ((drv (package-derivation store coreutils)) - (out (derivation->output-path drv))) - (add-text-to-store store "profile.sh" - (format #f "export PATH=~a/bin" out)))) +(define (sh-symlink store) + ;; Return a derivation that symlinks the 'bash' executable. + (let* ((drv (package-derivation store bash)) + (out (derivation->output-path drv)) + (sh (string-append out "/bin/bash"))) + (build-expression->derivation store "sh" + `(symlink ,sh %output)))) @end example Using @code{(guix monads)}, it may be rewritten as a monadic function: @example -(define (profile.sh) +(define (sh-symlink) ;; Same, but return a monadic value. - (mlet %store-monad ((bin (package-file coreutils "bin"))) - (text-file "profile.sh" - (string-append "export PATH=" bin)))) + (mlet %store-monad ((sh (package-file bash "bin"))) + (derivation-expression "sh" `(symlink ,sh %output)))) @end example There are two things to note in the second version: the @code{store} @@ -1672,7 +1671,32 @@ open store connection. @deffn {Monadic Procedure} text-file @var{name} @var{text} Return as a monadic value the absolute file name in the store of the file -containing @var{text}. +containing @var{text}, a string. +@end deffn + +@deffn {Monadic Procedure} text-file* @var{name} @var{text} @dots{} +Return as a monadic value a derivation that builds a text file +containing all of @var{text}. @var{text} may list, in addition to +strings, packages, derivations, and store file names; the resulting +store file holds references to all these. + +This variant should be preferred over @code{text-file} anytime the file +to create will reference items from the store. This is typically the +case when building a configuration file that embeds store file names, +like this: + +@example +(define (profile.sh) + ;; Return the name of a shell script in the store that + ;; initializes the 'PATH' environment variable. + (text-file* "profile.sh" + "export PATH=" coreutils "/bin:" + grep "/bin:" sed "/bin\n")) +@end example + +In this example, the resulting @file{/nix/store/@dots{}-profile.sh} file +will references @var{coreutils}, @var{grep}, and @var{sed}, thereby +preventing them from being garbage-collected during its lifetime. @end deffn @deffn {Monadic Procedure} package-file @var{package} [@var{file}] @ diff --git a/guix/monads.scm b/guix/monads.scm index ad80a0698d..db8b645402 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -23,6 +23,7 @@ (define-module (guix monads) #:use-module ((system syntax) #:select (syntax-local-binding)) #:use-module (ice-9 match) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) #:export (;; Monads. @@ -53,6 +54,7 @@ (define-module (guix monads) store-lift run-with-store text-file + text-file* package-file package->derivation built-derivations @@ -305,10 +307,59 @@ (define result (define* (text-file name text) "Return as a monadic value the absolute file name in the store of the file -containing TEXT." +containing TEXT, a string." (lambda (store) (add-text-to-store store name text '()))) +(define* (text-file* name #:rest text) + "Return as a monadic value a derivation that builds a text file containing +all of TEXT. TEXT may list, in addition to strings, packages, derivations, +and store file names; the resulting store file holds references to all these." + (define inputs + ;; Transform packages and derivations from TEXT into a valid input list. + (filter-map (match-lambda + ((? package? p) `("x" ,p)) + ((? derivation? d) `("x" ,d)) + ((x ...) `("x" ,@x)) + ((? string? s) + (and (direct-store-path? s) `("x" ,s))) + (x x)) + text)) + + (define (computed-text text inputs) + ;; Using the lowered INPUTS, return TEXT with derivations replaced with + ;; their output file name. + (define (real-string? s) + (and (string? s) (not (direct-store-path? s)))) + + (let loop ((inputs inputs) + (text text) + (result '())) + (match text + (() + (string-concatenate-reverse result)) + (((? real-string? head) rest ...) + (loop inputs rest (cons head result))) + ((_ rest ...) + (match inputs + (((_ (? derivation? drv) sub-drv ...) inputs ...) + (loop inputs rest + (cons (apply derivation->output-path drv + sub-drv) + result))) + (((_ file) inputs ...) + ;; FILE is the result of 'add-text-to-store' or so. + (loop inputs rest (cons file result)))))))) + + (define (builder inputs) + `(call-with-output-file (assoc-ref %outputs "out") + (lambda (port) + (display ,(computed-text text inputs) port)))) + + (mlet %store-monad ((inputs (lower-inputs inputs))) + (derivation-expression name (builder inputs) + #:inputs inputs))) + (define* (package-file package #:optional file #:key (system (%current-system)) (output "out")) diff --git a/tests/monads.scm b/tests/monads.scm index d3f78e1568..b51e705f01 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -126,6 +126,30 @@ (define (g x) (readlink (string-append out "/guile-rocks")))))) #:guile-for-build (package-derivation %store %bootstrap-guile))) +(test-assert "text-file*" + (let ((references (store-lift references))) + (run-with-store %store + (mlet* %store-monad + ((drv (package->derivation %bootstrap-guile)) + (guile -> (derivation->output-path drv)) + (file (text-file "bar" "This is bar.")) + (text (text-file* "foo" + %bootstrap-guile "/bin/guile " + `(,%bootstrap-guile "out") "/bin/guile " + drv "/bin/guile " + file)) + (done (built-derivations (list text))) + (out -> (derivation->output-path text)) + (refs (references out))) + ;; Make sure we get the right references and the right content. + (return (and (lset= string=? refs (list guile file)) + (equal? (call-with-input-file out get-string-all) + (string-append guile "/bin/guile " + guile "/bin/guile " + guile "/bin/guile " + file))))) + #:guile-for-build (package-derivation %store %bootstrap-guile)))) + (test-assert "mapm" (every (lambda (monad run) (with-monad monad -- cgit v1.2.3 From 7c9325a9ecad1a8d02793aadb2e1730b4a8de48b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 3 Feb 2014 23:37:09 +0100 Subject: gnu: dmd: Use 'text-file*' when building Xorg's config file. * gnu/system/dmd.scm (xorg-service)[xserver.conf]: Change to use 'text-file*' instead of 'text-file'. Adjust body accordingly. Remove now extraneous packages from the service's 'inputs' field. --- gnu/system/dmd.scm | 41 ++++++++++++++--------------------------- 1 file changed, 14 insertions(+), 27 deletions(-) diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm index 505c4c9afb..656c2f5634 100644 --- a/gnu/system/dmd.scm +++ b/gnu/system/dmd.scm @@ -273,26 +273,15 @@ (define* (static-networking-service interface ip (define (xorg-service) "Return a service that starts the Xorg graphical display server." (define (xserver.conf) - (mlet %store-monad ((fonts (package-file font-adobe75dpi - "lib/X11/fonts")) - (xorg (package-file xorg-server - "lib/xorg/modules")) - (vesa (package-file xf86-video-vesa - "lib/xorg/modules/drivers")) - (kbd (package-file xf86-input-keyboard - "lib/xorg/modules/input")) - (mouse (package-file xf86-input-mouse - "lib/xorg/modules/input"))) - (text-file "xserver.conf" ; let's go! - (string-append " + (text-file* "xserver.conf" " Section \"Files\" - FontPath \"" fonts "\" - ModulePath \"" vesa "\" - ModulePath \"" mouse "\" - ModulePath \"" kbd "\" - ModulePath \"" xorg "\" - ModulePath \"" xorg "/extensions\" - ModulePath \"" xorg "/multimedia\" + FontPath \"" font-adobe75dpi "/lib/X11/fonts\" + ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" + ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" + ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\" + ModulePath \"" xorg-server "/lib/xorg/modules\" + ModulePath \"" xorg-server "/lib/xorg/modules/extensions\" + ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\" EndSection Section \"ServerFlags\" @@ -323,7 +312,7 @@ (define (xserver.conf) Section \"Screen\" Identifier \"Screen-vesa\" Device \"Device-vesa\" -EndSection")))) +EndSection")) (mlet %store-monad ((xorg-bin (package-file xorg-server "bin/X")) (dri (package-file mesa "lib/dri")) @@ -344,19 +333,17 @@ (define (xserver.conf) "XKB_BINDIR=" xkbcomp-bin " " xorg-bin " -ac -logverbose -verbose " "-xkbdir " xkb-dir " " - "-config " config " " + "-config " + (derivation->output-path config) " " "-nolisten tcp :0 vt7"))) (stop `(make-kill-destructor)) (respawn? #f) (inputs `(("xorg" ,xorg-server) - ("mesa" ,mesa) ("xkbcomp" ,xkbcomp) ("xkeyboard-config" ,xkeyboard-config) - ("vesa" ,xf86-video-vesa) - ("mouse" ,xf86-input-mouse) - ("kbd" ,xf86-input-keyboard) - ("fonts" ,font-adobe75dpi) - ("bash" ,bash))))))) + ("mesa" ,mesa) + ("bash" ,bash) + ("xorg.conf" ,config))))))) (define (dmd-configuration-file services etc) -- cgit v1.2.3 From 99b030c7052abb5bc80c7e2e892529f0de8e4bf2 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Tue, 4 Feb 2014 13:48:18 +0100 Subject: gnu: gxmessage: New module MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/gxmessage.scm: New file * gnu-system.am (GNU_SYSTEM_MODULES): Add gxmessage.scm Signed-off-by: Ludovic Courtès --- gnu-system.am | 1 + gnu/packages/gxmessage.scm | 50 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+) create mode 100644 gnu/packages/gxmessage.scm diff --git a/gnu-system.am b/gnu-system.am index 1f7327e865..0a9fb4651e 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -101,6 +101,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/guile.scm \ gnu/packages/guile-wm.scm \ gnu/packages/gv.scm \ + gnu/packages/gxmessage.scm \ gnu/packages/help2man.scm \ gnu/packages/hugs.scm \ gnu/packages/icu4c.scm \ diff --git a/gnu/packages/gxmessage.scm b/gnu/packages/gxmessage.scm new file mode 100644 index 0000000000..425659274c --- /dev/null +++ b/gnu/packages/gxmessage.scm @@ -0,0 +1,50 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 John Darrington +;;; +;;; 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 . + +(define-module (gnu packages gxmessage) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages glib) + #:use-module (gnu packages pkg-config) + #:use-module (gnu packages gtk) + #:use-module (gnu packages)) + +(define-public gxmessage + (package + (name "gxmessage") + (version "2.20.0") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnu/gxmessage/gxmessage-" + version ".tar.gz")) + (sha256 + (base32 "1nq8r321x3rzcdkjlvj61i9x7smslnis7b05b39xqcjc9xyg4hv0")))) + (build-system gnu-build-system) + (inputs + `(("gtk+" ,gtk+-2))) + (native-inputs + `(("intltool" ,intltool) + ("pkg-config" ,pkg-config))) + (home-page "http://www.gnu.org/software/gxmessage/") + (synopsis "Open popup message window with buttons for return") + (description "GNU gxmessage is a program that pops up dialog windows, which display +a message to the user and waits for their action. The program then exits +with an exit code corresponding to the response.") + (license gpl3+))) -- cgit v1.2.3 From 2a72eeeea1e199a16cad2db5c62fb2ee1fac020b Mon Sep 17 00:00:00 2001 From: John Darrington Date: Tue, 4 Feb 2014 16:12:38 +0100 Subject: gnu: Add Boost. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/boost.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add boost.scm Signed-off-by: Ludovic Courtès --- gnu-system.am | 1 + gnu/packages/boost.scm | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 90 insertions(+) create mode 100644 gnu/packages/boost.scm diff --git a/gnu-system.am b/gnu-system.am index 0a9fb4651e..8355104a28 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -40,6 +40,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/bdb.scm \ gnu/packages/bdw-gc.scm \ gnu/packages/bison.scm \ + gnu/packages/boost.scm \ gnu/packages/bootstrap.scm \ gnu/packages/cdrom.scm \ gnu/packages/cflow.scm \ diff --git a/gnu/packages/boost.scm b/gnu/packages/boost.scm new file mode 100644 index 0000000000..73b377e384 --- /dev/null +++ b/gnu/packages/boost.scm @@ -0,0 +1,89 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 John Darrington +;;; +;;; 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 . + +(define-module (gnu packages boost) + #:use-module ((guix licenses) + #:renamer (symbol-prefix-proc 'license:)) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages) + #:use-module (gnu packages python) + #:use-module (gnu packages tcsh) + #:use-module (gnu packages perl)) + +(define-public boost + (package + (name "boost") + (version "1.55.0") + (source (origin + (method url-fetch) + (uri (string-append + "mirror://sourceforge/boost/boost_" + (string-map (lambda (x) (if (eq? x #\.) #\_ x)) version) + ".tar.bz2")) + (sha256 + (base32 + "0lkv5dzssbl5fmh2nkaszi8x9qbj80pr4acf9i26sj3rvlih1w7z")))) + (build-system gnu-build-system) + (native-inputs + `(("perl" ,perl) + ("python" ,python-2) + ("tcsh" ,tcsh))) + (arguments + `(#:phases + (alist-replace + 'configure + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (substitute* '("libs/config/configure" + "libs/spirit/classic/phoenix/test/runtest.sh" + "tools/build/v2/doc/bjam.qbk" + "tools/build/v2/engine/execunix.c" + "tools/build/v2/engine/Jambase" + "tools/build/v2/engine/jambase.c") + (("/bin/sh") (which "sh"))) + + (setenv "SHELL" (which "sh")) + (setenv "CONFIG_SHELL" (which "sh")) + + (zero? (system* "./bootstrap.sh" + (string-append "--prefix=" out) + "--with-toolset=gcc")))) + (alist-replace + 'build + (lambda _ + (zero? (system* "./b2" "threading=multi" "link=shared"))) + + (alist-replace + 'check + (lambda _ #t) + + (alist-replace + 'install + (lambda _ + (zero? (system* "./b2" "install" "threading=multi" "link=shared"))) + %standard-phases)))))) + + (home-page "http://boost.org") + (synopsis "Peer-reviewed portable C++ source libraries") + (description + "A collection of libraries intended to be widely useful, and usable +across a broad spectrum of applications.") + (license (license:x11-style "http://www.boost.org/LICENSE_1_0.txt" + "Some components have other similar licences.")))) -- cgit v1.2.3 From 1d07e9316a84a47da54469d63b1825368c0db720 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Tue, 4 Feb 2014 16:12:39 +0100 Subject: gnu: inkscape: New module MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/inkscape.scm, gnu/packages/patches/inkscape-stray-comma.patch: New files. * gnu-system.am (GNU_SYSTEM_MODULES): Add inkscape.scm. (dist_patch_DATA): Add inkscape-stray-comma.patch. Signed-off-by: Ludovic Courtès --- gnu-system.am | 2 + gnu/packages/inkscape.scm | 79 +++++++++++++++++++++++++ gnu/packages/patches/inkscape-stray-comma.patch | 13 ++++ 3 files changed, 94 insertions(+) create mode 100644 gnu/packages/inkscape.scm create mode 100644 gnu/packages/patches/inkscape-stray-comma.patch diff --git a/gnu-system.am b/gnu-system.am index 8355104a28..66c9ab39cd 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -109,6 +109,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/idutils.scm \ gnu/packages/imagemagick.scm \ gnu/packages/indent.scm \ + gnu/packages/inkscape.scm \ gnu/packages/irssi.scm \ gnu/packages/iso-codes.scm \ gnu/packages/kde.scm \ @@ -269,6 +270,7 @@ dist_patch_DATA = \ gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \ gnu/packages/patches/gtkglext-remove-pangox-dependency.patch \ gnu/packages/patches/hop-bigloo-4.0b.patch \ + gnu/packages/patches/inkscape-stray-comma.patch \ gnu/packages/patches/libevent-dns-tests.patch \ gnu/packages/patches/libffi-mips-n32-fix.patch \ gnu/packages/patches/liboop-mips64-deplibs-fix.patch \ diff --git a/gnu/packages/inkscape.scm b/gnu/packages/inkscape.scm new file mode 100644 index 0000000000..6b8669f373 --- /dev/null +++ b/gnu/packages/inkscape.scm @@ -0,0 +1,79 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 John Darrington +;;; +;;; 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 . + +(define-module (gnu packages inkscape) + #:use-module ((guix licenses) + #:renamer (symbol-prefix-proc 'license:)) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages) + #:use-module (gnu packages aspell) + #:use-module (gnu packages bdw-gc) + #:use-module (gnu packages boost) + #:use-module (gnu packages glib) + #:use-module (gnu packages gtk) + #:use-module (gnu packages maths) + #:use-module (gnu packages perl) + #:use-module (gnu packages pdf) + #:use-module (gnu packages popt) + #:use-module (gnu packages python) + #:use-module (gnu packages xml) + #:use-module (gnu packages ghostscript) + #:use-module (gnu packages fontutils) + #:use-module (gnu packages libpng) + #:use-module (gnu packages pkg-config)) + +(define-public inkscape + (package + (name "inkscape") + (version "0.48.4") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/inkscape/inkscape-" + version ".tar.gz")) + (sha256 + (base32 + "0nhxsgrgsx6zrgpkd1akxjvmdqjp8ccnsvlwxh62l0brg84fw6bf")) + (patches (list (search-patch "inkscape-stray-comma.patch"))))) + (build-system gnu-build-system) + (inputs + `(("aspell" ,aspell) + ("gtkmm" ,gtkmm-2) + ("gtk" ,gtk+-2) + ("gsl" ,gsl) + ("poppler" ,poppler) + ("libpng" ,libpng) + ("libxml2" ,libxml2) + ("libxslt" ,libxslt) + ("libgc" ,libgc) + ("freetype" ,freetype) + ("popt" ,popt) + ("python" ,python-2) + ("lcms" ,lcms) + ("boost" ,boost))) + (native-inputs + `(("intltool" ,intltool) + ("perl" ,perl) + ("pkg-config" ,pkg-config))) + (home-page "http://inkscape.org/") + (synopsis "Vector graphics editor") + (description "Inkscape is a vector graphics editor. What sets Inkscape +apart is its use of Scalable Vector Graphics (SVG), an XML-based W3C standard, +as the native format.") + (license license:gpl2+))) diff --git a/gnu/packages/patches/inkscape-stray-comma.patch b/gnu/packages/patches/inkscape-stray-comma.patch new file mode 100644 index 0000000000..0b000d9e30 --- /dev/null +++ b/gnu/packages/patches/inkscape-stray-comma.patch @@ -0,0 +1,13 @@ +This is verbatim from Upstream: http://bazaar.launchpad.net/~inkscape.dev/inkscape/RELEASE_0_48_BRANCH/diff/9943 +--- a/src/widgets/desktop-widget.h 2011-06-06 06:43:00 +0000 ++++ b/src/widgets/desktop-widget.h 2013-01-05 14:34:09 +0000 +@@ -239,7 +239,7 @@ + private: + GtkWidget *tool_toolbox; + GtkWidget *aux_toolbox; +- GtkWidget *commands_toolbox,; ++ GtkWidget *commands_toolbox; + GtkWidget *snap_toolbox; + + static void init(SPDesktopWidget *widget); + -- cgit v1.2.3 From 16686a902276c827455d78860dd62aaa68922cd2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 5 Feb 2014 22:18:14 +0100 Subject: gnu: slim: Upgrade to 1.3.6; allow the choice of a config file at run time. * gnu/packages/slim.scm (slim): Upgrade to 1.3.6. Add patches. Comment out systemd-related stuff from CMakeLists.txt. Add "-DBUILD_SHARED_LIBS=OFF" and "-DCMAKE_SKIP_BUILD_RPATH=ON" to #:configure-flags. Adjust 'home-page' field. * gnu/packages/patches/slim-config.patch, gnu/packages/patches/slim-session.patch: New files. * gnu-system.am (dist_patch_DATA): Add them. --- gnu-system.am | 2 ++ gnu/packages/patches/slim-config.patch | 27 +++++++++++++++++++++++++++ gnu/packages/patches/slim-session.patch | 17 +++++++++++++++++ gnu/packages/slim.scm | 31 ++++++++++++++++++++++++------- 4 files changed, 70 insertions(+), 7 deletions(-) create mode 100644 gnu/packages/patches/slim-config.patch create mode 100644 gnu/packages/patches/slim-session.patch diff --git a/gnu-system.am b/gnu-system.am index 66c9ab39cd..2e248c7df7 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -296,6 +296,8 @@ dist_patch_DATA = \ gnu/packages/patches/readline-link-ncurses.patch \ gnu/packages/patches/ripperx-libm.patch \ gnu/packages/patches/scheme48-tests.patch \ + gnu/packages/patches/slim-session.patch \ + gnu/packages/patches/slim-config.patch \ gnu/packages/patches/tcsh-fix-autotest.patch \ gnu/packages/patches/teckit-cstdio.patch \ gnu/packages/patches/valgrind-glibc.patch \ diff --git a/gnu/packages/patches/slim-config.patch b/gnu/packages/patches/slim-config.patch new file mode 100644 index 0000000000..5e6135d75c --- /dev/null +++ b/gnu/packages/patches/slim-config.patch @@ -0,0 +1,27 @@ +Allow the configuration file and theme directory to be specified at run time. +Patch by Eelco Dolstra, from Nixpkgs. + +--- slim-1.3.6/app.cpp 2013-10-02 00:38:05.000000000 +0200 ++++ slim-1.3.6/app.cpp 2013-10-15 11:02:55.629263422 +0200 +@@ -200,7 +200,9 @@ + + /* Read configuration and theme */ + cfg = new Cfg; +- cfg->readConf(CFGFILE); ++ char *cfgfile = getenv("SLIM_CFGFILE"); ++ if (!cfgfile) cfgfile = CFGFILE; ++ cfg->readConf(cfgfile); + string themebase = ""; + string themefile = ""; + string themedir = ""; +@@ -208,7 +210,9 @@ + if (testing) { + themeName = testtheme; + } else { +- themebase = string(THEMESDIR) + "/"; ++ char *themesdir = getenv("SLIM_THEMESDIR"); ++ if (!themesdir) themesdir = THEMESDIR; ++ themebase = string(themesdir) + "/"; + themeName = cfg->getOption("current_theme"); + string::size_type pos; + if ((pos = themeName.find(",")) != string::npos) { diff --git a/gnu/packages/patches/slim-session.patch b/gnu/packages/patches/slim-session.patch new file mode 100644 index 0000000000..b85d3f7dd0 --- /dev/null +++ b/gnu/packages/patches/slim-session.patch @@ -0,0 +1,17 @@ +Exit after the user's session has finished. This works around slim's broken +PAM session handling (see +http://developer.berlios.de/bugs/?func=detailbug&bug_id=19102&group_id=2663). + +Patch by Eelco Dolstra, from Nixpkgs. + +--- slim-1.3.6/app.cpp 2013-10-15 11:02:55.629263422 +0200 ++++ slim-1.3.6/app.cpp 2013-10-15 13:00:10.141210784 +0200 +@@ -816,7 +822,7 @@ + StopServer(); + RemoveLock(); + while (waitpid(-1, NULL, WNOHANG) > 0); /* Collects all dead childrens */ +- Run(); ++ exit(OK_EXIT); + } + + void App::KillAllClients(Bool top) { diff --git a/gnu/packages/slim.scm b/gnu/packages/slim.scm index fd2c73c772..1a1feadede 100644 --- a/gnu/packages/slim.scm +++ b/gnu/packages/slim.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Guy Grant +;;; Copyright © 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +24,7 @@ (define-module (gnu packages slim) #:use-module (guix download) #:use-module (guix build-system cmake) #:use-module (guix packages) + #:use-module (gnu packages) #:use-module (gnu packages gl) #:use-module (gnu packages xorg) #:use-module (gnu packages libpng) @@ -34,13 +36,17 @@ (define-module (gnu packages slim) (define-public slim (package (name "slim") - (version "1.3.3") + (version "1.3.6") (source (origin (method url-fetch) - (uri (string-append "mirror://sourceforge/project/slim.berlios/slim-" + ;; Used to be available from + ;; mirror://sourceforge/project/slim.berlios/. + (uri (string-append "http://download.berlios.de/slim/slim-" version ".tar.gz")) (sha256 - (base32 "1fdvipj3658s8dm78djmfr8xhg6l8rr7kc4qcb34bjrnkkclhln1")))) + (base32 "1pqhk22jb4aja4hkrm7rjgbgzjyh7i4zswdgf5nw862l2znzxpi1")) + (patches (map search-patch + (list "slim-config.patch" "slim-session.patch"))))) (build-system cmake-build-system) (inputs `(("linux-pam" ,linux-pam) ("libpng" ,libpng) @@ -62,12 +68,23 @@ (define-public slim (lambda _ (substitute* "CMakeLists.txt" (("/etc") - (string-append - (assoc-ref %outputs "out") "/etc")))) + (string-append (assoc-ref %outputs "out") "/etc")) + (("install.*systemd.*") + ;; The build system's logic here is: if "Linux", then + ;; "systemd". Strip that. + ""))) %standard-phases) - #:configure-flags '("-DUSE_PAM=yes" "-DUSE_CONSOLEKIT=no") + #:configure-flags '("-DUSE_PAM=yes" "-DUSE_CONSOLEKIT=no" + + ;; Don't build libslim.so, because then the build + ;; system is unable to set the right RUNPATH on the + ;; 'slim' binary. + "-DBUILD_SHARED_LIBS=OFF" + + ;; Leave a valid RUNPATH upon install. + "-DCMAKE_SKIP_BUILD_RPATH=ON") #:tests? #f)) - (home-page "http://www.slim.berlios.de/") + (home-page "http://slim.berlios.de/") (synopsis "Desktop-independent graphcal login manager for X11") (description "SLiM is a Desktop-independent graphical login manager for X11, derived -- cgit v1.2.3 From 7aec36830faf5de613ca2ae64b1845545ad12da9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 5 Feb 2014 22:22:51 +0100 Subject: gnu: system: Build /etc/localtime. * gnu/system.scm (etc-directory)[bashrc]: Use 'text-file*' instead of 'text-file'. Adjust users accordingly. [files]: Add the /etc/localtime file for TIMEZONE. Add TZDATA to the 'file-union' inputs. (operating-system-derivation): Pass 'etc-directory' PROFILE-DRV instead of PROFILE. --- gnu/system.scm | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/gnu/system.scm b/gnu/system.scm index 514e67ab9a..e06b8103a5 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -251,38 +251,39 @@ (define* (etc-directory #:key You can log in as 'guest' or 'root' with no password. ")) - ;; Assume TZDATA is installed---e.g., as part of the system packages. - ;; Users can choose not to have it. - (tzdir (package-file tzdata "share/zoneinfo")) - ;; TODO: Generate bashrc from packages' search-paths. - (bashrc (text-file "bashrc" (string-append " + (bashrc (text-file* "bashrc" " export PS1='\\u@\\h\\$ ' export LC_ALL=\"" locale "\" export TZ=\"" timezone "\" -export TZDIR=\"" tzdir "\" +export TZDIR=\"" tzdata "/share/zoneinfo\" export PATH=$HOME/.guix-profile/bin:" profile "/bin:" profile "/sbin export CPATH=$HOME/.guix-profile/include:" profile "/include export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib alias ls='ls -p --color' alias ll='ls -l' -"))) +")) + (tz-file (package-file tzdata + (string-append "share/zoneinfo/" timezone))) (files -> `(("services" ,services) ("protocols" ,protocols) ("rpc" ,rpc) ("pam.d" ,(derivation->output-path pam.d)) ("login.defs" ,login.defs) ("issue" ,issue) - ("profile" ,bashrc) + ("profile" ,(derivation->output-path bashrc)) + ("localtime" ,tz-file) ("passwd" ,passwd) ("shadow" ,shadow) ("group" ,group)))) (file-union files #:inputs `(("net" ,net-base) - ("pam.d" ,pam.d)) + ("pam.d" ,pam.d) + ("bashrc" ,bashrc) + ("tzdata" ,tzdata)) #:name "etc"))) (define (operating-system-profile-derivation os) @@ -329,7 +330,7 @@ (define (operating-system-derivation os) #:pam-services pam-services #:locale (operating-system-locale os) #:timezone (operating-system-timezone os) - #:profile profile)) + #:profile profile-drv)) (etc -> (derivation->output-path etc-drv)) (dmd-conf (dmd-configuration-file services etc)) -- cgit v1.2.3 From c36b22281e3b1fc41d229417e91442f260a68805 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 5 Feb 2014 23:21:24 +0100 Subject: gnu: guile-wm: Upgrade to 1.0. * gnu/packages/guile-wm.scm (guile-wm): Upgrade to 1.0. --- gnu/packages/guile-wm.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/packages/guile-wm.scm b/gnu/packages/guile-wm.scm index 1dc9f3f50a..b05974c8ae 100644 --- a/gnu/packages/guile-wm.scm +++ b/gnu/packages/guile-wm.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -73,14 +73,14 @@ (define-public guile-xcb (define-public guile-wm (package (name "guile-wm") - (version "0.2") + (version "1.0") (source (origin (method url-fetch) (uri (string-append "http://www.markwitmer.com/dist/guile-wm-" version ".tar.gz")) (sha256 (base32 - "0vv6avpkl6lgrhy2a16z470fqjhvzi4r93qwl87xw9v5dvldf08p")))) + "1l9qcz236jxvryndimjy62cf8zxf8i3f8vg3zpqqjhw15j9mdk3r")))) (build-system gnu-build-system) (arguments '(;; The '.scm' files go to $(datadir), so set that to the ;; standard value. -- cgit v1.2.3 From 8254b480664ad3af84564804dfc6ad2dd9b88afb Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Wed, 5 Feb 2014 15:48:19 -0600 Subject: gnu: gnu-pw-mgr: Upgrade to 1.1. * gnu/packages/gnu-pw-mgr.scm (gnu-pw-mgr): Upgrade to 1.1. Signed-off-by: Andreas Enge --- gnu/packages/gnu-pw-mgr.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/gnu/packages/gnu-pw-mgr.scm b/gnu/packages/gnu-pw-mgr.scm index d8340d6712..3b66cde018 100644 --- a/gnu/packages/gnu-pw-mgr.scm +++ b/gnu/packages/gnu-pw-mgr.scm @@ -27,15 +27,16 @@ (define-module (gnu packages gnu-pw-mgr) (define-public gnu-pw-mgr (package (name "gnu-pw-mgr") - (version "1.0") + (version "1.1") (source (origin (method url-fetch) - (uri (string-append "mirror://gnu/gnu-pw-mgr/gnu-pw-mgr-" + (uri (string-append "mirror://gnu/gnu-pw-mgr/gpw-" + version "/gnu-pw-mgr-" version ".tar.gz")) (sha256 (base32 - "0sn9gzngqkrv74iwxzn5ldqx3w73w9paldcdh8rsv9yvgarv2bm4")))) + "1nqkwjsdcif51d1s4dizr1ifx0qpmkjzvi375vc27dwbav4dwalx")))) (build-system gnu-build-system) (inputs `(("which" ,which))) (home-page "http://www.gnu.org/software/gnu-pw-mgr/") -- cgit v1.2.3 From c6ebb77cb7c3e845ddc8f4fc13d9dad7f5cd3a28 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Thu, 6 Feb 2014 09:32:12 +0100 Subject: gnu: imagemagick: Upgrade to 6.8.8-4. * gnu/packages/imagemagick.scm (imagemagick): Upgrade to 6.8.8-4. --- gnu/packages/imagemagick.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/imagemagick.scm b/gnu/packages/imagemagick.scm index 0d574731f9..a1713273e9 100644 --- a/gnu/packages/imagemagick.scm +++ b/gnu/packages/imagemagick.scm @@ -37,14 +37,14 @@ (define-module (gnu packages imagemagick) (define-public imagemagick (package (name "imagemagick") - (version "6.8.7-9") + (version "6.8.8-4") (source (origin (method url-fetch) (uri (string-append "mirror://imagemagick/ImageMagick-" version ".tar.xz")) (sha256 (base32 - "0625hqddc93qjd5923yivy74jyagk3n2bi2kjgykn86g7kxh7fcd")))) + "0bfxhfymkdbvardlr0nbjfmv53m47lcl9kkycipk4hxawfs927jr")))) (build-system gnu-build-system) (arguments `(#:phases (alist-cons-before -- cgit v1.2.3 From 3600420e3e4bfc105e3d01474688ab10a7eb37a6 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Wed, 5 Feb 2014 21:27:20 +0100 Subject: gnu: Add Glade. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/gnome.scm (glade): New variable. Signed-off-by: Ludovic Courtès --- gnu/packages/gnome.scm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index 90683f3635..5d17b019fd 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -496,3 +496,30 @@ (define-public gtkglext additional GDK objects which support OpenGL rendering in GTK+ and GtkWidget API add-ons to make GTK+ widgets OpenGL-capable.") (license lgpl2.1+))) + +(define-public glade3 + (package + (name "glade") + (version "3.8.4") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/" name "/" + (substring version 0 (string-rindex version #\.)) "/" + name "3-" version ".tar.xz")) + (sha256 + (base32 "021xgq2l18w3rvwms9aq2idm0fk66vwb4f777gs0qh3ap5shgbn7")))) + (build-system gnu-build-system) + (inputs + `(("gtk+" ,gtk+-2) + ("libxml2" ,libxml2))) + (native-inputs + `(("intltool" ,intltool) + ("python" ,python) + ("pkg-config" ,pkg-config))) + (home-page "https://glade.gnome.org") + (synopsis "GTK+ rapid application development tool") + (description "Glade is a rapid application development (RAD) tool to +enable quick & easy development of user interfaces for the GTK+ toolkit and +the GNOME desktop environment.") + (license lgpl2.0+))) -- cgit v1.2.3 From 924cd631168ba6d03e7aee57f3e02d4c0959f9dd Mon Sep 17 00:00:00 2001 From: Raimon Grau Date: Thu, 6 Feb 2014 01:43:31 +0100 Subject: gnu: Add luajit MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/lua.scm (luajit): New variable. Signed-off-by: Ludovic Courtès --- gnu/packages/lua.scm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/gnu/packages/lua.scm b/gnu/packages/lua.scm index 14fc28ced0..81caa263ad 100644 --- a/gnu/packages/lua.scm +++ b/gnu/packages/lua.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Cyril Roelandt +;;; Copyright © 2014 Raimon Grau ;;; ;;; This file is part of GNU Guix. ;;; @@ -61,3 +62,27 @@ (define-public lua automatic memory management with incremental garbage collection, making it ideal for configuration, scripting, and rapid prototyping.") (license x11))) + +(define-public luajit + (package + (name "luajit") + (version "2.0.2") + (source (origin + (method url-fetch) + (uri (string-append "http://luajit.org/download/LuaJIT-" + version ".tar.gz")) + (sha256 + (base32 "0f3cykihfdn3gi6na9p0xjd4jnv26z18m441n5vyg42q9abh4ln0")))) + (build-system gnu-build-system) + (arguments + '(#:tests? #f ;luajit is distributed without tests + #:phases (alist-delete 'configure %standard-phases) + #:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))))) + (home-page "http://www.luajit.org/") + (synopsis "Just in time compiler for Lua programming language version 5.1") + (description + "LuaJIT is a Just-In-Time Compiler (JIT) for the Lua +programming language. Lua is a powerful, dynamic and light-weight programming +language. It may be embedded or used as a general-purpose, stand-alone +language.") + (license x11))) -- cgit v1.2.3 From c37b2b2aa5326feeeb4fa8edff988adf6fb96f15 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 6 Feb 2014 19:07:10 +0100 Subject: Add Raimon to 'AUTHORS'. --- AUTHORS | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS b/AUTHORS index 6ec176cb9b..0c50e3cb27 100644 --- a/AUTHORS +++ b/AUTHORS @@ -13,6 +13,7 @@ alphabetical order): John Darrington Andreas Enge Guy Grant + Raimon Grau Nikita Karetnikov Aljosha Papsch Cyril Roelandt -- cgit v1.2.3 From 6e37066e76ce4ffaf8328242d941ca2e0af2965a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 6 Feb 2014 21:49:47 +0100 Subject: daemon: Add '--gc-keep-outputs' and '--gc-keep-derivations'. * nix/nix-daemon/guix-daemon.cc (GUIX_OPT_GC_KEEP_OUTPUTS, GUIX_OPT_GC_KEEP_DERIVATIONS): New macros. (options): Add 'gc-keep-outputs' and 'gc-keep-derivations'. (string_to_bool): New function. (parse_opt): Honor GUIX_OPT_GC_KEEP_DERIVATIONS and GUIX_OPT_GC_KEEP_OUTPUTS. * doc/guix.texi (Invoking guix-daemon): Document --gc-keep-outputs and --gc-keep-derivations. --- doc/guix.texi | 24 ++++++++++++++++++++++++ nix/nix-daemon/guix-daemon.cc | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 57 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index 28b1cb8bd7..af84b75108 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -502,6 +502,30 @@ the daemon makes the new file a hard link to the other file. This slightly increases the input/output load at the end of a build process. This option disables this. +@item --gc-keep-outputs[=yes|no] +Tell whether the garbage collector (GC) must keep outputs of live +derivations. + +When set to ``yes'', the GC will keep the outputs of any live derivation +available in the store---the @code{.drv} files. The default is ``no'', +meaning that derivation outputs are kept only if they are GC roots. + +@item --gc-keep-derivations[=yes|no] +Tell whether the garbage collector (GC) must keep derivations +corresponding to live outputs. + +When set to ``yes'', as is the case by default, the GC keeps +derivations---i.e., @code{.drv} files---as long as at least one of their +outputs is live. This allows users to keep track of the origins of +items in their store. Setting it to ``no'' saves a bit of disk space. + +Note that when both @code{--gc-keep-derivations} and +@code{--gc-keep-outputs} are used, the effect is to keep all the build +prerequisites (the sources, compiler, libraries, and other build-time +tools) of live objects in the store, regardless of whether these +prerequisites are live. This is convenient for developers since it +saves rebuilds or downloads. + @item --impersonate-linux-2.6 On Linux-based systems, impersonate Linux 2.6. This means that the kernel's @code{uname} system call will report 2.6 as the release number. diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc index d35b1cd076..79cd080363 100644 --- a/nix/nix-daemon/guix-daemon.cc +++ b/nix/nix-daemon/guix-daemon.cc @@ -30,6 +30,7 @@ #include #include #include +#include #include /* Variables used by `nix-daemon.cc'. */ @@ -68,6 +69,8 @@ builds derivations on behalf of its clients."; #define GUIX_OPT_LISTEN 11 #define GUIX_OPT_NO_SUBSTITUTES 12 #define GUIX_OPT_NO_BUILD_HOOK 13 +#define GUIX_OPT_GC_KEEP_OUTPUTS 14 +#define GUIX_OPT_GC_KEEP_DERIVATIONS 15 static const struct argp_option options[] = { @@ -111,6 +114,14 @@ static const struct argp_option options[] = " (this option has no effect in this configuration)" #endif }, + { "gc-keep-outputs", GUIX_OPT_GC_KEEP_OUTPUTS, + "yes/no", OPTION_ARG_OPTIONAL, + "Tell whether the GC must keep outputs of live derivations" }, + { "gc-keep-derivations", GUIX_OPT_GC_KEEP_DERIVATIONS, + "yes/no", OPTION_ARG_OPTIONAL, + "Tell whether the GC must keep derivations corresponding \ +to live outputs" }, + { "listen", GUIX_OPT_LISTEN, "SOCKET", 0, "Listen for connections on SOCKET" }, { "debug", GUIX_OPT_DEBUG, 0, 0, @@ -118,6 +129,22 @@ static const struct argp_option options[] = { 0, 0, 0, 0, 0 } }; + +/* Convert ARG to a Boolean value, or throw an error if it does not denote a + Boolean. */ +static bool +string_to_bool (const char *arg, bool dflt = true) +{ + if (arg == NULL) + return dflt; + else if (strcasecmp (arg, "yes") == 0) + return true; + else if (strcasecmp (arg, "no") == 0) + return false; + else + throw nix::Error (format ("'%1%': invalid Boolean value") % arg); +} + /* Parse a single option. */ static error_t parse_opt (int key, char *arg, struct argp_state *state) @@ -168,6 +195,12 @@ parse_opt (int key, char *arg, struct argp_state *state) case GUIX_OPT_DEBUG: verbosity = lvlDebug; break; + case GUIX_OPT_GC_KEEP_OUTPUTS: + settings.gcKeepOutputs = string_to_bool (arg); + break; + case GUIX_OPT_GC_KEEP_DERIVATIONS: + settings.gcKeepDerivations = string_to_bool (arg); + break; case 'c': settings.buildCores = atoi (arg); break; -- cgit v1.2.3 From b93afd5b53714cb896e2abdea1e0b405550fb67b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 6 Feb 2014 22:09:52 +0100 Subject: gnu: gdb: Upgrade to 7.7. * gnu/packages/gdb.scm (gdb): Upgrade to 7.7. Remove 'gdb-loongson-madd-fix.patch', no longer needed. * gnu/packages/patches/gdb-loongson-madd-fix.patch: Remove. * gnu-system.am (dist_patch_DATA): Adjust accordingly. --- gnu-system.am | 1 - gnu/packages/gdb.scm | 7 ++-- gnu/packages/patches/gdb-loongson-madd-fix.patch | 44 ------------------------ 3 files changed, 3 insertions(+), 49 deletions(-) delete mode 100644 gnu/packages/patches/gdb-loongson-madd-fix.patch diff --git a/gnu-system.am b/gnu-system.am index 2e248c7df7..eb1e0d06dc 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -250,7 +250,6 @@ dist_patch_DATA = \ gnu/packages/patches/gawk-shell.patch \ gnu/packages/patches/gcc-cross-environment-variables.patch \ gnu/packages/patches/gd-mips64-deplibs-fix.patch \ - gnu/packages/patches/gdb-loongson-madd-fix.patch \ gnu/packages/patches/glib-tests-desktop.patch \ gnu/packages/patches/glib-tests-homedir.patch \ gnu/packages/patches/glib-tests-newnet.patch \ diff --git a/gnu/packages/gdb.scm b/gnu/packages/gdb.scm index 5a863e54aa..7a780d8ea2 100644 --- a/gnu/packages/gdb.scm +++ b/gnu/packages/gdb.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,15 +33,14 @@ (define-module (gnu packages gdb) (define-public gdb (package (name "gdb") - (version "7.6.2") + (version "7.7") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/gdb/gdb-" version ".tar.bz2")) (sha256 (base32 - "1s6hjqmq7xz10hqx45dgrpfh5mla578shn3zxgnrsv66w4n0wsig")) - (patches (list (search-patch "gdb-loongson-madd-fix.patch"))))) + "08vcb97j1b7vxwq6088wb6s3g3bm8iwikd922y0xsgbbxv3d2104")))) (build-system gnu-build-system) (arguments '(#:phases (alist-cons-after diff --git a/gnu/packages/patches/gdb-loongson-madd-fix.patch b/gnu/packages/patches/gdb-loongson-madd-fix.patch deleted file mode 100644 index 0d50dd2dd4..0000000000 --- a/gnu/packages/patches/gdb-loongson-madd-fix.patch +++ /dev/null @@ -1,44 +0,0 @@ -Fix the Loongson 2F specific fused multiply-add instructions on paired singles to -use the encoding recognized by the processor, as opposed to the mistaken english -Loongson 2F documentation. - -Patch by Mark H Weaver . - ---- gdb/opcodes/mips-opc.c.orig 2013-02-09 05:24:18.000000000 -0500 -+++ gdb/opcodes/mips-opc.c 2013-10-27 23:35:20.191997541 -0400 -@@ -956,7 +956,7 @@ - {"madd.s", "D,S,T", 0x4600001c, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, EE }, - {"madd.ps", "D,R,S,T", 0x4c000026, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 }, - {"madd.ps", "D,S,T", 0x45600018, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E }, --{"madd.ps", "D,S,T", 0x71600018, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F }, -+{"madd.ps", "D,S,T", 0x72c00018, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F }, - {"madd", "s,t", 0x0000001c, 0xfc00ffff, RD_s|RD_t|WR_HILO, 0, L1 }, - {"madd", "s,t", 0x70000000, 0xfc00ffff, RD_s|RD_t|MOD_HILO, 0, I32|N55 }, - {"madd", "s,t", 0x70000000, 0xfc00ffff, RD_s|RD_t|WR_HILO|IS_M, 0, G1 }, -@@ -1084,7 +1084,7 @@ - {"msub.s", "D,S,T", 0x4600001d, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, EE }, - {"msub.ps", "D,R,S,T", 0x4c00002e, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 }, - {"msub.ps", "D,S,T", 0x45600019, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E }, --{"msub.ps", "D,S,T", 0x71600019, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F }, -+{"msub.ps", "D,S,T", 0x72c00019, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F }, - {"msub", "s,t", 0x0000001e, 0xfc00ffff, RD_s|RD_t|WR_HILO, 0, L1 }, - {"msub", "s,t", 0x70000004, 0xfc00ffff, RD_s|RD_t|MOD_HILO, 0, I32|N55 }, - {"msub", "7,s,t", 0x70000004, 0xfc00e7ff, MOD_a|RD_s|RD_t, 0, D32 }, -@@ -1218,7 +1218,7 @@ - {"nmadd.s", "D,S,T", 0x7200001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, IL2F }, - {"nmadd.ps","D,R,S,T", 0x4c000036, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 }, - {"nmadd.ps", "D,S,T", 0x4560001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E }, --{"nmadd.ps", "D,S,T", 0x7160001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F }, -+{"nmadd.ps", "D,S,T", 0x72c0001a, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F }, - {"nmsub.d", "D,R,S,T", 0x4c000039, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I4_33 }, - {"nmsub.d", "D,S,T", 0x4620001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E }, - {"nmsub.d", "D,S,T", 0x7220001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F }, -@@ -1227,7 +1227,7 @@ - {"nmsub.s", "D,S,T", 0x7200001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_S, 0, IL2F }, - {"nmsub.ps","D,R,S,T", 0x4c00003e, 0xfc00003f, RD_R|RD_S|RD_T|WR_D|FP_D, 0, I5_33 }, - {"nmsub.ps", "D,S,T", 0x4560001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2E }, --{"nmsub.ps", "D,S,T", 0x7160001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F }, -+{"nmsub.ps", "D,S,T", 0x72c0001b, 0xffe0003f, RD_S|RD_T|WR_D|FP_D, 0, IL2F }, - /* nop is at the start of the table. */ - {"nor", "d,v,t", 0x00000027, 0xfc0007ff, WR_d|RD_s|RD_t, 0, I1 }, - {"nor", "t,r,I", 0, (int) M_NOR_I, INSN_MACRO, 0, I1 }, -- cgit v1.2.3 From 4380a7b4b866f03c4775966647075b1bcaf75f32 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Fri, 7 Feb 2014 10:55:42 -0600 Subject: gnu: Add paperkey. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/gnupg.scm (paperkey): New variable. Signed-off-by: Ludovic Courtès --- gnu/packages/gnupg.scm | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index 82293fbabd..499b20097f 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; Copyright © 2013 Andreas Enge +;;; Copyright © 2014 Eric Bavier ;;; ;;; This file is part of GNU Guix. ;;; @@ -422,3 +423,37 @@ (define-public pinentry "Pinentry provides a console and a GTK+ GUI that allows users to enter a passphrase when `gpg' or `gpg2' is run and needs it.") (license gpl2+))) + +(define-public paperkey + (package + (name "paperkey") + (version "1.3") + (source (origin + (method url-fetch) + (uri (string-append "http://www.jabberwocky.com/" + "software/paperkey/paperkey-" + version ".tar.gz")) + (sha256 + (base32 + "1yybj8bj68v4lxwpn596b6ismh2fyixw5vlqqg26byrn4d9dfmsv")))) + (build-system gnu-build-system) + (arguments + `(#:phases + (alist-replace + 'check + (lambda* (#:key #:allow-other-keys #:rest args) + (let ((check (assoc-ref %standard-phases 'check))) + (substitute* '("checks/roundtrip.sh" + "checks/roundtrip-raw.sh") + (("/bin/echo") "echo")) + (apply check args))) + %standard-phases))) + (home-page "http://www.jabberwocky.com/software/paperkey/") + (synopsis "Backup OpenPGP keys to paper") + (description + "Paperkey extracts the secret bytes from an OpenPGP (GnuPG, PGP, etc) key +for printing with paper and ink, which have amazingly long retention +qualities. To reconstruct a secret key, you re-enter those +bytes (whether by hand, OCR, QR code, or the like) and paperkey can use +them to transform your existing public key into a secret key.") + (license gpl2+))) -- cgit v1.2.3 From 7a03af707c1a77a660f3d45686587c87c11c7562 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 7 Feb 2014 23:44:26 +0100 Subject: gnu: python-pysqlite: Point to the latest release tarball. * gnu/packages/python.scm (python2-pysqlite): Change 'version' to "2.6.3a". Change 'uri' to point to pypi.python.org. Reported by Mark H Weaver and others. Update 'home-page' and 'synopsis'. --- gnu/packages/python.scm | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index b5070e7fda..44e3c14aa2 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Nikita Karetnikov -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; Copyright © 2013 Andreas Enge ;;; ;;; This file is part of GNU Guix. @@ -323,24 +323,28 @@ (define-public python2-dateutil (define-public python2-pysqlite (package (name "python2-pysqlite") - (version "2.6.3") + (version "2.6.3a") ; see below (source (origin (method url-fetch) - (uri (string-append "http://pysqlite.googlecode.com/files/pysqlite-" - version ".tar.gz")) + ;; During the switch from code.google.com to pypi.python.org, the 2.6.3 + ;; tarball was modified, but the version number was kept: + ;; . + ;; Here we want to refer to the pypi-hosted 2.6.3 tarball. + (uri (string-append + "https://pypi.python.org/packages/source/p/pysqlite/pysqlite-" + "2.6.3" ".tar.gz")) (sha256 (base32 - "0nsqqfp072rgqbls100rdvbzkjkin7li3kprhfxlfqvzf608hlqd")))) + "13djzgnbi71znjjyaw4nybg6smilgszcid646j5qav7mdchkb77y")))) (build-system python-build-system) (inputs `(("sqlite" ,sqlite))) (arguments `(#:python ,python-2 ; incompatible with Python 3 #:tests? #f)) ; no test target - (home-page "http://labix.org/python-dateutil") - (synopsis - "SQLite bindings for Python.") + (home-page "https://pypi.python.org/pypi/pysqlite") + (synopsis "SQLite bindings for Python") (description "Pysqlite provides SQLite bindings for Python that comply to the Database API 2.0T.") -- cgit v1.2.3 From ea0e9ce2e6d0c99106c47ee32203b92933a837de Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 8 Feb 2014 00:18:25 +0100 Subject: gnu: Move root's home directory to /root. * gnu/system.scm (operating-system-derivation): Change root's 'home-directory' to "/root". * gnu/system/vm.scm (operating-system-default-contents): Add /root. --- gnu/system.scm | 2 +- gnu/system/vm.scm | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/gnu/system.scm b/gnu/system.scm index e06b8103a5..6918d5bcb8 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -317,7 +317,7 @@ (define (operating-system-derivation os) (password "") (uid 0) (gid 0) (comment "System administrator") - (home-directory "/")) + (home-directory "/root")) (append (operating-system-users os) (append-map service-user-accounts services)))) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 1bdd2c6e92..dea7d0599b 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -485,6 +485,7 @@ (define (user-directories user) (directory "/tmp") (directory "/var/nix/profiles/per-user/root" 0 0) + (directory "/root" 0 0) ; an exception ,@(append-map user-directories (operating-system-users os)))))) -- cgit v1.2.3 From e30835e24797e7e2633d608cfa1f6c8f591a214c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 8 Feb 2014 16:07:02 +0100 Subject: gnu: Add FUSE. * gnu/packages/linux.scm (fuse): New variable. --- gnu/packages/linux.scm | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index b88ecfcac0..3fca5dfaf9 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -885,3 +885,38 @@ (define-public iotop "Iotop is a Python program with a top like user interface to show the processes currently causing I/O.") (license gpl2+))) + +(define-public fuse + (package + (name "fuse") + (version "2.9.3") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/fuse/fuse-" + version ".tar.gz")) + (sha256 + (base32 + "071r6xjgssy8vwdn6m28qq1bqxsd2bphcd2mzhq0grf5ybm87sqb")))) + (build-system gnu-build-system) + (native-inputs `(("util-linux" ,util-linux))) + (arguments + '(#:configure-flags (list (string-append "MOUNT_FUSE_PATH=" + (assoc-ref %outputs "out") + "/sbin") + (string-append "INIT_D_PATH=" + (assoc-ref %outputs "out") + "/etc/init.d") + (string-append "UDEV_RULES_PATH=" + (assoc-ref %outputs "out") + "/etc/udev")))) + (home-page "http://fuse.sourceforge.net/") + (synopsis "Support file systems implemented in user space") + (description + "As a consequence of its monolithic design, file system code for Linux +normally goes into the kernel itself---which is not only a robustness issue, +but also an impediment to system extensibility. FUSE, for \"file systems in +user space\", is a kernel module and user-space library that tries to address +part of this problem by allowing users to run file system implementations as +user-space processes.") + (license (list lgpl2.1 ; library + gpl2+)))) ; command-line utilities -- cgit v1.2.3 From 350b9b9933bdfd46efd3e9dee6f1dd1ec5889818 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Fri, 7 Feb 2014 17:04:58 -0600 Subject: gnu: moe: New module MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/moe.scm: New file * gnu-system.am (GNU_SYSTEM_MODULES): Add moe.scm Signed-off-by: Ludovic Courtès --- gnu-system.am | 1 + gnu/packages/moe.scm | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+) create mode 100644 gnu/packages/moe.scm diff --git a/gnu-system.am b/gnu-system.am index eb1e0d06dc..1ffeee5084 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -141,6 +141,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/make-bootstrap.scm \ gnu/packages/maths.scm \ gnu/packages/mit-krb5.scm \ + gnu/packages/moe.scm \ gnu/packages/mp3.scm \ gnu/packages/multiprecision.scm \ gnu/packages/mtools.scm \ diff --git a/gnu/packages/moe.scm b/gnu/packages/moe.scm new file mode 100644 index 0000000000..0dead5fe0c --- /dev/null +++ b/gnu/packages/moe.scm @@ -0,0 +1,52 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Eric Bavier +;;; +;;; 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 . + +(define-module (gnu packages moe) + #:use-module (guix licenses) + #:use-module (gnu packages ncurses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu)) + +(define-public moe + (package + (name "moe") + (version "1.5") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/moe/moe-" + version ".tar.gz")) + (sha256 + (base32 + "0hqag8022x68jmii1v6n7jb4fhp9icjkapgcpd2j3p9nzc8xch7s")))) + (build-system gnu-build-system) + (inputs + `(("ncurses" ,ncurses))) + (home-page "https://www.gnu.org/software/moe/moe.html") + (synopsis "Modeless, multiple-buffer, user-friendly 8-bit text editor") + (description + "GNU Moe is a powerful-but-simple-to-use text editor. It works in a +modeless manner, and features an intuitive set of key-bindings that +assign a degree of severity to each key; for example, key +combinations with the Alt key are for harmless commands like cursor +movements while combinations with the Control key are for commands +that will modify the text. Moe features multiple windows, unlimited +undo/redo, unlimited line length, global search and replace, and +more.") + (license gpl3+))) -- cgit v1.2.3 From 4cccb3617ee0e2344d0d986f3c60d97e77aa3249 Mon Sep 17 00:00:00 2001 From: Raimon Grau Date: Sun, 9 Feb 2014 16:28:39 +0100 Subject: gnu: Add stalonetray MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/stalonetray.scm: New file * gnu-system.am (GNU_SYSTEM_MODULES): Add stalonetray.scm Signed-off-by: Ludovic Courtès --- gnu-system.am | 1 + gnu/packages/stalonetray.scm | 48 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 49 insertions(+) create mode 100644 gnu/packages/stalonetray.scm diff --git a/gnu-system.am b/gnu-system.am index 1ffeee5084..cc34dbc7b3 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -190,6 +190,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/smalltalk.scm \ gnu/packages/sqlite.scm \ gnu/packages/ssh.scm \ + gnu/packages/stalonetray.scm \ gnu/packages/swig.scm \ gnu/packages/tcl.scm \ gnu/packages/tcsh.scm \ diff --git a/gnu/packages/stalonetray.scm b/gnu/packages/stalonetray.scm new file mode 100644 index 0000000000..5a53cd832e --- /dev/null +++ b/gnu/packages/stalonetray.scm @@ -0,0 +1,48 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Raimon Grau +;;; +;;; 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 . + +(define-module (gnu packages stalonetray) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module ((guix licenses) #:select (gpl2+)) + #:use-module (gnu packages xorg)) + +(define-public stalonetray + (package + (name "stalonetray") + (version "0.8.1") + (source + (origin + (method url-fetch) + (uri + (string-append "mirror://sourceforge/stalonetray/stalonetray-" + version "/stalonetray-" version ".tar.bz2")) + (sha256 + (base32 + "1wp8pnlv34w7xizj1vivnc3fkwqq4qgb9dbrsg15598iw85gi8ll")))) + (inputs `(("libx11" ,libx11))) + (build-system gnu-build-system) + (home-page "stalonetray") + (synopsis "Standalone freedesktop.org and KDE systray implementation") + (description + "Stalonetray is a stand-alone freedesktop.org and KDE system +tray (notification area) for X Window System/X11 (e.g. X.Org or XFree86). It +has full XEMBED support and minimal dependencies: an X11 lib only. Stalonetray +works with virtually any EWMH-compliant window manager.") + (license gpl2+))) -- cgit v1.2.3 From f9ec07a9859c5b305105ab38bff3f3db0dcb842d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Feb 2014 23:20:42 +0100 Subject: gnu: slim: Work around flaky synchronization with the X server. * gnu/packages/patches/slim-sigusr1.patch: New file. * gnu/packages/slim.scm (slim): Use it. * gnu-system.am (dist_patch_DATA): Add it. --- gnu-system.am | 1 + gnu/packages/patches/slim-sigusr1.patch | 33 +++++++++++++++++++++++++++++++++ gnu/packages/slim.scm | 3 ++- 3 files changed, 36 insertions(+), 1 deletion(-) create mode 100644 gnu/packages/patches/slim-sigusr1.patch diff --git a/gnu-system.am b/gnu-system.am index cc34dbc7b3..a98ef250d0 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -299,6 +299,7 @@ dist_patch_DATA = \ gnu/packages/patches/scheme48-tests.patch \ gnu/packages/patches/slim-session.patch \ gnu/packages/patches/slim-config.patch \ + gnu/packages/patches/slim-sigusr1.patch \ gnu/packages/patches/tcsh-fix-autotest.patch \ gnu/packages/patches/teckit-cstdio.patch \ gnu/packages/patches/valgrind-glibc.patch \ diff --git a/gnu/packages/patches/slim-sigusr1.patch b/gnu/packages/patches/slim-sigusr1.patch new file mode 100644 index 0000000000..344b02933e --- /dev/null +++ b/gnu/packages/patches/slim-sigusr1.patch @@ -0,0 +1,33 @@ +This patch fixes SLiM so it really waits for the X server to be ready +before attempting to connect to it. Indeed, the X server notices that +its parent process has a handler for SIGUSR1, and consequently sends it +SIGUSR1 when it's ready to accept connections. + +The problem was that SLiM doesn't pay attention to SIGUSR1. So in practice, +if X starts slowly, then SLiM gets ECONNREFUSED a couple of time on +/tmp/.X11-unix/X0, then goes on trying to connect to localhost:6000, +where nobody answers; eventually, it times out and tries again on +/tmp/.X11-unix/X0, and finally it shows up on the screen. + +Patch by L. Courtès. + +--- slim-1.3.6/app.cpp 2014-02-05 15:27:20.000000000 +0100 ++++ slim-1.3.6/app.cpp 2014-02-09 22:42:04.000000000 +0100 +@@ -119,7 +119,9 @@ void CatchSignal(int sig) { + exit(ERR_EXIT); + } + ++static volatile int got_sigusr1 = 0; + void User1Signal(int sig) { ++ got_sigusr1 = 1; + signal(sig, User1Signal); + } + +@@ -884,6 +886,7 @@ int App::WaitForServer() { + int ncycles = 120; + int cycles; + ++ while (!got_sigusr1); + for(cycles = 0; cycles < ncycles; cycles++) { + if((Dpy = XOpenDisplay(DisplayName))) { + XSetIOErrorHandler(xioerror); diff --git a/gnu/packages/slim.scm b/gnu/packages/slim.scm index 1a1feadede..f25b070f3c 100644 --- a/gnu/packages/slim.scm +++ b/gnu/packages/slim.scm @@ -46,7 +46,8 @@ (define-public slim (sha256 (base32 "1pqhk22jb4aja4hkrm7rjgbgzjyh7i4zswdgf5nw862l2znzxpi1")) (patches (map search-patch - (list "slim-config.patch" "slim-session.patch"))))) + (list "slim-config.patch" "slim-session.patch" + "slim-sigusr1.patch"))))) (build-system cmake-build-system) (inputs `(("linux-pam" ,linux-pam) ("libpng" ,libpng) -- cgit v1.2.3 From 26fc862a61adb231c57982ce687cac6931fd1e7e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Feb 2014 23:28:18 +0100 Subject: gnu: linux-initrd: When booting, chdir to the new root before calling 'chroot'. * guix/build/linux-initrd.scm (boot-system): Add 'chdir' call right before 'chroot'. --- guix/build/linux-initrd.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index 5bf20fa6df..80ce679496 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -318,6 +318,7 @@ (define MS_RDONLY 1) (if to-load (begin (format #t "loading '~a'...\n" to-load) + (chdir "/root") (chroot "/root") ;; TODO: Remove /lib, /share, and /loader.go. (catch #t -- cgit v1.2.3 From f3d4af173a09b29454155def7d8058b21b83d27b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Feb 2014 23:30:49 +0100 Subject: gnu: dmd: Fix X font directory name in X service. * gnu/system/dmd.scm (xorg-service)[xserver.conf]: Fix directory name in 'FontPath' entry for FONT-ADOBE75DPI. --- gnu/system/dmd.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm index 656c2f5634..8fe225f0e9 100644 --- a/gnu/system/dmd.scm +++ b/gnu/system/dmd.scm @@ -275,7 +275,7 @@ (define (xorg-service) (define (xserver.conf) (text-file* "xserver.conf" " Section \"Files\" - FontPath \"" font-adobe75dpi "/lib/X11/fonts\" + FontPath \"" font-adobe75dpi "/share/font/X11/75dpi\" ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\" -- cgit v1.2.3 From 06d275f67f9ad58ea041f3e31add95fe48631f50 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Feb 2014 23:46:28 +0100 Subject: gnu: dmd: Add SLiM service. * gnu/system/dmd.scm (xorg-service): Remove. (xorg-start-command, slim-service): New procedure. --- gnu/system/dmd.scm | 124 ++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 99 insertions(+), 25 deletions(-) diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm index 8fe225f0e9..c1ddec88d6 100644 --- a/gnu/system/dmd.scm +++ b/gnu/system/dmd.scm @@ -22,9 +22,9 @@ (define-module (gnu system dmd) #:use-module (guix derivations) #:use-module (guix records) #:use-module ((gnu packages base) - #:select (glibc-final)) + #:select (glibc-final guile-final)) #:use-module ((gnu packages admin) - #:select (mingetty inetutils shadow)) + #:select (dmd mingetty inetutils shadow)) #:use-module ((gnu packages package-management) #:select (guix)) #:use-module ((gnu packages linux) @@ -32,6 +32,8 @@ (define-module (gnu system dmd) #:use-module (gnu packages xorg) #:use-module (gnu packages bash) #:use-module (gnu packages gl) + #:use-module (gnu packages slim) + #:use-module (gnu packages ratpoison) #:use-module (gnu system shadow) ; for user accounts/groups #:use-module (gnu system linux) ; for PAM services @@ -58,7 +60,8 @@ (define-module (gnu system dmd) nscd-service guix-service static-networking-service - xorg-service + xorg-start-command + slim-service dmd-configuration-file)) @@ -270,8 +273,12 @@ (define* (static-networking-service interface ip `(("net-tools" ,net-tools)) '()))))))) -(define (xorg-service) - "Return a service that starts the Xorg graphical display server." +(define* (xorg-start-command #:key + (guile guile-final) + (xorg-server xorg-server)) + "Return a derivation that builds a GUILE script to start the X server from +XORG-SERVER. Usually the X server is started by a login manager." + (define (xserver.conf) (text-file* "xserver.conf" " Section \"Files\" @@ -314,36 +321,103 @@ (define (xserver.conf) Device \"Device-vesa\" EndSection")) - (mlet %store-monad ((xorg-bin (package-file xorg-server "bin/X")) + (mlet %store-monad ((guile-bin (package-file guile "bin/guile")) + (xorg-bin (package-file xorg-server "bin/X")) (dri (package-file mesa "lib/dri")) (xkbcomp-bin (package-file xkbcomp "bin")) (xkb-dir (package-file xkeyboard-config "share/X11/xkb")) - (sh (package-file bash "bin/sh")) (config (xserver.conf))) + (define builder + ;; Write a small wrapper around the X server. + `(let ((out (assoc-ref %outputs "out"))) + (call-with-output-file out + (lambda (port) + (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin) + (write '(begin + (setenv "XORG_DRI_DRIVER_PATH" ,dri) + (setenv "XKB_BINDIR" ,xkbcomp-bin) + + (apply execl + + ,xorg-bin "-ac" "-logverbose" "-verbose" + "-xkbdir" ,xkb-dir + "-config" ,(derivation->output-path config) + "-nolisten" "tcp" "-terminate" + + ;; Note: SLiM and other display managers add the + ;; '-auth' flag by themselves. + (cdr (command-line)))) + port))) + (chmod out #o555) + #t)) + + (mlet %store-monad ((inputs (lower-inputs + `(("xorg" ,xorg-server) + ("xkbcomp" ,xkbcomp) + ("xkeyboard-config" ,xkeyboard-config) + ("mesa" ,mesa) + ("guile" ,guile) + ("xorg.conf" ,config))))) + (derivation-expression "start-xorg" builder + #:inputs inputs)))) + +(define* (slim-service #:key (slim slim) + (allow-empty-passwords? #t) auto-login? + (default-user "") + (xauth xauth) (dmd dmd) (bash bash) + startx) + "Return a service that spawns the SLiM graphical login manager, which in +turn start the X display server with STARTX, a command as returned by +'xorg-start-command'. + +When ALLOW-EMPTY-PASSWORDS? is true, allow logins with an empty password. +When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER." + (define (slim.cfg) + ;; TODO: Run "bash -login ~/.xinitrc %session". + (mlet %store-monad ((startx (or startx (xorg-start-command)))) + (text-file* "slim.cfg" " +default_path /run/current-system/bin +default_xserver " startx " +xserver_arguments :0 vt7 +xauth_path " xauth "/bin/xauth +authfile /var/run/slim.auth + +# The login command. '%session' is replaced by the chosen session name, one +# of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc. +login_cmd exec " ratpoison "/bin/ratpoison + +halt_cmd " dmd "/sbin/halt +reboot_cmd " dmd "/sbin/reboot +" (if auto-login? + (string-append "auto_login yes\ndefault_user " default-user) + "")))) + + (mlet %store-monad ((slim-bin (package-file slim "bin/slim")) + (bash-bin (package-file bash "bin/bash")) + (slim.cfg (slim.cfg))) (return (service - (documentation "The X11 graphic server") + (documentation "Xorg display server") (provision '(xorg-server)) (requirement '(host-name)) - (start `(make-forkexec-constructor - ;; XXX: 'make-forkexec-constructor' should allow use to specify - ;; env vars. - ,sh "-c" ,(string-append "XORG_DRI_DRIVER_PATH=" dri " " - "XKB_BINDIR=" xkbcomp-bin " " - xorg-bin " -ac -logverbose -verbose " - "-xkbdir " xkb-dir " " - "-config " - (derivation->output-path config) " " - "-nolisten tcp :0 vt7"))) + (start + ;; XXX: Work around the inability to specify env. vars. directly. + `(make-forkexec-constructor + ,bash-bin "-c" + ,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg) + " " slim-bin + " -nodaemon"))) (stop `(make-kill-destructor)) - (respawn? #f) - (inputs `(("xorg" ,xorg-server) - ("xkbcomp" ,xkbcomp) - ("xkeyboard-config" ,xkeyboard-config) - ("mesa" ,mesa) - ("bash" ,bash) - ("xorg.conf" ,config))))))) + (inputs `(("slim" ,slim) + ("slim.cfg" ,slim.cfg) + ("bash" ,bash))) + (respawn? #t) + (pam-services + ;; Tell PAM about 'slim'. + (list (unix-pam-service + "slim" + #:allow-empty-passwords? allow-empty-passwords?))))))) (define (dmd-configuration-file services etc) -- cgit v1.2.3 From 2de227af4bca7204e93f48d52555d576c25f1ca9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Feb 2014 00:03:34 +0100 Subject: download: Provide a 'User-Agent' field in HTTP requests. Fixes . Reported by Raimon Grau . * guix/build/download.scm (http-fetch)[headers]: New variable. Pass it as #:headers or #:extra-headers to 'http-get' and 'http-get*'. --- guix/build/download.scm | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/guix/build/download.scm b/guix/build/download.scm index ac2086d96e..f9715e10f7 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -201,6 +201,12 @@ (define post-2.0.7? (string>? (micro-version) "7") (string>? (version) "2.0.7"))) + (define headers + ;; Some web sites, such as http://dist.schmorp.de, would block you if + ;; there's no 'User-Agent' header, presumably on the assumption that + ;; you're a spammer. So work around that. + '((User-Agent . "GNU Guile"))) + (let*-values (((connection) (open-connection-for-uri uri)) ((resp bv-or-port) @@ -210,11 +216,14 @@ (define post-2.0.7? ;; version. So keep this compatibility hack for now. (if post-2.0.7? (http-get uri #:port connection #:decode-body? #f - #:streaming? #t) + #:streaming? #t + #:headers headers) (if (module-defined? (resolve-interface '(web client)) 'http-get*) - (http-get* uri #:port connection #:decode-body? #f) - (http-get uri #:port connection #:decode-body? #f)))) + (http-get* uri #:port connection #:decode-body? #f + #:headers headers) + (http-get uri #:port connection #:decode-body? #f + #:extra-headers headers)))) ((code) (response-code resp)) ((size) -- cgit v1.2.3 From 6ede17ca69a68457c7492601e24ef02fb62487f8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Feb 2014 00:05:39 +0100 Subject: union: Do not compare directories upon collision. * guix/build/union.scm (file=?): Return #f if FILE1 and FILE2 are not regular files. Fixes a bug whereby collisions among directories would lead to the invocation of 'file=?' and thus 'call-with-input-file' on directories. Reported by Mark H. Weaver . --- guix/build/union.scm | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/guix/build/union.scm b/guix/build/union.scm index 1b09da45c7..6e2b296d81 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -103,21 +103,26 @@ (define non-collisions (leaf leaf)))) (define (file=? file1 file2) - "Return #t if the contents of FILE1 and FILE2 are identical, #f otherwise." - (and (= (stat:size (stat file1)) (stat:size (stat file2))) - (call-with-input-file file1 - (lambda (port1) - (call-with-input-file file2 - (lambda (port2) - (define len 8192) - (define buf1 (make-bytevector len)) - (define buf2 (make-bytevector len)) - (let loop () - (let ((n1 (get-bytevector-n! port1 buf1 0 len)) - (n2 (get-bytevector-n! port2 buf2 0 len))) - (and (equal? n1 n2) - (or (eof-object? n1) - (loop))))))))))) + "Return #t if FILE1 and FILE2 are regular files and their contents are +identical, #f otherwise." + (let ((st1 (stat file1)) + (st2 (stat file2))) + (and (eq? (stat:type st1) 'regular) + (eq? (stat:type st2) 'regular) + (= (stat:size st1) (stat:size st2)) + (call-with-input-file file1 + (lambda (port1) + (call-with-input-file file2 + (lambda (port2) + (define len 8192) + (define buf1 (make-bytevector len)) + (define buf2 (make-bytevector len)) + (let loop () + (let ((n1 (get-bytevector-n! port1 buf1 0 len)) + (n2 (get-bytevector-n! port2 buf2 0 len))) + (and (equal? n1 n2) + (or (eof-object? n1) + (loop)))))))))))) (define* (union-build output directories #:key (log-port (current-error-port))) -- cgit v1.2.3 From 18095a4ae0c2596b6282c1937bc30b75660839ee Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 9 Feb 2014 04:56:51 -0500 Subject: gnu: openssl: Upgrade to 1.0.1f. * gnu/packages/openssl.scm (openssl): Upgrade to 1.0.1f. --- gnu/packages/openssl.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/openssl.scm b/gnu/packages/openssl.scm index 438e76fd71..c0f8b6ff88 100644 --- a/gnu/packages/openssl.scm +++ b/gnu/packages/openssl.scm @@ -27,13 +27,13 @@ (define-module (gnu packages openssl) (define-public openssl (package (name "openssl") - (version "1.0.1c") + (version "1.0.1f") (source (origin (method url-fetch) (uri (string-append "ftp://ftp.openssl.org/source/openssl-" version ".tar.gz")) (sha256 (base32 - "1gjy6a7d8nszi9wq8jdzx3cffn0nss23h3cw2ywlw4cb9v6v77ia")))) + "0nnbr70dg67raqsqvlypzxa1v5xsv9gp91f9pavyckfn2w5sihkc")))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl))) (arguments -- cgit v1.2.3 From fc0a973d70fdda2379be10832f779b0a14fc3e89 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 9 Feb 2014 04:57:51 -0500 Subject: gnu: openssh: Upgrade to 6.5p1. * gnu/packages/ssh.scm (openssh): Upgrade to 6.5p1. --- gnu/packages/ssh.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm index 7589408e47..41ceeb6cef 100644 --- a/gnu/packages/ssh.scm +++ b/gnu/packages/ssh.scm @@ -120,14 +120,14 @@ (define-public libssh2 (define-public openssh (package (name "openssh") - (version "6.1p1") + (version "6.5p1") (source (origin (method url-fetch) (uri (string-append "ftp://ftp.fr.openbsd.org/pub/OpenBSD/OpenSSH/portable/openssh-" version ".tar.gz")) (sha256 (base32 - "04f4l4vx6f964v5qjm03nhyixdc3llc90z6cj70r0bl5q3v5ghfi")))) + "09wh7mi65aahyxd2xvq1makckhd5laid8c0pb8njaidrbpamw6d1")))) (build-system gnu-build-system) (inputs `(("groff" ,groff) ("openssl" ,openssl) @@ -150,7 +150,7 @@ (define-public openssh (let ((check (assoc-ref %standard-phases 'check))) ;; remove tests that require the user sshd (substitute* "regress/Makefile" - (("t9 t-exec") "t9")) + (("t10 t-exec") "t10")) (apply check args))) (alist-replace 'install -- cgit v1.2.3 From 93bfe3e27c42a60a3e6fa24278734e73d7386307 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Feb 2014 23:00:37 +0100 Subject: gnu: gstreamer 1.0.10: Temporarily disable tests. * gnu/packages/gstreamer.scm (gstreamer): Add 'arguments' field. --- gnu/packages/gstreamer.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/gnu/packages/gstreamer.scm b/gnu/packages/gstreamer.scm index 6ebd8c399b..c68d756d1e 100644 --- a/gnu/packages/gstreamer.scm +++ b/gnu/packages/gstreamer.scm @@ -43,6 +43,10 @@ (define-public gstreamer (base32 "0c0irk85jd2cihm5pmf4zxhlpg08qpxjcqv1l9qn2n3h2gsaj2lf")))) (build-system gnu-build-system) + (arguments + ;; XXX: Temporarily disable tests to work around 'gst/gstbus' test + ;; failure: . + '(#:tests? #f)) (inputs `(("glib" ,glib))) (native-inputs `(("bison" ,bison) @@ -51,8 +55,7 @@ (define-public gstreamer ("pkg-config" ,pkg-config) ("python-wrapper" ,python-wrapper))) (home-page "http://gstreamer.freedesktop.org/") - (synopsis - "Multimedia library") + (synopsis "Multimedia library") (description "GStreamer is a library for constructing graphs of media-handling components. The applications it supports range from simple Ogg/Vorbis -- cgit v1.2.3 From 266b39fc26fff62e63c63f7f6bc8c92dfbc3f91a Mon Sep 17 00:00:00 2001 From: Sree Harsha Totakura Date: Fri, 31 Jan 2014 00:33:36 +0100 Subject: gnu: Add GNUnet. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnunet/packages/gnunet.scm (gnunet): New variable. * gnu/package/patches/gnunet-fix-scheduler.patch: New file. * gnu/package/patches/gnunet-fix-tests.patch: New file. * gnu-system.am (dist_patch_DATA): Add the above two patch files. Co-authored-by: Andreas Enge Signed-off-by: Ludovic Courtès --- gnu-system.am | 2 + gnu/packages/gnunet.scm | 69 +++++++++++++++++++++++++ gnu/packages/patches/gnunet-fix-scheduler.patch | 13 +++++ gnu/packages/patches/gnunet-fix-tests.patch | 46 +++++++++++++++++ 4 files changed, 130 insertions(+) create mode 100644 gnu/packages/patches/gnunet-fix-scheduler.patch create mode 100644 gnu/packages/patches/gnunet-fix-tests.patch diff --git a/gnu-system.am b/gnu-system.am index a98ef250d0..3e9108cd87 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -259,6 +259,8 @@ dist_patch_DATA = \ gnu/packages/patches/glibc-bootstrap-system.patch \ gnu/packages/patches/glibc-ldd-x86_64.patch \ gnu/packages/patches/glibc-make-4.0.patch \ + gnu/packages/patches/gnunet-fix-scheduler.patch \ + gnu/packages/patches/gnunet-fix-tests.patch \ gnu/packages/patches/gobject-introspection-cc.patch \ gnu/packages/patches/grub-gets-undeclared.patch \ gnu/packages/patches/gstreamer-0.10-bison3.patch \ diff --git a/gnu/packages/gnunet.scm b/gnu/packages/gnunet.scm index 6af9063f19..2bbe72ffe1 100644 --- a/gnu/packages/gnunet.scm +++ b/gnu/packages/gnunet.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu packages gnunet) + #:use-module (gnu packages) #:use-module (gnu packages autotools) #:use-module (gnu packages compression) #:use-module (gnu packages curl) @@ -30,10 +31,14 @@ (define-module (gnu packages gnunet) #:use-module (gnu packages libidn) #:use-module (gnu packages libjpeg) #:use-module (gnu packages libtiff) + #:use-module (gnu packages libunistring) + #:use-module (gnu packages maths) #:use-module (gnu packages openssl) #:use-module (gnu packages pkg-config) #:use-module (gnu packages perl) + #:use-module (gnu packages pulseaudio) #:use-module (gnu packages python) + #:use-module (gnu packages sqlite) #:use-module (gnu packages video) #:use-module (gnu packages xiph) #:use-module ((guix licenses) @@ -184,3 +189,67 @@ (define-public gnurl (license (license:bsd-style "file://COPYING" "See COPYING in the distribution.")) (home-page "https://gnunet.org/gnurl"))) + +(define-public gnunet + (package + (name "gnunet") + (version "0.10.0") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/gnunet/gnunet-" version + ".tar.gz")) + (sha256 (base32 + "0zqpc47kywhjrpphl0palz849khv00ra2gjrfkysp6p0gfsbvd0i")) + (patches + (list + ;; Patch to fix serious bug in scheduler; upstream commit: #31747 + (search-patch "gnunet-fix-scheduler.patch") + ;; Patch to fix bugs in testcases: + ;; * Disable peerinfo-tool tests as they depend on reverse DNS lookups + ;; * Allow revocation testcase to run on loopback; upstream: #32130 + ;; * Skip GNS testcases requiring DNS lookups; upstream: #32118 + (search-patch "gnunet-fix-tests.patch"))) + (patch-flags '("-p0")))) + (build-system gnu-build-system) + (inputs + `(("gnutls" ,gnutls) + ("glpk" ,glpk) + ("libextractor" ,libextractor) + ("libgcrypt" ,libgcrypt) + ("gnurl" ,gnurl) + ("libidn" ,libidn) + ("openssl" ,openssl) + ("opus" ,opus) + ("libtool" ,libtool) + ("libunistring" ,libunistring) + ("pulseaudio", pulseaudio) + ("sqlite" ,sqlite) + ("zlib" ,zlib))) + (native-inputs + `(("pkg-config" ,pkg-config) + ("python" ,python-2))) + (arguments + '(#:phases + ;; swap check and install phases and set paths to installed binaries + (alist-cons-before + 'check 'set-path-for-check + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (setenv "GNUNET_PREFIX" out) + (setenv "PATH" (string-append (getenv "PATH") ":" out "/bin")))) + (alist-cons-after + 'install 'check + (assoc-ref %standard-phases 'check) + (alist-delete + 'check + %standard-phases))))) + (synopsis "Anonymous peer-to-peer file-sharing framework") + (description + "GNUnet is a framework for secure, peer-to-peer networking. It works in a +decentralized manner and does not rely on any notion of trusted services. One +service implemented on it is censorship-resistant file-sharing. Communication +is encrypted and anonymity is provided by making messages originating from a +peer indistinguishable from those that the peer is routing.") + (license license:gpl3+) + (home-page "https://gnunet.org/"))) diff --git a/gnu/packages/patches/gnunet-fix-scheduler.patch b/gnu/packages/patches/gnunet-fix-scheduler.patch new file mode 100644 index 0000000000..1e0aef2a1a --- /dev/null +++ b/gnu/packages/patches/gnunet-fix-scheduler.patch @@ -0,0 +1,13 @@ +Index: src/util/scheduler.c +=================================================================== +--- src/util/scheduler.c (revision 31745) ++++ src/util/scheduler.c (working copy) +@@ -1599,7 +1599,7 @@ + int real_fd; + + GNUNET_DISK_internal_file_handle_ (fd, &real_fd, sizeof (int)); +- GNUNET_assert (real_fd > 0); ++ GNUNET_assert (real_fd >= 0); + return add_without_sets ( + delay, priority, + on_read ? real_fd : -1, diff --git a/gnu/packages/patches/gnunet-fix-tests.patch b/gnu/packages/patches/gnunet-fix-tests.patch new file mode 100644 index 0000000000..1957b17119 --- /dev/null +++ b/gnu/packages/patches/gnunet-fix-tests.patch @@ -0,0 +1,46 @@ +diff -ru a/src/peerinfo-tool/Makefile.in b/src/peerinfo-tool/Makefile.in +--- src/peerinfo-tool/Makefile.in 2013-12-24 13:55:04.000000000 +0100 ++++ src/peerinfo-tool/Makefile.in 2014-01-30 13:07:52.275965484 +0100 +@@ -335,9 +335,6 @@ + $(top_builddir)/src/statistics/libgnunetstatistics.la \ + $(top_builddir)/src/util/libgnunetutil.la + +-@HAVE_PYTHON_TRUE@check_SCRIPTS = \ +-@HAVE_PYTHON_TRUE@ test_gnunet_peerinfo.py +- + @ENABLE_TEST_RUN_TRUE@TESTS = $(check_SCRIPTS) + do_subst = $(SED) -e 's,[@]PYTHON[@],$(PYTHON),g' + EXTRA_DIST = \ +diff -ru a/src/revocation/test_revocation.conf b/src/revocation/test_revocation.conf +--- src/revocation/test_revocation.conf 2013-12-21 18:57:06.000000000 +0100 ++++ src/revocation/test_revocation.conf 2014-01-30 15:00:02.841340556 +0100 +@@ -20,6 +20,9 @@ + [transport-udp] + BROADCAST = NO + ++[nat] ++RETURN_LOCAL_ADDRESSES = YES ++ + [peerinfo] + USE_INCLUDED_HELLOS = NO + +Index: src/gns/test_gns_cname_lookup.sh +=================================================================== +--- src/gns/test_gns_cname_lookup.sh (revision 32117) ++++ src/gns/test_gns_cname_lookup.sh (revision 32118) +@@ -13,6 +13,15 @@ + exit 77 + fi + ++# permissive DNS resolver we will use for the test ++DNS_RESOLVER="8.8.8.8" ++if ! nslookup gnunet.org $DNS_RESOLVER &> /dev/null ++then ++ echo "Cannot reach DNS, skipping test" ++ exit 77 ++fi ++ ++ + rm -rf /tmp/test-gnunet-gns-peer-1/ + + TEST_DOMAIN_PLUS="www.gnu" -- cgit v1.2.3 From 829b1b253e96b4e26b6d8dd5a128dc0a53a30e96 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Mon, 10 Feb 2014 21:35:31 +0100 Subject: gnu: lout: Change docdir from "doc" to "share/doc" MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/lout.scm (lout): Change docdir from "doc" to "share/doc". Signed-off-by: Ludovic Courtès --- gnu/packages/lout.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/gnu/packages/lout.scm b/gnu/packages/lout.scm index 76cb8a753b..1121f1674b 100644 --- a/gnu/packages/lout.scm +++ b/gnu/packages/lout.scm @@ -37,14 +37,14 @@ (define-public lout (("^LOUTLIBDIR[[:blank:]]*=.*$") (string-append "LOUTLIBDIR = " out "/lib/lout\n")) (("^LOUTDOCDIR[[:blank:]]*=.*$") - (string-append "LOUTDOCDIR = " doc "/doc/lout\n")) + (string-append "LOUTDOCDIR = " doc "/share/doc/lout\n")) (("^MANDIR[[:blank:]]*=.*$") (string-append "MANDIR = " out "/man\n"))) (mkdir out) (mkdir (string-append out "/bin")) (mkdir (string-append out "/lib")) (mkdir (string-append out "/man")) - (mkdir-p (string-append doc "/doc/lout"))))) + (mkdir-p (string-append doc "/share/doc/lout"))))) (install-man-phase '(lambda* (#:key outputs #:allow-other-keys) (zero? (system* "make" "installman")))) @@ -60,7 +60,7 @@ (define out (every (lambda (doc) (format #t "doc: building `~a'...~%" doc) (with-directory-excursion doc - (let ((file (string-append out "/doc/lout/" + (let ((file (string-append out "/share/doc/lout/" doc ".ps"))) (and (or (file-exists? "outfile.ps") (zero? (system* "lout" "-r4" "-o" @@ -72,7 +72,7 @@ (define out "-dPDFSETTINGS=/prepress" "-sPAPERSIZE=a4" file - (string-append out "/doc/lout/" + (string-append out "/share/doc/lout/" doc ".pdf"))))))) '("design" "expert" "slides" "user"))))) (package -- cgit v1.2.3 From 99fbddf9a623757e39d88bfb431f8f7d6f24b75b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Feb 2014 23:30:09 +0100 Subject: store: Change 'export-paths' to always export in topological order. * guix/store.scm (export-paths): Pass PATHS through 'topologically-sorted' before iterating. * tests/store.scm ("export/import paths, ensure topological order"): New test. --- guix/store.scm | 6 +++--- tests/store.scm | 19 +++++++++++++++++++ 2 files changed, 22 insertions(+), 3 deletions(-) diff --git a/guix/store.scm b/guix/store.scm index eca0de7d97..b9b9d9e55a 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -732,10 +732,10 @@ (define* (export-path server path port #:key (sign? #t)) (= 1 (read-int s)))) (define* (export-paths server paths port #:key (sign? #t)) - "Export the store paths listed in PATHS to PORT, signing them if SIGN? -is true." + "Export the store paths listed in PATHS to PORT, in topological order, +signing them if SIGN? is true." (let ((s (nix-server-socket server))) - (let loop ((paths paths)) + (let loop ((paths (topologically-sorted server paths))) (match paths (() (write-int 0 port)) diff --git a/tests/store.scm b/tests/store.scm index a61d449fb4..7b0f3249d2 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -398,6 +398,25 @@ (define (same? x y) get-string-all)) files))))))) +(test-assert "export/import paths, ensure topological order" + (let* ((file1 (add-text-to-store %store "foo" (random-text))) + (file2 (add-text-to-store %store "bar" (random-text) + (list file1))) + (files (list file1 file2)) + (dump1 (call-with-bytevector-output-port + (cute export-paths %store (list file1 file2) <>))) + (dump2 (call-with-bytevector-output-port + (cute export-paths %store (list file2 file1) <>)))) + (delete-paths %store files) + (and (every (negate file-exists?) files) + (bytevector=? dump1 dump2) + (let* ((source (open-bytevector-input-port dump1)) + (imported (import-paths %store source))) + (and (equal? imported (list file1 file2)) + (every file-exists? files) + (null? (references %store file1)) + (equal? (list file1) (references %store file2))))))) + (test-assert "import corrupt path" (let* ((text (random-text)) (file (add-text-to-store %store "text" text)) -- cgit v1.2.3 From 05e8a0b005ef865aa982387942953708168e14df Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Mon, 10 Feb 2014 23:44:57 +0100 Subject: gnu: gnunet: Add input libmicrohttpd. * gnu/packages/gnunet.scm (gnunet): Add input libmicrohttpd and improve formatting. --- gnu/packages/gnunet.scm | 40 +++++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/gnu/packages/gnunet.scm b/gnu/packages/gnunet.scm index 2bbe72ffe1..39d0dbca9e 100644 --- a/gnu/packages/gnunet.scm +++ b/gnu/packages/gnunet.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Andreas Enge +;;; Copyright © 2013, 2014 Andreas Enge +;;; Copyright © 2014 Sree Harsha Totakura ;;; ;;; This file is part of GNU Guix. ;;; @@ -213,16 +214,17 @@ (define-public gnunet (patch-flags '("-p0")))) (build-system gnu-build-system) (inputs - `(("gnutls" ,gnutls) - ("glpk" ,glpk) + `(("glpk" ,glpk) + ("gnurl" ,gnurl) + ("gnutls" ,gnutls) ("libextractor" ,libextractor) ("libgcrypt" ,libgcrypt) - ("gnurl" ,gnurl) ("libidn" ,libidn) + ("libmicrohttpd" ,libmicrohttpd) + ("libtool" ,libtool)` + ("libunistring" ,libunistring) ("openssl" ,openssl) ("opus" ,opus) - ("libtool" ,libtool) - ("libunistring" ,libunistring) ("pulseaudio", pulseaudio) ("sqlite" ,sqlite) ("zlib" ,zlib))) @@ -231,19 +233,19 @@ (define-public gnunet ("python" ,python-2))) (arguments '(#:phases - ;; swap check and install phases and set paths to installed binaries - (alist-cons-before - 'check 'set-path-for-check - (lambda* (#:key outputs #:allow-other-keys) - (let ((out (assoc-ref outputs "out"))) - (setenv "GNUNET_PREFIX" out) - (setenv "PATH" (string-append (getenv "PATH") ":" out "/bin")))) - (alist-cons-after - 'install 'check - (assoc-ref %standard-phases 'check) - (alist-delete - 'check - %standard-phases))))) + ;; swap check and install phases and set paths to installed binaries + (alist-cons-before + 'check 'set-path-for-check + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (setenv "GNUNET_PREFIX" out) + (setenv "PATH" (string-append (getenv "PATH") ":" out "/bin")))) + (alist-cons-after + 'install 'check + (assoc-ref %standard-phases 'check) + (alist-delete + 'check + %standard-phases))))) (synopsis "Anonymous peer-to-peer file-sharing framework") (description "GNUnet is a framework for secure, peer-to-peer networking. It works in a -- cgit v1.2.3 From bbafef3ff1e42b4ad1e98737c7cbf9fb5ed4e434 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Mon, 10 Feb 2014 02:04:38 -0500 Subject: gnu: texinfo: Make version 4.13a available. * gnu/packages/texinfo.scm (texinfo-4): New variable. --- gnu/packages/texinfo.scm | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/gnu/packages/texinfo.scm b/gnu/packages/texinfo.scm index 7c753a7cf6..0f21ec3211 100644 --- a/gnu/packages/texinfo.scm +++ b/gnu/packages/texinfo.scm @@ -50,3 +50,17 @@ (define-public texinfo their source and the command-line Info reader. The emphasis of the language is on expressing the content semantically, avoiding physical markup commands.") (license gpl3+))) + +(define-public texinfo-4 + (package (inherit texinfo) + (version "4.13a") + (source (origin + (method url-fetch) + (uri (string-append + "mirror://gnu/texinfo/texinfo-" + version + ".tar.lzma")) + (sha256 + (base32 + "1rf9ckpqwixj65bw469i634897xwlgkm5i9g2hv3avl6mv7b0a3d")))) + (inputs `(("ncurses" ,ncurses) ("xz" ,xz))))) -- cgit v1.2.3 From 1680df13a8449c38fa8ac0b31903c4bfaf6f6fde Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Tue, 11 Feb 2014 10:20:53 +0100 Subject: gnu: gnunet: Correct typo. * gnu/packages/gnunet.scm (gnunet): Correct typo. --- gnu/packages/gnunet.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/gnunet.scm b/gnu/packages/gnunet.scm index 39d0dbca9e..1529f96283 100644 --- a/gnu/packages/gnunet.scm +++ b/gnu/packages/gnunet.scm @@ -221,7 +221,7 @@ (define-public gnunet ("libgcrypt" ,libgcrypt) ("libidn" ,libidn) ("libmicrohttpd" ,libmicrohttpd) - ("libtool" ,libtool)` + ("libtool" ,libtool) ("libunistring" ,libunistring) ("openssl" ,openssl) ("opus" ,opus) -- cgit v1.2.3 From b6b29c7737147bf683eb61bdbc93ad712a228ca7 Mon Sep 17 00:00:00 2001 From: Sree Harsha Totakura Date: Tue, 11 Feb 2014 19:17:33 +0100 Subject: gnu: curl, gnurl: Fix failing testcase 172. * gnu/packages/patches/curl-fix-test172.patch: New file. * gnu-system.am (dist_patch_DATA): Add the patch file. * gnu/packages/gnunet.scm (gnurl): Apply the patch file. * gnu/packages/curl.scm (curl): Apply the patch file. Signed-off-by: Andreas Enge --- gnu-system.am | 1 + gnu/packages/curl.scm | 7 ++++++- gnu/packages/gnunet.scm | 5 ++++- gnu/packages/patches/curl-fix-test172.patch | 12 ++++++++++++ 4 files changed, 23 insertions(+), 2 deletions(-) create mode 100644 gnu/packages/patches/curl-fix-test172.patch diff --git a/gnu-system.am b/gnu-system.am index 3e9108cd87..8229cf0cdd 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -242,6 +242,7 @@ dist_patch_DATA = \ gnu/packages/patches/cdparanoia-fpic.patch \ gnu/packages/patches/cmake-fix-tests.patch \ gnu/packages/patches/cpio-gets-undeclared.patch \ + gnu/packages/patches/curl-fix-test172.patch \ gnu/packages/patches/dbus-localstatedir.patch \ gnu/packages/patches/diffutils-gets-undeclared.patch \ gnu/packages/patches/dmd-getpw.patch \ diff --git a/gnu/packages/curl.scm b/gnu/packages/curl.scm index 7072ed3878..a9bfa76aa0 100644 --- a/gnu/packages/curl.scm +++ b/gnu/packages/curl.scm @@ -22,6 +22,7 @@ (define-module (gnu packages curl) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) + #:use-module (gnu packages) #:use-module (gnu packages compression) #:use-module (gnu packages gnutls) #:use-module (gnu packages groff) @@ -42,7 +43,11 @@ (define-public curl version ".tar.lzma")) (sha256 (base32 - "13bhfs41yf60ys2hrikqxjwfzaj0gm91kqzsgc5fr4grzmpm38nx")))) + "13bhfs41yf60ys2hrikqxjwfzaj0gm91kqzsgc5fr4grzmpm38nx")) + (patches + ;; This patch fixes testcase 172 which uses a hardcoded cookie + ;; expiration value which is expired as of Feb 1, 2014. + (list (search-patch "curl-fix-test172.patch"))))) (build-system gnu-build-system) (inputs `(("gnutls" ,gnutls) ("gss" ,gss) diff --git a/gnu/packages/gnunet.scm b/gnu/packages/gnunet.scm index 1529f96283..f3448a7e63 100644 --- a/gnu/packages/gnunet.scm +++ b/gnu/packages/gnunet.scm @@ -144,7 +144,10 @@ (define-public gnurl version ".tar.bz2")) (sha256 (base32 - "0kpi9wx9lg938b982smjg54acdwswdshs2bzf10sj5r6zmb05ygp")))) + "0kpi9wx9lg938b982smjg54acdwswdshs2bzf10sj5r6zmb05ygp")) + ;; This patch fixes testcase 172 which uses a hardcoded cookie + ;; expiration value which is expired as of Feb 1, 2014. + (patches (list (search-patch "curl-fix-test172.patch"))))) (build-system gnu-build-system) (inputs `(("gnutls" ,gnutls) ("libidn" ,libidn) diff --git a/gnu/packages/patches/curl-fix-test172.patch b/gnu/packages/patches/curl-fix-test172.patch new file mode 100644 index 0000000000..cc2c2705e7 --- /dev/null +++ b/gnu/packages/patches/curl-fix-test172.patch @@ -0,0 +1,12 @@ +diff --git a/tests/data/test172 b/tests/data/test172 +index b3efae9..3d53418 100644 +--- a/tests/data/test172 ++++ b/tests/data/test172 +@@ -36,7 +36,7 @@ http://%HOSTIP:%HTTPPORT/we/want/172 -b log/jar172.txt -b "tool=curl; name=fool" + + .%HOSTIP TRUE /silly/ FALSE 0 ismatch this + .%HOSTIP TRUE / FALSE 0 partmatch present +-%HOSTIP FALSE /we/want/ FALSE 1391252187 nodomain value ++%HOSTIP FALSE /we/want/ FALSE 2139150993 nodomain value + + -- cgit v1.2.3 From 9e5ace9d1dfc1e9de1cd936bf4f00d1dcca51f90 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 11 Feb 2014 14:24:39 -0500 Subject: gnu: isc-dhcp: Upgrade to 4.3.0. * gnu/packages/admin.scm (isc-dhcp): Upgrade to 4.3.0. --- gnu/packages/admin.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index dfbf20d56f..928d752531 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -349,14 +349,14 @@ (define-public alive (define-public isc-dhcp (package (name "isc-dhcp") - (version "4.3.0a1") + (version "4.3.0") (source (origin (method url-fetch) (uri (string-append "http://ftp.isc.org/isc/dhcp/" version "/dhcp-" version ".tar.gz")) (sha256 (base32 - "0001n26m4488nl95h53wg60sywbli4d246vz2h8lpv70jlrq9q1p")))) + "12mydvj6x3zcl3gla06bywfkkrgg03g66fijs94mwb7kbiym3dm7")))) (build-system gnu-build-system) (arguments '(#:phases (alist-cons-after @@ -383,9 +383,9 @@ (define-public isc-dhcp (system* "tar" "xf" "bind.tar.gz") (for-each patch-shebang - (find-files "bind-9.9.5b1" ".*")) + (find-files "bind-9.9.5" ".*")) (zero? (system* "tar" "cf" "bind.tar.gz" - "bind-9.9.5b1")))) + "bind-9.9.5")))) (alist-cons-after 'install 'post-install (lambda* (#:key inputs outputs #:allow-other-keys) -- cgit v1.2.3 From d66b704b51dc9a63eabbaee994f98101d8387ae6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 11 Feb 2014 23:16:28 +0100 Subject: store: Add comments for the stracer. * guix/store.scm (%worker-magic-1, %worker-magic-2): Add comments. --- guix/store.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/guix/store.scm b/guix/store.scm index b9b9d9e55a..8e88c5f86d 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -100,8 +100,8 @@ (define-module (guix store) (define %protocol-version #x10c) -(define %worker-magic-1 #x6e697863) -(define %worker-magic-2 #x6478696f) +(define %worker-magic-1 #x6e697863) ; "nixc" +(define %worker-magic-2 #x6478696f) ; "dxio" (define (protocol-major magic) (logand magic #xff00)) -- cgit v1.2.3 From bdff90a16a99ad95bd76a14847e1507454990588 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 11 Feb 2014 23:18:41 +0100 Subject: guix build: Move 'set-build-options' call earlier. * guix/scripts/build.scm (guix-build): Move 'set-build-options' call before 'show-what-to-build'. --- guix/scripts/build.scm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 7cb3710853..b153da8493 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -279,11 +279,6 @@ (define (parse-options) (_ #f)) opts))) - (unless (assoc-ref opts 'log-file?) - (show-what-to-build store drv - #:use-substitutes? (assoc-ref opts 'substitutes?) - #:dry-run? (assoc-ref opts 'dry-run?))) - ;; TODO: Add more options. (set-build-options store #:keep-failed? (assoc-ref opts 'keep-failed?) @@ -294,6 +289,11 @@ (define (parse-options) #:max-silent-time (assoc-ref opts 'max-silent-time) #:verbosity (assoc-ref opts 'verbosity)) + (unless (assoc-ref opts 'log-file?) + (show-what-to-build store drv + #:use-substitutes? (assoc-ref opts 'substitutes?) + #:dry-run? (assoc-ref opts 'dry-run?))) + (cond ((assoc-ref opts 'log-file?) (for-each (lambda (file) (let ((log (log-file store file))) -- cgit v1.2.3 From 7af52bd58c834f46e54f27592b6193604f7119fb Mon Sep 17 00:00:00 2001 From: Sree Harsha Totakura Date: Wed, 12 Feb 2014 16:15:32 +0100 Subject: gnu: gnunet: Fix failing testcases. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/gnunet.scm (gnurl): Add pkg-config. * gnu/packages/patches/gnunet-fix-tests.patch: Append fix for integration testcases. Signed-off-by: Ludovic Courtès --- gnu/packages/gnunet.scm | 8 +++++--- gnu/packages/patches/gnunet-fix-tests.patch | 12 ++++++++++++ 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/gnu/packages/gnunet.scm b/gnu/packages/gnunet.scm index f3448a7e63..960a5d725c 100644 --- a/gnu/packages/gnunet.scm +++ b/gnu/packages/gnunet.scm @@ -153,8 +153,9 @@ (define-public gnurl ("libidn" ,libidn) ("zlib" ,zlib))) (native-inputs - `(("perl" ,perl) - ("groff" ,groff) + `(("groff" ,groff) + ("perl" ,perl) + ("pkg-config" ,pkg-config) ("python" ,python-2))) (arguments `(#:configure-flags '("--enable-ipv6" "--with-gnutls" "--without-libssh2" @@ -211,7 +212,8 @@ (define-public gnunet (search-patch "gnunet-fix-scheduler.patch") ;; Patch to fix bugs in testcases: ;; * Disable peerinfo-tool tests as they depend on reverse DNS lookups - ;; * Allow revocation testcase to run on loopback; upstream: #32130 + ;; * Allow revocation and integration-tests testcases to run on + ;; loopback; upstream: #32130, #32326 ;; * Skip GNS testcases requiring DNS lookups; upstream: #32118 (search-patch "gnunet-fix-tests.patch"))) (patch-flags '("-p0")))) diff --git a/gnu/packages/patches/gnunet-fix-tests.patch b/gnu/packages/patches/gnunet-fix-tests.patch index 1957b17119..4276db5a7c 100644 --- a/gnu/packages/patches/gnunet-fix-tests.patch +++ b/gnu/packages/patches/gnunet-fix-tests.patch @@ -44,3 +44,15 @@ Index: src/gns/test_gns_cname_lookup.sh rm -rf /tmp/test-gnunet-gns-peer-1/ TEST_DOMAIN_PLUS="www.gnu" +Index: src/integration-tests/confs/test_defaults.conf +=================================================================== +--- src/integration-tests/confs/test_defaults.conf (revision 32320) ++++ src/integration-tests/confs/test_defaults.conf (working copy) +@@ -17,6 +17,7 @@ + EXTERNAL_ADDRESS = 127.0.0.1 + INTERNAL_ADDRESS = 127.0.0.1 + BINDTO = 127.0.0.1 ++RETURN_LOCAL_ADDRESSES = YES + + [hostlist] + SERVERS = -- cgit v1.2.3 From 0193c004322821409e7130f601c0ece676b32665 Mon Sep 17 00:00:00 2001 From: Manolis Ragkousis Date: Sun, 16 Feb 2014 10:17:52 +0000 Subject: gnu: Add GNU Mach headers. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/hurd.scm: New file * gnu-system.am (GNU_SYSTEM_MODULES): Add hurd.scm Co-authored-by: Ludovic Courtès Signed-off-by: Ludovic Courtès --- gnu-system.am | 1 + gnu/packages/hurd.scm | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+) create mode 100644 gnu/packages/hurd.scm diff --git a/gnu-system.am b/gnu-system.am index 8229cf0cdd..7e68290a95 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -105,6 +105,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/gxmessage.scm \ gnu/packages/help2man.scm \ gnu/packages/hugs.scm \ + gnu/packages/hurd.scm \ gnu/packages/icu4c.scm \ gnu/packages/idutils.scm \ gnu/packages/imagemagick.scm \ diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm new file mode 100644 index 0000000000..f915eda9cb --- /dev/null +++ b/gnu/packages/hurd.scm @@ -0,0 +1,57 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Manolis Fragkiskos Ragkousis +;;; +;;; 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 . + +(define-module (gnu packages hurd) + #:use-module (guix licenses) + #:use-module (guix download) + #:use-module (guix packages) + #:use-module (guix build-system gnu)) + +(define-public gnumach-headers + (package + (name "gnumach-headers") + (version "1.4") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/gnumach/gnumach-" + version ".tar.gz")) + (sha256 + (base32 + "0r371wsm7imx356p0xsls5hifb1gf9y90rm1phr0qkahbmfk9hlv")))) + (build-system gnu-build-system) + (arguments + `(#:phases (alist-replace + 'install + (lambda _ + (zero? + (system* "make" "install-data"))) + (alist-delete + 'build + %standard-phases)) + + ;; GNU Mach supports only IA32 currently, so cheat so that we can at + ;; least install its headers. + #:configure-flags '("--build=i686-pc-gnu") + + #:tests? #f)) + (home-page "https://www.gnu.org/software/hurd/microkernel/mach/gnumach.html") + (synopsis "GNU Mach kernel headers") + (description + "Headers of the GNU Mach kernel.") + (license gpl2+))) -- cgit v1.2.3 From 686e637ed283b82a8b254c0ea77f20aec4b827ff Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 16 Feb 2014 19:53:39 +0100 Subject: Add Manolis to 'AUTHORS'. --- AUTHORS | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS b/AUTHORS index 0c50e3cb27..705a43128e 100644 --- a/AUTHORS +++ b/AUTHORS @@ -16,6 +16,7 @@ alphabetical order): Raimon Grau Nikita Karetnikov Aljosha Papsch + Manolis Ragkousis Cyril Roelandt Alex Sassmannshausen Sree Harsha Totakura -- cgit v1.2.3 From 445c5abad8032f000387f36cc0533556289e5175 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 13 Feb 2014 00:42:41 -0500 Subject: gnu: ratpoison: Patch to use $SHELL instead of /bin/sh. * gnu/packages/patches/ratpoison-shell.patch: New file. * gnu/packages/ratpoison.scm (ratpoison): Add patch. * gnu-system.am (dist_patch_DATA): Add patch. --- gnu-system.am | 1 + gnu/packages/patches/ratpoison-shell.patch | 91 ++++++++++++++++++++++++++++++ gnu/packages/ratpoison.scm | 4 +- 3 files changed, 95 insertions(+), 1 deletion(-) create mode 100644 gnu/packages/patches/ratpoison-shell.patch diff --git a/gnu-system.am b/gnu-system.am index 7e68290a95..44ecf86de8 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -298,6 +298,7 @@ dist_patch_DATA = \ gnu/packages/patches/qemu-make-4.0.patch \ gnu/packages/patches/qemu-multiple-smb-shares.patch \ gnu/packages/patches/qt4-tests.patch \ + gnu/packages/patches/ratpoison-shell.patch \ gnu/packages/patches/readline-link-ncurses.patch \ gnu/packages/patches/ripperx-libm.patch \ gnu/packages/patches/scheme48-tests.patch \ diff --git a/gnu/packages/patches/ratpoison-shell.patch b/gnu/packages/patches/ratpoison-shell.patch new file mode 100644 index 0000000000..63d265a382 --- /dev/null +++ b/gnu/packages/patches/ratpoison-shell.patch @@ -0,0 +1,91 @@ +Use $SHELL instead of hardcoding /bin/sh in ratpoison. + +Patch by Mark H Weaver . + +--- ratpoison/src/actions.c.orig 2013-04-06 21:37:43.000000000 -0400 ++++ ratpoison/src/actions.c 2014-02-13 00:34:10.992553710 -0500 +@@ -19,6 +19,7 @@ + */ + + #include ++#include + #include /* for isspace */ + #include + #include +@@ -223,12 +223,12 @@ + add_command ("escape", cmd_escape, 1, 1, 1, + "Key: ", arg_KEY); + add_command ("exec", cmd_exec, 1, 1, 1, +- "/bin/sh -c ", arg_SHELLCMD); ++ "$SHELL -c ", arg_SHELLCMD); + add_command ("execa", cmd_execa, 1, 1, 1, +- "/bin/sh -c ", arg_SHELLCMD); ++ "$SHELL -c ", arg_SHELLCMD); + add_command ("execf", cmd_execf, 2, 2, 2, + "frame to execute in:", arg_FRAME, +- "/bin/sh -c ", arg_SHELLCMD); ++ "$SHELL -c ", arg_SHELLCMD); + add_command ("fdump", cmd_fdump, 1, 0, 0, + "", arg_NUMBER); + add_command ("focus", cmd_next_frame, 0, 0, 0); +@@ -359,7 +359,7 @@ + add_command ("unsetenv", cmd_unsetenv, 1, 1, 1, + "Variable: ", arg_STRING); + add_command ("verbexec", cmd_verbexec, 1, 1, 1, +- "/bin/sh -c ", arg_SHELLCMD); ++ "$SHELL -c ", arg_SHELLCMD); + add_command ("version", cmd_version, 0, 0, 0); + add_command ("vsplit", cmd_v_split, 1, 0, 0, + "Split: ", arg_STRING); +@@ -2627,6 +2627,9 @@ + pid = fork(); + if (pid == 0) + { ++ char *shell_path; ++ char *shell_name; ++ + /* Some process setup to make sure the spawned process runs + in its own session. */ + putenv(current_screen()->display_string); +@@ -2641,7 +2644,18 @@ + /* raw means don't run it through sh. */ + if (raw) + execl (cmd, cmd, NULL); +- execl("/bin/sh", "sh", "-c", cmd, NULL); ++ ++ shell_path = getenv ("SHELL"); ++ if (shell_path == NULL) ++ shell_path = "/bin/sh"; ++ ++ shell_name = strrchr (shell_path, '/'); ++ if (shell_name == NULL) ++ shell_name = shell_path; ++ else ++ shell_name++; ++ ++ execl(shell_path, shell_name, "-c", cmd, NULL); + _exit(EXIT_FAILURE); + } + +--- ratpoison/src/events.c.orig 2013-04-06 20:05:48.000000000 -0400 ++++ ratpoison/src/events.c 2014-02-13 00:34:39.327758789 -0500 +@@ -920,7 +920,7 @@ + { + /* Report any child that didn't return 0. */ + if (cur->status != 0) +- marked_message_printf (0,0, "/bin/sh -c \"%s\" finished (%d)", ++ marked_message_printf (0,0, "$SHELL -c \"%s\" finished (%d)", + cur->cmd, cur->status); + list_del (&cur->node); + free (cur->cmd); +--- ratpoison/src/messages.h.orig 2012-07-20 20:25:33.000000000 -0400 ++++ ratpoison/src/messages.h 2014-02-13 00:34:28.608398437 -0500 +@@ -41,7 +41,7 @@ + + #define MESSAGE_PROMPT_SWITCH_TO_WINDOW "Switch to window: " + #define MESSAGE_PROMPT_NEW_WINDOW_NAME "Set window's title to: " +-#define MESSAGE_PROMPT_SHELL_COMMAND "/bin/sh -c " ++#define MESSAGE_PROMPT_SHELL_COMMAND "$SHELL -c " + #define MESSAGE_PROMPT_COMMAND ":" + #define MESSAGE_PROMPT_SWITCH_WM "Switch to wm: " + #define MESSAGE_PROMPT_XTERM_COMMAND MESSAGE_PROMPT_SHELL_COMMAND TERM_PROG " -e " diff --git a/gnu/packages/ratpoison.scm b/gnu/packages/ratpoison.scm index fb1bfd8516..aabd1d330c 100644 --- a/gnu/packages/ratpoison.scm +++ b/gnu/packages/ratpoison.scm @@ -21,6 +21,7 @@ (define-module (gnu packages ratpoison) #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module ((guix licenses) #:select (gpl2+)) + #:use-module (gnu packages) #:use-module (gnu packages xorg) #:use-module (gnu packages perl) #:use-module (gnu packages readline) @@ -37,7 +38,8 @@ (define-public ratpoison version ".tar.xz")) (sha256 (base32 - "0v4mh8d3vsh5xbbycfdl3g8zfygi1rkslh1x7k5hi1d05bfq3cdr")))) + "0v4mh8d3vsh5xbbycfdl3g8zfygi1rkslh1x7k5hi1d05bfq3cdr")) + (patches (list (search-patch "ratpoison-shell.patch"))))) (build-system gnu-build-system) (inputs `(("libXi" ,libxi) -- cgit v1.2.3 From aaab995948e9e69d641be2d9c98131aff2a51ec7 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 14 Feb 2014 02:38:07 -0500 Subject: Update .gitignore for Guile 2.0.9 bootstrap binaries. * .gitignore: Change version number in ignored Guile bootstrap binaries from 2.0.7 to 2.0.9. --- .gitignore | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitignore b/.gitignore index 10b18daa5e..7cc6751c7e 100644 --- a/.gitignore +++ b/.gitignore @@ -46,8 +46,8 @@ config.cache /doc/guix.pdf /doc/stamp-vti /doc/version.texi -/gnu/packages/bootstrap/x86_64-linux/guile-2.0.7.tar.xz -/gnu/packages/bootstrap/i686-linux/guile-2.0.7.tar.xz +/gnu/packages/bootstrap/x86_64-linux/guile-2.0.9.tar.xz +/gnu/packages/bootstrap/i686-linux/guile-2.0.9.tar.xz /gnu/packages/bootstrap/mips64el-linux/guile-2.0.9.tar.xz /guix/config.scm /nix/nix-daemon/nix-daemon.cc -- cgit v1.2.3 From 72f210eafaad4c1bb4af78eb2353f8d9bfc7c4ac Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sat, 15 Feb 2014 20:32:57 -0500 Subject: gnu: Add ttf-dejavu. * gnu/packages/fonts.scm (ttf-dejavu): New variable. --- gnu/packages/fonts.scm | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) diff --git a/gnu/packages/fonts.scm b/gnu/packages/fonts.scm index c367a46e4a..8ec59e4d0e 100644 --- a/gnu/packages/fonts.scm +++ b/gnu/packages/fonts.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,6 +27,72 @@ (define-module (gnu packages fonts) #:select (tar)) #:use-module (gnu packages compression)) +(define-public ttf-dejavu + (package + (name "ttf-dejavu") + (version "2.34") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/dejavu/" + version "/dejavu-fonts-ttf-" + version ".tar.bz2")) + (sha256 + (base32 + "0pgb0a3ngamidacmrvasg51ck3gp8gn93w6sf1s8snwzx4x2r9yh")))) + (build-system trivial-build-system) + (arguments + `(#:modules ((guix build utils)) + #:builder (begin + (use-modules (guix build utils)) + + (let ((tar (string-append (assoc-ref %build-inputs + "tar") + "/bin/tar")) + (PATH (string-append (assoc-ref %build-inputs + "bzip2") + "/bin")) + (font-dir (string-append + %output "/share/fonts/truetype")) + (conf-dir (string-append + %output "/share/fontconfig/conf.avail")) + (doc-dir (string-append + %output "/share/doc/" ,name "-" ,version))) + (setenv "PATH" PATH) + (system* tar "xvf" (assoc-ref %build-inputs "source")) + + (mkdir-p font-dir) + (mkdir-p conf-dir) + (mkdir-p doc-dir) + (chdir (string-append "dejavu-fonts-ttf-" ,version)) + (for-each (lambda (ttf) + (copy-file ttf + (string-append font-dir "/" + (basename ttf)))) + (find-files "ttf" "\\.ttf$")) + (for-each (lambda (conf) + (copy-file conf + (string-append conf-dir "/" + (basename conf)))) + (find-files "fontconfig" "\\.conf$")) + (for-each (lambda (doc) + (copy-file doc + (string-append doc-dir "/" + (basename doc)))) + (find-files "." "\\.txt$|^[A-Z][A-Z]*$")))))) + (native-inputs `(("source" ,source) + ("tar" ,tar) + ("bzip2" ,bzip2))) + (home-page "http://dejavu-fonts.org/") + (synopsis "Vera font family derivate with additional characters") + (description "DejaVu provides an expanded version of the Vera font family +aiming for quality and broader Unicode coverage while retaining the original +Vera style. DejaVu currently works towards conformance with the Multilingual +European Standards (MES-1 and MES-2) for Unicode coverage. The DejaVu fonts +provide serif, sans and monospaced variants.") + (license + (license:x11-style + "http://dejavu-fonts.org/")))) + (define-public ttf-bitstream-vera (package (name "ttf-bitstream-vera") -- cgit v1.2.3 From 436c95d9a73064d7884530928a6ebb331377a9e3 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 16 Feb 2014 02:23:18 -0500 Subject: gnu: dmd: Sleep longer in tests, for slower machines. * gnu/packages/patches/dmd-tests-longer-sleeps.patch: New file. * gnu/packages/admin.scm (dmd): Add the patch. * gnu-system.am (dist_patch_DATA): Add it. --- gnu-system.am | 1 + gnu/packages/admin.scm | 3 +- gnu/packages/patches/dmd-tests-longer-sleeps.patch | 52 ++++++++++++++++++++++ 3 files changed, 55 insertions(+), 1 deletion(-) create mode 100644 gnu/packages/patches/dmd-tests-longer-sleeps.patch diff --git a/gnu-system.am b/gnu-system.am index 44ecf86de8..9b0a6919d9 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -247,6 +247,7 @@ dist_patch_DATA = \ gnu/packages/patches/dbus-localstatedir.patch \ gnu/packages/patches/diffutils-gets-undeclared.patch \ gnu/packages/patches/dmd-getpw.patch \ + gnu/packages/patches/dmd-tests-longer-sleeps.patch \ gnu/packages/patches/emacs-configure-sh.patch \ gnu/packages/patches/findutils-absolute-paths.patch \ gnu/packages/patches/flac-fix-memcmp-not-declared.patch \ diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index 928d752531..6998996523 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -49,7 +49,8 @@ (define-public dmd (sha256 (base32 "07mddw0p62fcphwjzgb6rfa0pjz5sy6jzbha0sm2vc3rqf459jxg")) - (patches (list (search-patch "dmd-getpw.patch"))))) + (patches (list (search-patch "dmd-getpw.patch") + (search-patch "dmd-tests-longer-sleeps.patch"))))) (build-system gnu-build-system) (arguments '(#:configure-flags '("--localstatedir=/var"))) diff --git a/gnu/packages/patches/dmd-tests-longer-sleeps.patch b/gnu/packages/patches/dmd-tests-longer-sleeps.patch new file mode 100644 index 0000000000..708000f351 --- /dev/null +++ b/gnu/packages/patches/dmd-tests-longer-sleeps.patch @@ -0,0 +1,52 @@ +Increase sleep times in tests, for slower machines. + +Patch by Mark H Weaver . + +--- dmd/tests/basic.sh 2013-11-30 17:22:00.000000000 -0500 ++++ dmd/tests/basic.sh 2014-02-16 02:18:34.036376953 -0500 +@@ -46,7 +46,7 @@ + dmd -I -s "$socket" -c "$conf" -l "$log" & + dmd_pid=$! + +-sleep 1 # XXX: wait till it's up ++sleep 3 # XXX: wait till it's up + kill -0 $dmd_pid + test -S "$socket" + $deco status dmd | grep -E '(Start.*dmd|Stop.*test)' +--- dmd/tests/respawn.sh 2013-12-01 16:50:37.000000000 -0500 ++++ dmd/tests/respawn.sh 2014-02-16 02:19:16.958251953 -0500 +@@ -39,7 +39,7 @@ + i=0 + while ! test -f "$1" && test $i -lt 20 + do +- sleep 0.3 ++ sleep 1 + i=`expr $i + 1` + done + test -f "$1" +@@ -65,14 +65,14 @@ + #:provides '(test1) + #:start (make-forkexec-constructor + "$SHELL" "-c" +- "echo \$\$ > $service1_pid ; while true ; do sleep 1 ; done") ++ "echo \$\$ > $service1_pid ; while true ; do sleep 3 ; done") + #:stop (make-kill-destructor) + #:respawn? #t) + (make + #:provides '(test2) + #:start (make-forkexec-constructor + "$SHELL" "-c" +- "echo \$\$ > $service2_pid ; while true ; do sleep 1 ; done") ++ "echo \$\$ > $service2_pid ; while true ; do sleep 3 ; done") + #:stop (make-kill-destructor) + #:respawn? #t)) + (start 'test1) +@@ -82,7 +82,7 @@ + dmd -I -s "$socket" -c "$conf" -l "$log" & + dmd_pid=$! + +-sleep 1 # XXX: wait till it's up ++sleep 3 # XXX: wait till it's up + kill -0 $dmd_pid + test -S "$socket" + $deco status test1 | grep started -- cgit v1.2.3 From 7ee3f1a2089949870565582f306c5a40a08244d2 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Sun, 16 Feb 2014 23:01:56 +0100 Subject: gnu: Add hdf5. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/maths.scm (hdf5): New variable. * gnu/packages/maths.scm (octave): New input hdf5. Signed-off-by: Ludovic Courtès --- gnu/packages/maths.scm | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index f5bd1d12d4..fe87e6d25a 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -236,6 +236,36 @@ (define-public gnuplot (license (license:fsf-free "http://gnuplot.cvs.sourceforge.net/gnuplot/gnuplot/Copyright")))) +(define-public hdf5 + (package + (name "hdf5") + (version "1.8.12") + (source + (origin + (method url-fetch) + (uri (string-append "http://www.hdfgroup.org/ftp/HDF5/current/src/hdf5-" + version ".tar.bz2")) + (sha256 + (base32 "0f9n0v3p3lwc7564791a39c6cn1d3dbrn7d1j3ikqsi27a8hy23d")))) + (build-system gnu-build-system) + (arguments + `(#:phases + (alist-replace + 'configure + (lambda* (#:key target system outputs #:allow-other-keys #:rest args) + (let ((configure (assoc-ref %standard-phases 'configure))) + (substitute* "configure" + (("/bin/mv") "mv")) + (apply configure args))) + %standard-phases))) + (outputs '("out" "bin" "lib" "include")) + (home-page "http://www.hdfgroup.org") + (synopsis "Management suite for extremely large and complex data") + (description "HDF5 is a suite that makes possible the management of +extremely large and complex data collections.") + (license (license:x11-style "http://www.hdfgroup.org/ftp/HDF5/current/src/unpacked/COPYING")))) + + ;; For a fully featured Octave, users are strongly recommended also to install ;; the following packages: texinfo, less, ghostscript, gnuplot. (define-public octave @@ -260,6 +290,8 @@ (define-public octave ("fltk" ,fltk) ("fontconfig" ,fontconfig) ("freetype" ,freetype) + ("hdf5-lib" ,hdf5 "lib") + ("hdf5-include" ,hdf5 "include") ("libxft" ,libxft) ("mesa" ,mesa) ("zlib" ,zlib))) -- cgit v1.2.3 From d850e5b913789c2d842d00bb7a27cf13f2ebe005 Mon Sep 17 00:00:00 2001 From: Sree Harsha Totakura Date: Sun, 16 Feb 2014 20:00:02 +0100 Subject: gnu: gnurl: Update to 7.35.0. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/gnunet.scm (gnurl): Update to 7.35.0. Signed-off-by: Ludovic Courtès --- gnu/packages/gnunet.scm | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/gnu/packages/gnunet.scm b/gnu/packages/gnunet.scm index 960a5d725c..b08479624d 100644 --- a/gnu/packages/gnunet.scm +++ b/gnu/packages/gnunet.scm @@ -137,17 +137,13 @@ (define-public libmicrohttpd (define-public gnurl (package (name "gnurl") - (version "7.34.0") + (version "7.35.0") (source (origin (method url-fetch) (uri (string-append "https://gnunet.org/sites/default/files/gnurl-" version ".tar.bz2")) (sha256 - (base32 - "0kpi9wx9lg938b982smjg54acdwswdshs2bzf10sj5r6zmb05ygp")) - ;; This patch fixes testcase 172 which uses a hardcoded cookie - ;; expiration value which is expired as of Feb 1, 2014. - (patches (list (search-patch "curl-fix-test172.patch"))))) + (base32 "0dzj22f5z6ppjj1aq1bml64iwbzzcd8w1qy3bgpk6gnzqslsxknf")))) (build-system gnu-build-system) (inputs `(("gnutls" ,gnutls) ("libidn" ,libidn) -- cgit v1.2.3 From 98e7fc9b02f00f3f2324b12dec1a6cd9beafbe01 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 16 Feb 2014 23:09:18 -0500 Subject: gnu: Add xapian. * gnu/packages/search.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. --- gnu-system.am | 1 + gnu/packages/search.scm | 58 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+) create mode 100644 gnu/packages/search.scm diff --git a/gnu-system.am b/gnu-system.am index 9b0a6919d9..86bece3638 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -184,6 +184,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/scheme.scm \ gnu/packages/screen.scm \ gnu/packages/sdl.scm \ + gnu/packages/search.scm \ gnu/packages/serveez.scm \ gnu/packages/shishi.scm \ gnu/packages/skribilo.scm \ diff --git a/gnu/packages/search.scm b/gnu/packages/search.scm new file mode 100644 index 0000000000..282893d2e6 --- /dev/null +++ b/gnu/packages/search.scm @@ -0,0 +1,58 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Mark H Weaver +;;; +;;; 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 . + +(define-module (gnu packages search) + #:use-module ((guix licenses) + #:select (gpl2+ bsd-3 x11)) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages compression) + #:use-module (gnu packages linux) + #:export (xapian)) + +(define-public xapian + (package + (name "xapian") + (version "1.2.17") + (source (origin + (method url-fetch) + (uri (string-append "http://oligarchy.co.uk/xapian/" version + "/xapian-core-" version ".tar.xz")) + (sha256 + (base32 "1pn65h06c23imck2pb42zhrrngch3clk39wl2bjwyqhfyfq4b7g7")))) + (build-system gnu-build-system) + (inputs `(("zlib" ,zlib) + ("util-linux" ,util-linux))) + (arguments + `(#:phases (alist-cons-after + 'unpack 'patch-remotetcp-harness + (lambda _ + (substitute* "tests/harness/backendmanager_remotetcp.cc" + (("/bin/sh") (which "bash")))) + %standard-phases))) + (synopsis "Search Engine Library") + (description + "Xapian is a highly adaptable toolkit which allows developers to easily +add advanced indexing and search facilities to their own applications. It +supports the Probabilistic Information Retrieval model and also supports a +rich set of boolean query operators.") + (home-page "http://xapian.org/") + (license (list gpl2+ bsd-3 x11)))) + +;;; search.scm ends here -- cgit v1.2.3 From e7fc17b592a0d25c18fbc6774b1f8a6d2a9bbc69 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 18 Feb 2014 00:13:06 +0100 Subject: guix build: Factorize common options. * guix/scripts/build.scm (show-build-options-help, set-build-options-from-command-line): New procedures. (show-help): Remove description of --dry-run, --fallback, --no-substitutes, --max-silent-time, and --cores. Call 'show-build-options-help'. (%standard-build-options): New variable. (%options): Remove --dry-run, --fallback, --no-substitutes, --verbosity, --max-silent-time, and --cores. Add %STANDARD-BUILD-OPTIONS. (guix-build): Use 'set-build-options-from-command-line' instead of 'set-build-options'. * guix/scripts/archive.scm (show-help): Remove description of --dry-run, --fallback, --no-substitutes, --max-silent-time, and --cores. Call 'show-build-options-help'. (%options): Remove --dry-run, --fallback, --no-substitutes, --verbosity, --max-silent-time, and --cores. Add %STANDARD-BUILD-OPTIONS. (export-from-store): Call 'set-build-options-from-command-line' instead of 'set-build-options. --- guix/scripts/archive.scm | 147 ++++++++++++++--------------------- guix/scripts/build.scm | 198 +++++++++++++++++++++++++++-------------------- 2 files changed, 169 insertions(+), 176 deletions(-) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 32690c6b45..4788468584 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -71,17 +71,10 @@ (define (show-help) -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) (display (_ " --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) - (display (_ " - -n, --dry-run do not build the derivations")) - (display (_ " - --fallback fall back to building when the substituter fails")) - (display (_ " - --no-substitutes build instead of resorting to pre-built substitutes")) - (display (_ " - --max-silent-time=SECONDS - mark the build as failed after SECONDS of silence")) - (display (_ " - -c, --cores=N allow the use of up to N CPU cores for the build")) + + (newline) + (show-build-options-help) + (newline) (display (_ " -h, --help display this help and exit")) @@ -92,81 +85,60 @@ (define (show-help) (define %options ;; Specifications of the command-line options. - (list (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix build"))) + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix build"))) - (option '("export") #f #f - (lambda (opt name arg result) - (alist-cons 'export #t result))) - (option '("import") #f #f - (lambda (opt name arg result) - (alist-cons 'import #t result))) - (option '("missing") #f #f - (lambda (opt name arg result) - (alist-cons 'missing #t result))) - (option '("generate-key") #f #t - (lambda (opt name arg result) - (catch 'gcry-error - (lambda () - (let ((params - (string->canonical-sexp - (or arg "(genkey (rsa (nbits 4:4096)))")))) - (alist-cons 'generate-key params result))) - (lambda args - (leave (_ "invalid key generation parameters: ~s~%") - arg))))) - (option '("authorize") #f #f - (lambda (opt name arg result) - (alist-cons 'authorize #t result))) + (option '("export") #f #f + (lambda (opt name arg result) + (alist-cons 'export #t result))) + (option '("import") #f #f + (lambda (opt name arg result) + (alist-cons 'import #t result))) + (option '("missing") #f #f + (lambda (opt name arg result) + (alist-cons 'missing #t result))) + (option '("generate-key") #f #t + (lambda (opt name arg result) + (catch 'gcry-error + (lambda () + (let ((params + (string->canonical-sexp + (or arg "(genkey (rsa (nbits 4:4096)))")))) + (alist-cons 'generate-key params result))) + (lambda args + (leave (_ "invalid key generation parameters: ~s~%") + arg))))) + (option '("authorize") #f #f + (lambda (opt name arg result) + (alist-cons 'authorize #t result))) - (option '(#\S "source") #f #f - (lambda (opt name arg result) - (alist-cons 'source? #t result))) - (option '(#\s "system") #t #f - (lambda (opt name arg result) - (alist-cons 'system arg - (alist-delete 'system result eq?)))) - (option '("target") #t #f - (lambda (opt name arg result) - (alist-cons 'target arg - (alist-delete 'target result eq?)))) - (option '(#\e "expression") #t #f - (lambda (opt name arg result) - (alist-cons 'expression arg result))) - (option '(#\c "cores") #t #f - (lambda (opt name arg result) - (let ((c (false-if-exception (string->number arg)))) - (if c - (alist-cons 'cores c result) - (leave (_ "~a: not a number~%") arg))))) - (option '(#\n "dry-run") #f #f - (lambda (opt name arg result) - (alist-cons 'dry-run? #t result))) - (option '("fallback") #f #f - (lambda (opt name arg result) - (alist-cons 'fallback? #t - (alist-delete 'fallback? result)))) - (option '("no-substitutes") #f #f - (lambda (opt name arg result) - (alist-cons 'substitutes? #f - (alist-delete 'substitutes? result)))) - (option '("max-silent-time") #t #f - (lambda (opt name arg result) - (alist-cons 'max-silent-time (string->number* arg) - result))) - (option '(#\r "root") #t #f - (lambda (opt name arg result) - (alist-cons 'gc-root arg result))) - (option '("verbosity") #t #f - (lambda (opt name arg result) - (let ((level (string->number arg))) - (alist-cons 'verbosity level - (alist-delete 'verbosity result))))))) + (option '(#\S "source") #f #f + (lambda (opt name arg result) + (alist-cons 'source? #t result))) + (option '(#\s "system") #t #f + (lambda (opt name arg result) + (alist-cons 'system arg + (alist-delete 'system result eq?)))) + (option '("target") #t #f + (lambda (opt name arg result) + (alist-cons 'target arg + (alist-delete 'target result eq?)))) + (option '(#\e "expression") #t #f + (lambda (opt name arg result) + (alist-cons 'expression arg result))) + (option '(#\n "dry-run") #f #f + (lambda (opt name arg result) + (alist-cons 'dry-run? #t result))) + (option '(#\r "root") #t #f + (lambda (opt name arg result) + (alist-cons 'gc-root arg result))) + + %standard-build-options)) (define (options->derivations+files store opts) "Given OPTS, the result of 'args-fold', return a list of derivations to @@ -219,16 +191,11 @@ (define (export-from-store store opts) resulting archive to the standard output port." (let-values (((drv files) (options->derivations+files store opts))) + (set-build-options-from-command-line store opts) (show-what-to-build store drv #:use-substitutes? (assoc-ref opts 'substitutes?) #:dry-run? (assoc-ref opts 'dry-run?)) - (set-build-options store - #:build-cores (or (assoc-ref opts 'cores) 0) - #:fallback? (assoc-ref opts 'fallback?) - #:use-substitutes? (assoc-ref opts 'substitutes?) - #:max-silent-time (assoc-ref opts 'max-silent-time)) - (if (or (assoc-ref opts 'dry-run?) (build-derivations store drv)) (export-paths store files (current-output-port)) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index b153da8493..4a00505022 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -34,6 +34,11 @@ (define-module (guix scripts build) #:use-module (srfi srfi-37) #:autoload (gnu packages) (find-best-packages-by-name) #:export (derivation-from-expression + + %standard-build-options + set-build-options-from-command-line + show-build-options-help + guix-build)) (define (derivation-from-expression store str package-derivation @@ -101,30 +106,13 @@ (define (register-root store paths root) ;;; -;;; Command-line options. +;;; Standard command-line build options. ;;; -(define %default-options - ;; Alist of default option values. - `((system . ,(%current-system)) - (substitutes? . #t) - (build-hook? . #t) - (max-silent-time . 3600) - (verbosity . 0))) - -(define (show-help) - (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION... -Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) - (display (_ " - -e, --expression=EXPR build the package or derivation EXPR evaluates to")) - (display (_ " - -S, --source build the packages' source derivations")) - (display (_ " - -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) - (display (_ " - --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) - (display (_ " - -d, --derivations return the derivation paths of the given packages")) +(define (show-build-options-help) + "Display on the current output port help about the standard command-line +options handled by 'set-build-options-from-command-line', and listed in +'%standard-build-options'." (display (_ " -K, --keep-failed keep build tree of failed builds")) (display (_ " @@ -138,62 +126,29 @@ (define (show-help) (display (_ " --max-silent-time=SECONDS mark the build as failed after SECONDS of silence")) - (display (_ " - -c, --cores=N allow the use of up to N CPU cores for the build")) - (display (_ " - -r, --root=FILE make FILE a symlink to the result, and register it - as a garbage collector root")) (display (_ " --verbosity=LEVEL use the given verbosity LEVEL")) (display (_ " - --log-file return the log file names for the given derivations")) - (newline) - (display (_ " - -h, --help display this help and exit")) - (display (_ " - -V, --version display version information and exit")) - (newline) - (show-bug-report-information)) + -c, --cores=N allow the use of up to N CPU cores for the build"))) -(define %options - ;; Specifications of the command-line options. - (list (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix build"))) +(define (set-build-options-from-command-line store opts) + "Given OPTS, an alist as returned by 'args-fold' given +'%standard-build-options', set the corresponding build options on STORE." + ;; TODO: Add more options. + (set-build-options store + #:keep-failed? (assoc-ref opts 'keep-failed?) + #:build-cores (or (assoc-ref opts 'cores) 0) + #:fallback? (assoc-ref opts 'fallback?) + #:use-substitutes? (assoc-ref opts 'substitutes?) + #:use-build-hook? (assoc-ref opts 'build-hook?) + #:max-silent-time (assoc-ref opts 'max-silent-time) + #:verbosity (assoc-ref opts 'verbosity))) - (option '(#\S "source") #f #f - (lambda (opt name arg result) - (alist-cons 'source? #t result))) - (option '(#\s "system") #t #f - (lambda (opt name arg result) - (alist-cons 'system arg - (alist-delete 'system result eq?)))) - (option '("target") #t #f - (lambda (opt name arg result) - (alist-cons 'target arg - (alist-delete 'target result eq?)))) - (option '(#\d "derivations") #f #f - (lambda (opt name arg result) - (alist-cons 'derivations-only? #t result))) - (option '(#\e "expression") #t #f - (lambda (opt name arg result) - (alist-cons 'expression arg result))) - (option '(#\K "keep-failed") #f #f +(define %standard-build-options + ;; List of standard command-line options for tools that build something. + (list (option '(#\K "keep-failed") #f #f (lambda (opt name arg result) (alist-cons 'keep-failed? #t result))) - (option '(#\c "cores") #t #f - (lambda (opt name arg result) - (let ((c (false-if-exception (string->number arg)))) - (if c - (alist-cons 'cores c result) - (leave (_ "~a: not a number~%") arg))))) - (option '(#\n "dry-run") #f #f - (lambda (opt name arg result) - (alist-cons 'dry-run? #t result))) (option '("fallback") #f #f (lambda (opt name arg result) (alist-cons 'fallback? #t @@ -210,17 +165,97 @@ (define %options (lambda (opt name arg result) (alist-cons 'max-silent-time (string->number* arg) result))) - (option '(#\r "root") #t #f - (lambda (opt name arg result) - (alist-cons 'gc-root arg result))) (option '("verbosity") #t #f (lambda (opt name arg result) (let ((level (string->number arg))) (alist-cons 'verbosity level (alist-delete 'verbosity result))))) - (option '("log-file") #f #f + (option '(#\c "cores") #t #f (lambda (opt name arg result) - (alist-cons 'log-file? #t result))))) + (let ((c (false-if-exception (string->number arg)))) + (if c + (alist-cons 'cores c result) + (leave (_ "~a: not a number~%") arg))))))) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + ;; Alist of default option values. + `((system . ,(%current-system)) + (substitutes? . #t) + (build-hook? . #t) + (max-silent-time . 3600) + (verbosity . 0))) + +(define (show-help) + (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION... +Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) + (display (_ " + -e, --expression=EXPR build the package or derivation EXPR evaluates to")) + (display (_ " + -S, --source build the packages' source derivations")) + (display (_ " + -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) + (display (_ " + --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) + (display (_ " + -d, --derivations return the derivation paths of the given packages")) + (display (_ " + -r, --root=FILE make FILE a symlink to the result, and register it + as a garbage collector root")) + (display (_ " + --log-file return the log file names for the given derivations")) + (newline) + (show-build-options-help) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specifications of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix build"))) + + (option '(#\S "source") #f #f + (lambda (opt name arg result) + (alist-cons 'source? #t result))) + (option '(#\s "system") #t #f + (lambda (opt name arg result) + (alist-cons 'system arg + (alist-delete 'system result eq?)))) + (option '("target") #t #f + (lambda (opt name arg result) + (alist-cons 'target arg + (alist-delete 'target result eq?)))) + (option '(#\d "derivations") #f #f + (lambda (opt name arg result) + (alist-cons 'derivations-only? #t result))) + (option '(#\e "expression") #t #f + (lambda (opt name arg result) + (alist-cons 'expression arg result))) + (option '(#\n "dry-run") #f #f + (lambda (opt name arg result) + (alist-cons 'dry-run? #t result))) + (option '(#\r "root") #t #f + (lambda (opt name arg result) + (alist-cons 'gc-root arg result))) + (option '("log-file") #f #f + (lambda (opt name arg result) + (alist-cons 'log-file? #t result))) + + %standard-build-options)) (define (options->derivations store opts) "Given OPTS, the result of 'args-fold', return a list of derivations to @@ -279,16 +314,7 @@ (define (parse-options) (_ #f)) opts))) - ;; TODO: Add more options. - (set-build-options store - #:keep-failed? (assoc-ref opts 'keep-failed?) - #:build-cores (or (assoc-ref opts 'cores) 0) - #:fallback? (assoc-ref opts 'fallback?) - #:use-substitutes? (assoc-ref opts 'substitutes?) - #:use-build-hook? (assoc-ref opts 'build-hook?) - #:max-silent-time (assoc-ref opts 'max-silent-time) - #:verbosity (assoc-ref opts 'verbosity)) - + (set-build-options-from-command-line store opts) (unless (assoc-ref opts 'log-file?) (show-what-to-build store drv #:use-substitutes? (assoc-ref opts 'substitutes?) -- cgit v1.2.3 From 0841dcf7dd8e6c3e474f75cfa5b95a7feaf6f112 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 16 Feb 2014 20:20:10 -0500 Subject: gnu: patchelf: Fix platform page size determination. * gnu/packages/patches/patchelf-page-size.patch: New file. * gnu/packages/elf.scm (patchelf): Add the patch. * gnu-system.am (dist_patch_DATA): Add the patch. --- gnu-system.am | 1 + gnu/packages/elf.scm | 4 +- gnu/packages/patches/patchelf-page-size.patch | 69 +++++++++++++++++++++++++++ 3 files changed, 73 insertions(+), 1 deletion(-) create mode 100644 gnu/packages/patches/patchelf-page-size.patch diff --git a/gnu-system.am b/gnu-system.am index 86bece3638..d231cfa57b 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -291,6 +291,7 @@ dist_patch_DATA = \ gnu/packages/patches/make-impure-dirs.patch \ gnu/packages/patches/mcron-install.patch \ gnu/packages/patches/mit-krb5-init-fix.patch \ + gnu/packages/patches/patchelf-page-size.patch \ gnu/packages/patches/perl-no-sys-dirs.patch \ gnu/packages/patches/plotutils-libpng-jmpbuf.patch \ gnu/packages/patches/procps-make-3.82.patch \ diff --git a/gnu/packages/elf.scm b/gnu/packages/elf.scm index 1df9956f87..45714be70e 100644 --- a/gnu/packages/elf.scm +++ b/gnu/packages/elf.scm @@ -21,6 +21,7 @@ (define-module (gnu packages elf) #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module ((guix licenses) #:select (gpl3+ lgpl3+ lgpl2.0+)) + #:use-module (gnu packages) #:use-module (gnu packages m4) #:use-module (gnu packages compression)) @@ -92,7 +93,8 @@ (define-public patchelf "/patchelf-" version ".tar.bz2")) (sha256 (base32 - "00bw29vdsscsili65wcb5ay0gvg1w0ljd00sb5xc6br8bylpyzpw")))) + "00bw29vdsscsili65wcb5ay0gvg1w0ljd00sb5xc6br8bylpyzpw")) + (patches (list (search-patch "patchelf-page-size.patch"))))) (build-system gnu-build-system) (home-page "http://nixos.org/patchelf.html") (synopsis "Modify the dynamic linker and RPATH of ELF executables") diff --git a/gnu/packages/patches/patchelf-page-size.patch b/gnu/packages/patches/patchelf-page-size.patch new file mode 100644 index 0000000000..2528b604e5 --- /dev/null +++ b/gnu/packages/patches/patchelf-page-size.patch @@ -0,0 +1,69 @@ +Improve the determination of pageSize in patchelf.cc. + +Patch by Mark H Weaver . + +--- patchelf/src/patchelf.cc.orig 1969-12-31 19:00:01.000000000 -0500 ++++ patchelf/src/patchelf.cc 2014-02-16 20:15:06.283203125 -0500 +@@ -21,11 +21,19 @@ + using namespace std; + + +-#ifdef MIPSEL +-/* The lemote fuloong 2f kernel defconfig sets a page size of 16KB */ +-const unsigned int pageSize = 4096*4; +-#else ++/* Note that some platforms support multiple page sizes. Therefore, ++ it is not enough to query the current page size. 'pageSize' must ++ be the maximum architectural page size for the platform, which is ++ typically defined in the corresponding ABI document. ++ ++ XXX FIXME: This won't work when we're cross-compiling. */ ++ ++#if defined __MIPSEL__ || defined __MIPSEB__ || defined __aarch64__ ++const unsigned int pageSize = 65536; ++#elif defined __x86_64__ || defined __i386__ || defined __arm__ + const unsigned int pageSize = 4096; ++#else ++# error maximum architectural page size unknown for this platform + #endif + + +--- patchelf/tests/no-rpath.sh.orig 1969-12-31 19:00:01.000000000 -0500 ++++ patchelf/tests/no-rpath.sh 2014-02-16 20:44:12.036376953 -0500 +@@ -1,22 +1,22 @@ + #! /bin/sh -e + +-rm -rf scratch +-mkdir -p scratch ++if [ "$(uname -m)" = i686 -a "$(uname -s)" = Linux ]; then ++ rm -rf scratch ++ mkdir -p scratch + +-cp no-rpath scratch/ ++ cp no-rpath scratch/ + +-oldRPath=$(../src/patchelf --print-rpath scratch/no-rpath) +-if test -n "$oldRPath"; then exit 1; fi +-../src/patchelf \ +- --set-interpreter "$(../src/patchelf --print-interpreter ../src/patchelf)" \ +- --set-rpath /foo:/bar:/xxxxxxxxxxxxxxx scratch/no-rpath ++ oldRPath=$(../src/patchelf --print-rpath scratch/no-rpath) ++ if test -n "$oldRPath"; then exit 1; fi ++ ../src/patchelf \ ++ --set-interpreter "$(../src/patchelf --print-interpreter ../src/patchelf)" \ ++ --set-rpath /foo:/bar:/xxxxxxxxxxxxxxx scratch/no-rpath + +-newRPath=$(../src/patchelf --print-rpath scratch/no-rpath) +-if ! echo "$newRPath" | grep -q '/foo:/bar'; then +- echo "incomplete RPATH" +- exit 1 +-fi ++ newRPath=$(../src/patchelf --print-rpath scratch/no-rpath) ++ if ! echo "$newRPath" | grep -q '/foo:/bar'; then ++ echo "incomplete RPATH" ++ exit 1 ++ fi + +-if [ "$(uname -m)" = i686 -a "$(uname -s)" = Linux ]; then + cd scratch && ./no-rpath + fi -- cgit v1.2.3 From 625bd408064605a6ab1107603d8b5bb6353ae9f1 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 16 Feb 2014 16:38:00 -0500 Subject: gnu: icu4c: Upgrade to 52.1. * gnu/packages/icu4c.scm (icu4c): Upgrade to 52.1. --- gnu/packages/icu4c.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/packages/icu4c.scm b/gnu/packages/icu4c.scm index 6129662436..aea5d2fae5 100644 --- a/gnu/packages/icu4c.scm +++ b/gnu/packages/icu4c.scm @@ -28,7 +28,7 @@ (define-module (gnu packages icu4c) (define-public icu4c (package (name "icu4c") - (version "50.1.1") + (version "52.1") (source (origin (method url-fetch) (uri (string-append "http://download.icu-project.org/files/icu4c/" @@ -37,7 +37,7 @@ (define-public icu4c (string-map (lambda (x) (if (char=? x #\.) #\_ x)) version) "-src.tgz")) (sha256 (base32 - "13yz0kk6zsgj94idnlr3vbg8iph5z4ly4b4xrd5wfja7q3ijdx56")))) + "14l0kl17nirc34frcybzg0snknaks23abhdxkmsqg3k9sil5wk9g")))) (build-system gnu-build-system) (inputs `(("patchelf" ,patchelf) @@ -61,7 +61,7 @@ (define-public icu4c (lambda* (#:key #:allow-other-keys #:rest args) (let ((configure (assoc-ref %standard-phases 'configure))) ;; patch out two occurrences of /bin/sh from configure script - ;; that might have disappeared in a release later than 50.1.1 + ;; that might have disappeared in a release later than 52.1 (substitute* "configure" (("`/bin/sh") (string-append "`" (which "bash")))) -- cgit v1.2.3 From d93627e4a9c2652b577c097363614a212dcab23a Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 18 Feb 2014 03:46:09 -0500 Subject: gnu: gnutls: Upgrade to 3.2.11. * gnu/packages/gnutls.scm (gnutls): Upgrade to 3.2.11. Improve URI computation. --- gnu/packages/gnutls.scm | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/gnu/packages/gnutls.scm b/gnu/packages/gnutls.scm index 79cebe637d..915f6f8c8f 100644 --- a/gnu/packages/gnutls.scm +++ b/gnu/packages/gnutls.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,7 +30,8 @@ (define-module (gnu packages gnutls) #:use-module (gnu packages perl) #:use-module (gnu packages which) #:use-module (gnu packages texinfo) - #:use-module (gnu packages pkg-config)) + #:use-module (gnu packages pkg-config) + #:use-module (srfi srfi-1)) (define-public libtasn1 (package @@ -61,17 +63,19 @@ (define-public libtasn1 (define-public gnutls (package (name "gnutls") - (version "3.2.4") + (version "3.2.11") (source (origin (method url-fetch) (uri ;; Note: Releases are no longer on ftp.gnu.org since the ;; schism (after version 3.1.5). - (string-append "mirror://gnupg/gnutls/v3.2/gnutls-" - version ".tar.xz")) + (string-append "mirror://gnupg/gnutls/v" + (string-join (take (string-split version #\.) 2) + ".") + "/gnutls-" version ".tar.xz")) (sha256 (base32 - "0zvhzy87v9dfxfvmg1pl951kw55rp647cqdza8942fxq7spp158i")))) + "1hgk3k8f6wqijca3bsjbfn8pzyfva509y4j2vaxhm4ynfa5cai5q")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) -- cgit v1.2.3 From 7c869effd4a75b86a00f699feba95a709a896622 Mon Sep 17 00:00:00 2001 From: Sree Harsha Totakura Date: Tue, 18 Feb 2014 21:05:17 +0100 Subject: gnu: ncdc: Update to 1.19. * gnu/packages/dc (ncdc): Update to 1.19. Signed-off-by: Andreas Enge --- gnu/packages/dc.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/gnu/packages/dc.scm b/gnu/packages/dc.scm index 75ed5f4af7..0cb7c5b4f0 100644 --- a/gnu/packages/dc.scm +++ b/gnu/packages/dc.scm @@ -28,19 +28,19 @@ (define-module (gnu packages dc) #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module ((guix licenses) - #:renamer (symbol-prefix-proc 'license:))) + #:renamer (symbol-prefix-proc 'license:))) (define-public ncdc (package (name "ncdc") - (version "1.18.1") + (version "1.19") (source (origin (method url-fetch) (uri (string-append "http://dev.yorhel.nl/download/ncdc-" version - ".tar.gz")) + ".tar.gz")) (sha256 (base32 - "11c6z9c3vv2vg01q02r53m28q3cx6x66j1l63f1mbk1crlqpf9fc")))) + "1wgvqwfxq9kc729h2r528n55821w87sfbm4h21mr6pvkpfw30hf2")))) (build-system gnu-build-system) (inputs `(("bzip2" ,bzip2) -- cgit v1.2.3 From 67543125f3f838c8789877797aa92fda68bdcd9e Mon Sep 17 00:00:00 2001 From: Sree Harsha Totakura Date: Tue, 18 Feb 2014 21:57:43 +0100 Subject: gnu: gnurl: Do not disable testcase 1022. * gnu/packages/gnunet.scm (gnurl): Do not disable testcase 1022. Signed-off-by: Andreas Enge --- gnu/packages/gnunet.scm | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/gnu/packages/gnunet.scm b/gnu/packages/gnunet.scm index b08479624d..7f7a6fd6f9 100644 --- a/gnu/packages/gnunet.scm +++ b/gnu/packages/gnunet.scm @@ -167,20 +167,13 @@ (define-public gnurl "--disable-file" "--disable-ftp") #:test-target "test" #:parallel-tests? #f - ;; We have to patch runtests.pl in tests/ directory and add a failing - ;; test due to curl->gnurl name change to tests/data/DISABLED + ;; We have to patch runtests.pl in tests/ directory #:phases (alist-cons-before 'check 'patch-runtests (lambda _ - (with-directory-excursion "tests" - (substitute* "runtests.pl" - (("/bin/sh") - (which "sh"))) - (let* ((port (open-file "data/DISABLED" "a"))) - (newline port) - (display "1022" port) - (close port)))) + (substitute* "tests/runtests.pl" + (("/bin/sh") (which "sh")))) %standard-phases))) (synopsis "Microfork of cURL with support for the HTTP/HTTPS/GnuTLS subset of cURL") (description -- cgit v1.2.3 From 2977b307ef0035773d47285855cdbc8f2bade490 Mon Sep 17 00:00:00 2001 From: Sree Harsha Totakura Date: Tue, 18 Feb 2014 21:45:57 +0100 Subject: gnu: curl: Update to 7.35.0. * gnu/packages/curl.scm (curl): Update to 7.35.0. Signed-off-by: Andreas Enge --- gnu/packages/curl.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/curl.scm b/gnu/packages/curl.scm index a9bfa76aa0..ea7dbf6e21 100644 --- a/gnu/packages/curl.scm +++ b/gnu/packages/curl.scm @@ -36,14 +36,14 @@ (define-module (gnu packages curl) (define-public curl (package (name "curl") - (version "7.28.1") + (version "7.35.0") (source (origin (method url-fetch) (uri (string-append "http://curl.haxx.se/download/curl-" version ".tar.lzma")) (sha256 (base32 - "13bhfs41yf60ys2hrikqxjwfzaj0gm91kqzsgc5fr4grzmpm38nx")) + "14w5cwh6b1426lxkq6kp6h4vxryr4n7wfrrwhny1r4123q7n8ab9")) (patches ;; This patch fixes testcase 172 which uses a hardcoded cookie ;; expiration value which is expired as of Feb 1, 2014. -- cgit v1.2.3 From c0e57fb876b1bc996b3d30648f427dbf23bc99b4 Mon Sep 17 00:00:00 2001 From: Sree Harsha Totakura Date: Tue, 18 Feb 2014 21:45:58 +0100 Subject: gnu: curl: Fix tests. * gnu/packages/curl.scm (curl): Add a new phase and python-2 to native-inputs. Signed-off-by: Andreas Enge --- gnu/packages/curl.scm | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/gnu/packages/curl.scm b/gnu/packages/curl.scm index ea7dbf6e21..7309da61e6 100644 --- a/gnu/packages/curl.scm +++ b/gnu/packages/curl.scm @@ -31,6 +31,7 @@ (define-module (gnu packages curl) #:use-module (gnu packages openldap) #:use-module (gnu packages perl) #:use-module (gnu packages pkg-config) + #:use-module (gnu packages python) #:use-module (gnu packages ssh)) (define-public curl @@ -59,9 +60,18 @@ (define-public curl `(("perl" ,perl) ;; to enable the --manual option and make test 1026 pass ("groff" ,groff) - ("pkg-config" ,pkg-config))) + ("pkg-config" ,pkg-config) + ("python" ,python-2))) (arguments - `(#:configure-flags '("--with-gnutls" "--with-gssapi"))) + `(#:configure-flags '("--with-gnutls" "--with-gssapi") + ;; Add a phase to patch '/bin/sh' occurances in tests/runtests.pl + #:phases + (alist-cons-before + 'check 'patch-runtests + (lambda _ + (substitute* "tests/runtests.pl" + (("/bin/sh") (which "sh")))) + %standard-phases))) (synopsis "curl, command line tool for transferring data with URL syntax") (description "curl is a command line tool for transferring data with URL syntax, -- cgit v1.2.3 From 523e48969bd87d26ebbe0a3f4de27257b6d6cb77 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 18 Feb 2014 23:45:58 +0100 Subject: Add 'guix system'. * guix/scripts/system.scm: New file. * Makefile.am (MODULES): Add it. * po/POTFILES.in: Likewise. * doc/guix.texi (Using the Configuration System): Link to "Invoking guix system". (Invoking guix system): New node. --- Makefile.am | 1 + doc/guix.texi | 43 +++++++++++--- guix/scripts/system.scm | 148 ++++++++++++++++++++++++++++++++++++++++++++++++ po/POTFILES.in | 1 + 4 files changed, 185 insertions(+), 8 deletions(-) create mode 100644 guix/scripts/system.scm diff --git a/Makefile.am b/Makefile.am index 16b28eb181..6ad8eb9914 100644 --- a/Makefile.am +++ b/Makefile.am @@ -77,6 +77,7 @@ MODULES = \ guix/scripts/substitute-binary.scm \ guix/scripts/authenticate.scm \ guix/scripts/refresh.scm \ + guix/scripts/system.scm \ guix.scm \ $(GNU_SYSTEM_MODULES) diff --git a/doc/guix.texi b/doc/guix.texi index af84b75108..e6636dc71f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2547,8 +2547,9 @@ instantiated. Then we show how this mechanism can be extended, for instance to support new system services. @menu -* Using the Configuration System:: Customizing your GNU system. -* Defining Services:: Adding new service definitions. +* Using the Configuration System:: Customizing your GNU system. +* Invoking guix system:: Instantiating a system configuration. +* Defining Services:: Adding new service definitions. @end menu @node Using the Configuration System @@ -2614,13 +2615,12 @@ daemon listening on port 2222, and allowing remote @code{root} logins right command-line options, possibly with supporting configuration files generated as needed (@pxref{Defining Services}). -@c TODO: update when that command exists Assuming the above snippet is stored in the @file{my-system-config.scm} -file, the (yet unwritten!) @command{guix system --boot -my-system-config.scm} command instantiates that configuration, and makes -it the default GRUB boot entry. The normal way to change the system's -configuration is by updating this file and re-running the @command{guix -system} command. +file, the @command{guix system boot my-system-config.scm} command +instantiates that configuration, and makes it the default GRUB boot +entry (@pxref{Invoking guix system}). The normal way to change the +system's configuration is by updating this file and re-running the +@command{guix system} command. At the Scheme level, the bulk of an @code{operating-system} declaration is instantiated with the following monadic procedure (@pxref{The Store @@ -2635,6 +2635,33 @@ the packages, configuration files, and other supporting files needed to instantiate @var{os}. @end deffn +@node Invoking guix system +@subsection Invoking @code{guix system} + +Once you have written an operating system declaration, as seen in the +previous section, it can be @dfn{instantiated} using the @command{guix +system} command. The synopsis is: + +@example +guix system @var{options}@dots{} @var{action} @var{file} +@end example + +@var{file} must be the name of a file containing an +@code{operating-system} declaration. @var{action} specifies how the +operating system is instantiate. Currently only one value is supported: + +@table @code +@item vm +@cindex virtual machine +Build a virtual machine that contain the operating system declared in +@var{file}, and return a script to run that virtual machine (VM). + +The VM shares its store with the host system. +@end table + +@var{options} can contain any of the common build options provided by +@command{guix build} (@pxref{Invoking guix build}). + @node Defining Services @subsection Defining Services diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm new file mode 100644 index 0000000000..5bb14c4383 --- /dev/null +++ b/guix/scripts/system.scm @@ -0,0 +1,148 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (guix scripts system) + #:use-module (guix ui) + #:use-module (guix store) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module (guix utils) + #:use-module (guix monads) + #:use-module (guix scripts build) + #:use-module (gnu system vm) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:export (guix-system)) + +(define %user-module + ;; Module in which the machine description file is loaded. + (let ((module (make-fresh-user-module))) + (for-each (lambda (iface) + (module-use! module (resolve-interface iface))) + '((gnu system) + (gnu system dmd) + (gnu system shadow))) + module)) + +(define (read-operating-system file) + "Read the operating-system declaration from FILE and return it." + ;; TODO: Factorize. + (catch #t + (lambda () + ;; Avoid ABI incompatibility with the record. + (set! %fresh-auto-compile #t) + + (save-module-excursion + (lambda () + (set-current-module %user-module) + (primitive-load file)))) + (lambda args + (match args + (('system-error . _) + (let ((err (system-error-errno args))) + (leave (_ "failed to open operating system file '~a': ~a~%") + file (strerror err)))) + (_ + (leave (_ "failed to load machine file '~a': ~s~%") + file args)))))) + + +;;; +;;; Options. +;;; + +(define (show-help) + (display (_ "Usage: guix system [OPTION] ACTION FILE +Build the operating system declared in FILE according to ACTION.\n")) + (display (_ "Currently the only valid value for ACTION is 'vm', which builds +a virtual machine of the given operating system.\n")) + (show-build-options-help) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specifications of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix system"))) + (option '(#\n "dry-run") #f #f + (lambda (opt name arg result) + (alist-cons 'dry-run? #t result))) + %standard-build-options)) + +(define %default-options + ;; Alist of default option values. + `((system . ,(%current-system)) + (substitutes? . #t) + (build-hook? . #t) + (max-silent-time . 3600) + (verbosity . 0))) + + +;;; +;;; Entry point. +;;; + +(define (guix-system . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (if (assoc-ref result 'action) + (let ((previous (assoc-ref result 'argument))) + (if previous + (leave (_ "~a: extraneous argument~%") previous) + (alist-cons 'argument arg result))) + (let ((action (string->symbol arg))) + (case action + ((vm) (alist-cons 'action action result)) + (else (leave (_ "~a: unknown action~%") + action)))))) + %default-options)) + + (with-error-handling + (let* ((opts (parse-options)) + (file (assoc-ref opts 'argument)) + (os (if file + (read-operating-system file) + (leave (_ "no configuration file specified~%")))) + (mdrv (system-qemu-image/shared-store-script os)) + (store (open-connection)) + (dry? (assoc-ref opts 'dry-run?)) + (drv (run-with-store store mdrv))) + (set-build-options-from-command-line store opts) + (show-what-to-build store (list drv) + #:dry-run? dry? + #:use-substitutes? (assoc-ref opts 'substitutes?)) + + (unless dry? + (build-derivations store (list drv)) + (display (derivation->output-path drv)) + (newline))))) diff --git a/po/POTFILES.in b/po/POTFILES.in index b329f21e92..ef864fe817 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -12,6 +12,7 @@ guix/scripts/hash.scm guix/scripts/pull.scm guix/scripts/substitute-binary.scm guix/scripts/authenticate.scm +guix/scripts/system.scm guix/gnu-maintenance.scm guix/ui.scm guix/http-client.scm -- cgit v1.2.3 From 75475ff7285b0a3fde54b0f8625da82bd8ba4f8e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 18 Feb 2014 23:47:09 +0100 Subject: gnu: qemu: Disable debug info. * gnu/packages/qemu.scm (qemu-headless): Add '--disable-debug-info' as a 'configure' flag. --- gnu/packages/qemu.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/gnu/packages/qemu.scm b/gnu/packages/qemu.scm index 0c90d95129..e0b9e4aeb1 100644 --- a/gnu/packages/qemu.scm +++ b/gnu/packages/qemu.scm @@ -73,6 +73,7 @@ (define-public qemu-headless (zero? (system* "./configure" (string-append "--cc=" (which "gcc")) + "--disable-debug-info" ; save build space (string-append "--prefix=" out) (string-append "--smbd=" samba "/sbin/smbd"))))) -- cgit v1.2.3 From 7fe492e8d956de17ad2af2ed0d1843a745d06e17 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 19 Feb 2014 16:43:25 +0100 Subject: gnu: bigloo: Upgrade to 4.1a. * gnu/packages/scheme.scm (bigloo): Upgrade to 4.1a. --- gnu/packages/patches/bigloo-gc-shebangs.patch | 4 ++-- gnu/packages/scheme.scm | 9 ++++++--- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/gnu/packages/patches/bigloo-gc-shebangs.patch b/gnu/packages/patches/bigloo-gc-shebangs.patch index 9ead2ba979..367708610a 100644 --- a/gnu/packages/patches/bigloo-gc-shebangs.patch +++ b/gnu/packages/patches/bigloo-gc-shebangs.patch @@ -1,7 +1,7 @@ Patch shebangs in source that gets unpacked by `configure'. ---- bigloo4.0b/gc/install-gc-7.3alpha3-20130330 2013-08-19 10:45:20.000000000 +0200 -+++ bigloo4.0b/gc/install-gc-7.3alpha3-20130330 2013-08-19 10:46:36.000000000 +0200 +--- bigloo4.1a/gc/install-gc-7.4.0 2014-02-04 14:55:03.000000000 +0100 ++++ bigloo4.1a/gc/install-gc-7.4.0 2014-02-04 14:55:36.000000000 +0100 @@ -29,10 +29,12 @@ fi # untar the two versions of the GC diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index 4dcd46305d..3d9e3b54dc 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -116,14 +116,14 @@ (define-public mit-scheme (define-public bigloo (package (name "bigloo") - (version "4.0b") + (version "4.1a") (source (origin (method url-fetch) (uri (string-append "ftp://ftp-sop.inria.fr/indes/fp/Bigloo/bigloo" version ".tar.gz")) (sha256 (base32 - "1fck2h48f0bvh8fl437cagmp0syfxy9lqacy1zwsis20fc76jvzi")) + "170q7nh08n4v20xl81fxb0xcdxphqqacfa643hsa8i2ar6pki04c")) (patches (list (search-patch "bigloo-gc-shebangs.patch"))))) (build-system gnu-build-system) (arguments @@ -163,6 +163,9 @@ (define-public bigloo (zero? (system* "./configure" (string-append "--prefix=" out) + ;; FIXME: Currently fails, see + ;; . + ;; "--customgc=no" ; use our libgc (string-append"--mv=" (which "mv")) (string-append "--rm=" (which "rm")))))) (alist-cons-after -- cgit v1.2.3 From db4fdc04cc05495788ee54ae25baf8cd056917dc Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 19 Feb 2014 20:58:24 +0100 Subject: gnu: Introduce the (gnu services ...) modules. * gnu/system/dmd.scm: Remove file. Move contents to... * gnu/services.scm, gnu/services/base.scm, gnu/services/dmd.scm, gnu/services/networking.scm, gnu/services/xorg.scm: ... here. New files. * gnu/system.scm, gnu/system/vm.scm: Adjust accordingly. * guix/scripts/system.scm (%user-module): Likewise. * doc/guix.texi (Using the Configuration System): Likewise. (Defining Services): Likewise. --- doc/guix.texi | 8 +- gnu-system.am | 11 +- gnu/services.scm | 62 ++++++ gnu/services/base.scm | 176 +++++++++++++++++ gnu/services/dmd.scm | 77 ++++++++ gnu/services/networking.scm | 80 ++++++++ gnu/services/xorg.scm | 186 ++++++++++++++++++ gnu/system.scm | 6 +- gnu/system/dmd.scm | 470 -------------------------------------------- gnu/system/vm.scm | 2 +- guix/scripts/system.scm | 2 +- 11 files changed, 600 insertions(+), 480 deletions(-) create mode 100644 gnu/services.scm create mode 100644 gnu/services/base.scm create mode 100644 gnu/services/dmd.scm create mode 100644 gnu/services/networking.scm create mode 100644 gnu/services/xorg.scm delete mode 100644 gnu/system/dmd.scm diff --git a/doc/guix.texi b/doc/guix.texi index e6636dc71f..9a0deeac59 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2562,9 +2562,9 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this: @findex operating-system @lisp -(use-modules (gnu system) +(use-modules (gnu services base) + (gnu services ssh) ; for 'lsh-service' (gnu system shadow) ; for 'user-account' - (gnu system service) ; for 'lsh-service' (gnu packages base) ; Coreutils, grep, etc. (gnu packages bash) ; Bash (gnu packages admin) ; dmd, Inetutils @@ -2603,7 +2603,7 @@ visible on the system, for all user accounts---i.e., in every user's The @code{services} field lists @dfn{system services} to be made available when the system starts. The @var{%standard-services} list, -from the @code{(gnu system)} module, provides the basic services one +from the @code{(gnu services base)} module, provides the basic services one would expect from a GNU system: a login service (mingetty) on each tty, syslogd, libc's name service cache daemon (nscd), etc. @@ -2666,7 +2666,7 @@ The VM shares its store with the host system. @node Defining Services @subsection Defining Services -The @code{(gnu system dmd)} module defines several procedures that allow +The @code{(gnu services @dots{})} modules define several procedures that allow users to declare the operating system's services (@pxref{Using the Configuration System}). These procedures are @emph{monadic procedures}---i.e., procedures that return a monadic value in the store diff --git a/gnu-system.am b/gnu-system.am index d231cfa57b..857c9bf663 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -70,7 +70,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/fonts.scm \ gnu/packages/fontutils.scm \ gnu/packages/freeipmi.scm \ - gnu/packages/games.scm \ + gnu/packages/games.scm \ gnu/packages/gawk.scm \ gnu/packages/gcal.scm \ gnu/packages/gcc.scm \ @@ -210,7 +210,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/vpn.scm \ gnu/packages/w3m.scm \ gnu/packages/wdiff.scm \ - gnu/packages/web.scm \ + gnu/packages/web.scm \ gnu/packages/wget.scm \ gnu/packages/which.scm \ gnu/packages/wordnet.scm \ @@ -223,8 +223,13 @@ GNU_SYSTEM_MODULES = \ gnu/packages/zile.scm \ gnu/packages/zip.scm \ \ + gnu/services.scm \ + gnu/services/base.scm \ + gnu/services/dmd.scm \ + gnu/services/networking.scm \ + gnu/services/xorg.scm \ + \ gnu/system.scm \ - gnu/system/dmd.scm \ gnu/system/grub.scm \ gnu/system/linux.scm \ gnu/system/linux-initrd.scm \ diff --git a/gnu/services.scm b/gnu/services.scm new file mode 100644 index 0000000000..eccde4e9a3 --- /dev/null +++ b/gnu/services.scm @@ -0,0 +1,62 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu services) + #:use-module (guix records) + #:export (service? + service + service-documentation + service-provision + service-requirement + service-respawn? + service-start + service-stop + service-inputs + service-user-accounts + service-user-groups + service-pam-services)) + +;;; Commentary: +;;; +;;; System services as cajoled by dmd. +;;; +;;; Code: + +(define-record-type* + service make-service + service? + (documentation service-documentation ; string + (default "[No documentation.]")) + (provision service-provision) ; list of symbols + (requirement service-requirement ; list of symbols + (default '())) + (respawn? service-respawn? ; Boolean + (default #t)) + (start service-start) ; expression + (stop service-stop ; expression + (default #f)) + (inputs service-inputs ; list of inputs + (default '())) + (user-accounts service-user-accounts ; list of + (default '())) + (user-groups service-user-groups ; list of + (default '())) + (pam-services service-pam-services ; list of + (default '()))) + +;;; services.scm ends here. diff --git a/gnu/services/base.scm b/gnu/services/base.scm new file mode 100644 index 0000000000..3d684a5bec --- /dev/null +++ b/gnu/services/base.scm @@ -0,0 +1,176 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu services base) + #:use-module (gnu services) + #:use-module (gnu system shadow) ; 'user-account', etc. + #:use-module (gnu system linux) ; 'pam-service', etc. + #:use-module (gnu packages admin) + #:use-module ((gnu packages base) + #:select (glibc-final)) + #:use-module (gnu packages package-management) + #:use-module (guix monads) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 format) + #:export (host-name-service + mingetty-service + nscd-service + syslog-service + guix-service)) + +;;; Commentary: +;;; +;;; Base system services---i.e., services that 99% of the users will want to +;;; use. +;;; +;;; Code: + +(define (host-name-service name) + "Return a service that sets the host name to NAME." + (with-monad %store-monad + (return (service + (documentation "Initialize the machine's host name.") + (provision '(host-name)) + (start `(lambda _ + (sethostname ,name))) + (respawn? #f))))) + +(define* (mingetty-service tty + #:key + (motd (text-file "motd" "Welcome.\n")) + (allow-empty-passwords? #t)) + "Return a service to run mingetty on TTY." + (mlet %store-monad ((mingetty-bin (package-file mingetty "sbin/mingetty")) + (motd motd)) + (return + (service + (documentation (string-append "Run mingetty on " tty ".")) + (provision (list (symbol-append 'term- (string->symbol tty)))) + + ;; Since the login prompt shows the host name, wait for the 'host-name' + ;; service to be done. + (requirement '(host-name)) + + (start `(make-forkexec-constructor ,mingetty-bin "--noclear" ,tty)) + (stop `(make-kill-destructor)) + (inputs `(("mingetty" ,mingetty) + ("motd" ,motd))) + + (pam-services + ;; Let 'login' be known to PAM. All the mingetty services will have + ;; that PAM service, but that's fine because they're all identical and + ;; duplicates are removed. + (list (unix-pam-service "login" + #:allow-empty-passwords? allow-empty-passwords? + #:motd motd))))))) + +(define* (nscd-service #:key (glibc glibc-final)) + "Return a service that runs libc's name service cache daemon (nscd)." + (mlet %store-monad ((nscd (package-file glibc "sbin/nscd"))) + (return (service + (documentation "Run libc's name service cache daemon (nscd).") + (provision '(nscd)) + (start `(make-forkexec-constructor ,nscd "-f" "/dev/null" + "--foreground")) + (stop `(make-kill-destructor)) + + (respawn? #f) + (inputs `(("glibc" ,glibc))))))) + +(define (syslog-service) + "Return a service that runs 'syslogd' with reasonable default settings." + + ;; Snippet adapted from the GNU inetutils manual. + (define contents " + # Log all kernel messages, authentication messages of + # level notice or higher and anything of level err or + # higher to the console. + # Don't log private authentication messages! + *.err;kern.*;auth.notice;authpriv.none /dev/console + + # Log anything (except mail) of level info or higher. + # Don't log private authentication messages! + *.info;mail.none;authpriv.none /var/log/messages + + # Same, in a different place. + *.info;mail.none;authpriv.none /dev/tty12 + + # The authpriv file has restricted access. + authpriv.* /var/log/secure + + # Log all the mail messages in one place. + mail.* /var/log/maillog +") + + (mlet %store-monad + ((syslog.conf (text-file "syslog.conf" contents)) + (syslogd (package-file inetutils "libexec/syslogd"))) + (return + (service + (documentation "Run the syslog daemon (syslogd).") + (provision '(syslogd)) + (start `(make-forkexec-constructor ,syslogd "--no-detach" + "--rcfile" ,syslog.conf)) + (stop `(make-kill-destructor)) + (inputs `(("inetutils" ,inetutils) + ("syslog.conf" ,syslog.conf))))))) + +(define* (guix-build-accounts count #:key + (first-uid 30001) + (gid 30000) + (shadow shadow)) + "Return a list of COUNT user accounts for Guix build users, with UIDs +starting at FIRST-UID, and under GID." + (with-monad %store-monad + (return (unfold (cut > <> count) + (lambda (n) + (user-account + (name (format #f "guixbuilder~2,'0d" n)) + (password "!") + (uid (+ first-uid n -1)) + (gid gid) + (comment (format #f "Guix Build User ~2d" n)) + (home-directory "/var/empty") + (shell (package-file shadow "sbin/nologin")) + (inputs `(("shadow" ,shadow))))) + 1+ + 1)))) + +(define* (guix-service #:key (guix guix) (builder-group "guixbuild") + (build-user-gid 30000) (build-accounts 10)) + "Return a service that runs the build daemon from GUIX, and has +BUILD-ACCOUNTS user accounts available under BUILD-USER-GID." + (mlet %store-monad ((daemon (package-file guix "bin/guix-daemon")) + (accounts (guix-build-accounts build-accounts + #:gid build-user-gid))) + (return (service + (provision '(guix-daemon)) + (start `(make-forkexec-constructor ,daemon + "--build-users-group" + ,builder-group)) + (stop `(make-kill-destructor)) + (inputs `(("guix" ,guix))) + (user-accounts accounts) + (user-groups (list (user-group + (name builder-group) + (id build-user-gid) + (members (map user-account-name + user-accounts))))))))) + +;;; base.scm ends here diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm new file mode 100644 index 0000000000..21719118eb --- /dev/null +++ b/gnu/services/dmd.scm @@ -0,0 +1,77 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu services dmd) + #:use-module (guix monads) + #:use-module (gnu services) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (dmd-configuration-file)) + +;;; Commentary: +;;; +;;; Instantiating system services as a dmd configuration file. +;;; +;;; Code: + +(define (dmd-configuration-file services etc) + "Return the dmd configuration file for SERVICES, that initializes /etc from +ETC (the name of a directory in the store) on startup." + (define config + `(begin + (use-modules (ice-9 ftw)) + + (register-services + ,@(map (lambda (service) + `(make + #:docstring ',(service-documentation service) + #:provides ',(service-provision service) + #:requires ',(service-requirement service) + #:respawn? ',(service-respawn? service) + #:start ,(service-start service) + #:stop ,(service-stop service))) + services)) + + ;; /etc is a mixture of static and dynamic settings. Here is where we + ;; initialize it from the static part. + (format #t "populating /etc from ~a...~%" ,etc) + (let ((rm-f (lambda (f) + (false-if-exception (delete-file f))))) + (rm-f "/etc/static") + (symlink ,etc "/etc/static") + (for-each (lambda (file) + ;; TODO: Handle 'shadow' specially so that changed + ;; password aren't lost. + (let ((target (string-append "/etc/" file)) + (source (string-append "/etc/static/" file))) + (rm-f target) + (symlink source target))) + (scandir ,etc + (lambda (file) + (not (member file '("." "..")))))) + + ;; Prevent ETC from being GC'd. + (rm-f "/var/nix/gcroots/etc-directory") + (symlink ,etc "/var/nix/gcroots/etc-directory")) + + (format #t "starting services...~%") + (for-each start ',(append-map service-provision services)))) + + (text-file "dmd.conf" (object->string config))) + +;;; dmd.scm ends here diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm new file mode 100644 index 0000000000..317800db50 --- /dev/null +++ b/gnu/services/networking.scm @@ -0,0 +1,80 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu services networking) + #:use-module (gnu services) + #:use-module (gnu packages admin) + #:use-module (gnu packages linux) + #:use-module (guix monads) + #:export (static-networking-service)) + +;;; Commentary: +;;; +;;; Networking services. +;;; +;;; Code: + +(define* (static-networking-service interface ip + #:key + gateway + (name-servers '()) + (inetutils inetutils) + (net-tools net-tools)) + "Return a service that starts INTERFACE with address IP. If GATEWAY is +true, it must be a string specifying the default network gateway." + + ;; TODO: Eventually we should do this using Guile's networking procedures, + ;; like 'configure-qemu-networking' does, but the patch that does this is + ;; not yet in stock Guile. + (mlet %store-monad ((ifconfig (package-file inetutils "bin/ifconfig")) + (route (package-file net-tools "sbin/route"))) + (return + (service + (documentation + (string-append "Set up networking on the '" interface + "' interface using a static IP address.")) + (provision '(networking)) + (start `(lambda _ + ;; Return #t if successfully started. + (and (zero? (system* ,ifconfig ,interface ,ip "up")) + ,(if gateway + `(zero? (system* ,route "add" "-net" "default" + "gw" ,gateway)) + #t) + ,(if (pair? name-servers) + `(call-with-output-file "/etc/resolv.conf" + (lambda (port) + (display + "# Generated by 'static-networking-service'.\n" + port) + (for-each (lambda (server) + (format port "nameserver ~a~%" + server)) + ',name-servers))) + #t)))) + (stop `(lambda _ + ;; Return #f is successfully stopped. + (not (and (system* ,ifconfig ,interface "down") + (system* ,route "del" "-net" "default"))))) + (respawn? #f) + (inputs `(("inetutils" ,inetutils) + ,@(if gateway + `(("net-tools" ,net-tools)) + '()))))))) + +;;; networking.scm ends here diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm new file mode 100644 index 0000000000..702be27714 --- /dev/null +++ b/gnu/services/xorg.scm @@ -0,0 +1,186 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu services xorg) + #:use-module (gnu services) + #:use-module (gnu system linux) ; 'pam-service' + #:use-module ((gnu packages base) #:select (guile-final)) + #:use-module (gnu packages xorg) + #:use-module (gnu packages gl) + #:use-module (gnu packages slim) + #:use-module (gnu packages ratpoison) + #:use-module (gnu packages admin) + #:use-module (gnu packages bash) + #:use-module (guix monads) + #:use-module (guix derivations) + #:export (xorg-start-command + slim-service)) + +;;; Commentary: +;;; +;;; Services that relate to the X Window System. +;;; +;;; Code: + +(define* (xorg-start-command #:key + (guile guile-final) + (xorg-server xorg-server)) + "Return a derivation that builds a GUILE script to start the X server from +XORG-SERVER. Usually the X server is started by a login manager." + + (define (xserver.conf) + (text-file* "xserver.conf" " +Section \"Files\" + FontPath \"" font-adobe75dpi "/share/font/X11/75dpi\" + ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" + ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" + ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\" + ModulePath \"" xorg-server "/lib/xorg/modules\" + ModulePath \"" xorg-server "/lib/xorg/modules/extensions\" + ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\" +EndSection + +Section \"ServerFlags\" + Option \"AllowMouseOpenFail\" \"on"" +EndSection + +Section \"Monitor\" + Identifier \"Monitor[0]\" +EndSection + +Section \"InputClass\" + Identifier \"Generic keyboard\" + MatchIsKeyboard \"on\" + Option \"XkbRules\" \"base\" + Option \"XkbModel\" \"pc104\" +EndSection + +Section \"ServerLayout\" + Identifier \"Layout\" + Screen \"Screen-vesa\" +EndSection + +Section \"Device\" + Identifier \"Device-vesa\" + Driver \"vesa\" +EndSection + +Section \"Screen\" + Identifier \"Screen-vesa\" + Device \"Device-vesa\" +EndSection")) + + (mlet %store-monad ((guile-bin (package-file guile "bin/guile")) + (xorg-bin (package-file xorg-server "bin/X")) + (dri (package-file mesa "lib/dri")) + (xkbcomp-bin (package-file xkbcomp "bin")) + (xkb-dir (package-file xkeyboard-config + "share/X11/xkb")) + (config (xserver.conf))) + (define builder + ;; Write a small wrapper around the X server. + `(let ((out (assoc-ref %outputs "out"))) + (call-with-output-file out + (lambda (port) + (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin) + (write '(begin + (setenv "XORG_DRI_DRIVER_PATH" ,dri) + (setenv "XKB_BINDIR" ,xkbcomp-bin) + + (apply execl + + ,xorg-bin "-ac" "-logverbose" "-verbose" + "-xkbdir" ,xkb-dir + "-config" ,(derivation->output-path config) + "-nolisten" "tcp" "-terminate" + + ;; Note: SLiM and other display managers add the + ;; '-auth' flag by themselves. + (cdr (command-line)))) + port))) + (chmod out #o555) + #t)) + + (mlet %store-monad ((inputs (lower-inputs + `(("xorg" ,xorg-server) + ("xkbcomp" ,xkbcomp) + ("xkeyboard-config" ,xkeyboard-config) + ("mesa" ,mesa) + ("guile" ,guile) + ("xorg.conf" ,config))))) + (derivation-expression "start-xorg" builder + #:inputs inputs)))) + +(define* (slim-service #:key (slim slim) + (allow-empty-passwords? #t) auto-login? + (default-user "") + (xauth xauth) (dmd dmd) (bash bash) + startx) + "Return a service that spawns the SLiM graphical login manager, which in +turn start the X display server with STARTX, a command as returned by +'xorg-start-command'. + +When ALLOW-EMPTY-PASSWORDS? is true, allow logins with an empty password. +When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER." + (define (slim.cfg) + ;; TODO: Run "bash -login ~/.xinitrc %session". + (mlet %store-monad ((startx (or startx (xorg-start-command)))) + (text-file* "slim.cfg" " +default_path /run/current-system/bin +default_xserver " startx " +xserver_arguments :0 vt7 +xauth_path " xauth "/bin/xauth +authfile /var/run/slim.auth + +# The login command. '%session' is replaced by the chosen session name, one +# of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc. +login_cmd exec " ratpoison "/bin/ratpoison + +halt_cmd " dmd "/sbin/halt +reboot_cmd " dmd "/sbin/reboot +" (if auto-login? + (string-append "auto_login yes\ndefault_user " default-user) + "")))) + + (mlet %store-monad ((slim-bin (package-file slim "bin/slim")) + (bash-bin (package-file bash "bin/bash")) + (slim.cfg (slim.cfg))) + (return + (service + (documentation "Xorg display server") + (provision '(xorg-server)) + (requirement '(host-name)) + (start + ;; XXX: Work around the inability to specify env. vars. directly. + `(make-forkexec-constructor + ,bash-bin "-c" + ,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg) + " " slim-bin + " -nodaemon"))) + (stop `(make-kill-destructor)) + (inputs `(("slim" ,slim) + ("slim.cfg" ,slim.cfg) + ("bash" ,bash))) + (respawn? #t) + (pam-services + ;; Tell PAM about 'slim'. + (list (unix-pam-service + "slim" + #:allow-empty-passwords? allow-empty-passwords?))))))) + +;;; xorg.scm ends here diff --git a/gnu/system.scm b/gnu/system.scm index 6918d5bcb8..f05b7a092a 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -26,7 +26,11 @@ (define-module (gnu system) #:use-module (gnu packages bash) #:use-module (gnu packages admin) #:use-module (gnu packages package-management) - #:use-module (gnu system dmd) + #:use-module (gnu services) + #:use-module (gnu services dmd) + #:use-module (gnu services base) + #:use-module ((gnu services networking) + #:select (static-networking-service)) #:use-module (gnu system grub) #:use-module (gnu system shadow) #:use-module (gnu system linux) diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm deleted file mode 100644 index c1ddec88d6..0000000000 --- a/gnu/system/dmd.scm +++ /dev/null @@ -1,470 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès -;;; -;;; 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 . - -(define-module (gnu system dmd) - #:use-module (guix store) - #:use-module (guix packages) - #:use-module (guix derivations) - #:use-module (guix records) - #:use-module ((gnu packages base) - #:select (glibc-final guile-final)) - #:use-module ((gnu packages admin) - #:select (dmd mingetty inetutils shadow)) - #:use-module ((gnu packages package-management) - #:select (guix)) - #:use-module ((gnu packages linux) - #:select (net-tools)) - #:use-module (gnu packages xorg) - #:use-module (gnu packages bash) - #:use-module (gnu packages gl) - #:use-module (gnu packages slim) - #:use-module (gnu packages ratpoison) - - #:use-module (gnu system shadow) ; for user accounts/groups - #:use-module (gnu system linux) ; for PAM services - #:use-module (ice-9 match) - #:use-module (ice-9 format) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:use-module (guix monads) - #:export (service? - service - service-provision - service-requirement - service-respawn? - service-start - service-stop - service-inputs - service-user-accounts - service-user-groups - service-pam-services - - host-name-service - syslog-service - mingetty-service - nscd-service - guix-service - static-networking-service - xorg-start-command - slim-service - - dmd-configuration-file)) - -;;; Commentary: -;;; -;;; System services as cajoled by dmd. -;;; -;;; Code: - -(define-record-type* - service make-service - service? - (documentation service-documentation ; string - (default "[No documentation.]")) - (provision service-provision) ; list of symbols - (requirement service-requirement ; list of symbols - (default '())) - (respawn? service-respawn? ; Boolean - (default #t)) - (start service-start) ; expression - (stop service-stop ; expression - (default #f)) - (inputs service-inputs ; list of inputs - (default '())) - (user-accounts service-user-accounts ; list of - (default '())) - (user-groups service-user-groups ; list of - (default '())) - (pam-services service-pam-services ; list of - (default '()))) - -(define (host-name-service name) - "Return a service that sets the host name to NAME." - (with-monad %store-monad - (return (service - (documentation "Initialize the machine's host name.") - (provision '(host-name)) - (start `(lambda _ - (sethostname ,name))) - (respawn? #f))))) - -(define* (mingetty-service tty - #:key - (motd (text-file "motd" "Welcome.\n")) - (allow-empty-passwords? #t)) - "Return a service to run mingetty on TTY." - (mlet %store-monad ((mingetty-bin (package-file mingetty "sbin/mingetty")) - (motd motd)) - (return - (service - (documentation (string-append "Run mingetty on " tty ".")) - (provision (list (symbol-append 'term- (string->symbol tty)))) - - ;; Since the login prompt shows the host name, wait for the 'host-name' - ;; service to be done. - (requirement '(host-name)) - - (start `(make-forkexec-constructor ,mingetty-bin "--noclear" ,tty)) - (stop `(make-kill-destructor)) - (inputs `(("mingetty" ,mingetty) - ("motd" ,motd))) - - (pam-services - ;; Let 'login' be known to PAM. All the mingetty services will have - ;; that PAM service, but that's fine because they're all identical and - ;; duplicates are removed. - (list (unix-pam-service "login" - #:allow-empty-passwords? allow-empty-passwords? - #:motd motd))))))) - -(define* (nscd-service #:key (glibc glibc-final)) - "Return a service that runs libc's name service cache daemon (nscd)." - (mlet %store-monad ((nscd (package-file glibc "sbin/nscd"))) - (return (service - (documentation "Run libc's name service cache daemon (nscd).") - (provision '(nscd)) - (start `(make-forkexec-constructor ,nscd "-f" "/dev/null" - "--foreground")) - (stop `(make-kill-destructor)) - - (respawn? #f) - (inputs `(("glibc" ,glibc))))))) - -(define (syslog-service) - "Return a service that runs 'syslogd' with reasonable default settings." - - ;; Snippet adapted from the GNU inetutils manual. - (define contents " - # Log all kernel messages, authentication messages of - # level notice or higher and anything of level err or - # higher to the console. - # Don't log private authentication messages! - *.err;kern.*;auth.notice;authpriv.none /dev/console - - # Log anything (except mail) of level info or higher. - # Don't log private authentication messages! - *.info;mail.none;authpriv.none /var/log/messages - - # Same, in a different place. - *.info;mail.none;authpriv.none /dev/tty12 - - # The authpriv file has restricted access. - authpriv.* /var/log/secure - - # Log all the mail messages in one place. - mail.* /var/log/maillog -") - - (mlet %store-monad - ((syslog.conf (text-file "syslog.conf" contents)) - (syslogd (package-file inetutils "libexec/syslogd"))) - (return - (service - (documentation "Run the syslog daemon (syslogd).") - (provision '(syslogd)) - (start `(make-forkexec-constructor ,syslogd "--no-detach" - "--rcfile" ,syslog.conf)) - (stop `(make-kill-destructor)) - (inputs `(("inetutils" ,inetutils) - ("syslog.conf" ,syslog.conf))))))) - -(define* (guix-build-accounts count #:key - (first-uid 30001) - (gid 30000) - (shadow shadow)) - "Return a list of COUNT user accounts for Guix build users, with UIDs -starting at FIRST-UID, and under GID." - (with-monad %store-monad - (return (unfold (cut > <> count) - (lambda (n) - (user-account - (name (format #f "guixbuilder~2,'0d" n)) - (password "!") - (uid (+ first-uid n -1)) - (gid gid) - (comment (format #f "Guix Build User ~2d" n)) - (home-directory "/var/empty") - (shell (package-file shadow "sbin/nologin")) - (inputs `(("shadow" ,shadow))))) - 1+ - 1)))) - -(define* (guix-service #:key (guix guix) (builder-group "guixbuild") - (build-user-gid 30000) (build-accounts 10)) - "Return a service that runs the build daemon from GUIX, and has -BUILD-ACCOUNTS user accounts available under BUILD-USER-GID." - (mlet %store-monad ((daemon (package-file guix "bin/guix-daemon")) - (accounts (guix-build-accounts build-accounts - #:gid build-user-gid))) - (return (service - (provision '(guix-daemon)) - (start `(make-forkexec-constructor ,daemon - "--build-users-group" - ,builder-group)) - (stop `(make-kill-destructor)) - (inputs `(("guix" ,guix))) - (user-accounts accounts) - (user-groups (list (user-group - (name builder-group) - (id build-user-gid) - (members (map user-account-name - user-accounts))))))))) - -(define* (static-networking-service interface ip - #:key - gateway - (name-servers '()) - (inetutils inetutils) - (net-tools net-tools)) - "Return a service that starts INTERFACE with address IP. If GATEWAY is -true, it must be a string specifying the default network gateway." - - ;; TODO: Eventually we should do this using Guile's networking procedures, - ;; like 'configure-qemu-networking' does, but the patch that does this is - ;; not yet in stock Guile. - (mlet %store-monad ((ifconfig (package-file inetutils "bin/ifconfig")) - (route (package-file net-tools "sbin/route"))) - (return - (service - (documentation - (string-append "Set up networking on the '" interface - "' interface using a static IP address.")) - (provision '(networking)) - (start `(lambda _ - ;; Return #t if successfully started. - (and (zero? (system* ,ifconfig ,interface ,ip "up")) - ,(if gateway - `(zero? (system* ,route "add" "-net" "default" - "gw" ,gateway)) - #t) - ,(if (pair? name-servers) - `(call-with-output-file "/etc/resolv.conf" - (lambda (port) - (display - "# Generated by 'static-networking-service'.\n" - port) - (for-each (lambda (server) - (format port "nameserver ~a~%" - server)) - ',name-servers))) - #t)))) - (stop `(lambda _ - ;; Return #f is successfully stopped. - (not (and (system* ,ifconfig ,interface "down") - (system* ,route "del" "-net" "default"))))) - (respawn? #f) - (inputs `(("inetutils" ,inetutils) - ,@(if gateway - `(("net-tools" ,net-tools)) - '()))))))) - -(define* (xorg-start-command #:key - (guile guile-final) - (xorg-server xorg-server)) - "Return a derivation that builds a GUILE script to start the X server from -XORG-SERVER. Usually the X server is started by a login manager." - - (define (xserver.conf) - (text-file* "xserver.conf" " -Section \"Files\" - FontPath \"" font-adobe75dpi "/share/font/X11/75dpi\" - ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" - ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" - ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\" - ModulePath \"" xorg-server "/lib/xorg/modules\" - ModulePath \"" xorg-server "/lib/xorg/modules/extensions\" - ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\" -EndSection - -Section \"ServerFlags\" - Option \"AllowMouseOpenFail\" \"on"" -EndSection - -Section \"Monitor\" - Identifier \"Monitor[0]\" -EndSection - -Section \"InputClass\" - Identifier \"Generic keyboard\" - MatchIsKeyboard \"on\" - Option \"XkbRules\" \"base\" - Option \"XkbModel\" \"pc104\" -EndSection - -Section \"ServerLayout\" - Identifier \"Layout\" - Screen \"Screen-vesa\" -EndSection - -Section \"Device\" - Identifier \"Device-vesa\" - Driver \"vesa\" -EndSection - -Section \"Screen\" - Identifier \"Screen-vesa\" - Device \"Device-vesa\" -EndSection")) - - (mlet %store-monad ((guile-bin (package-file guile "bin/guile")) - (xorg-bin (package-file xorg-server "bin/X")) - (dri (package-file mesa "lib/dri")) - (xkbcomp-bin (package-file xkbcomp "bin")) - (xkb-dir (package-file xkeyboard-config - "share/X11/xkb")) - (config (xserver.conf))) - (define builder - ;; Write a small wrapper around the X server. - `(let ((out (assoc-ref %outputs "out"))) - (call-with-output-file out - (lambda (port) - (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin) - (write '(begin - (setenv "XORG_DRI_DRIVER_PATH" ,dri) - (setenv "XKB_BINDIR" ,xkbcomp-bin) - - (apply execl - - ,xorg-bin "-ac" "-logverbose" "-verbose" - "-xkbdir" ,xkb-dir - "-config" ,(derivation->output-path config) - "-nolisten" "tcp" "-terminate" - - ;; Note: SLiM and other display managers add the - ;; '-auth' flag by themselves. - (cdr (command-line)))) - port))) - (chmod out #o555) - #t)) - - (mlet %store-monad ((inputs (lower-inputs - `(("xorg" ,xorg-server) - ("xkbcomp" ,xkbcomp) - ("xkeyboard-config" ,xkeyboard-config) - ("mesa" ,mesa) - ("guile" ,guile) - ("xorg.conf" ,config))))) - (derivation-expression "start-xorg" builder - #:inputs inputs)))) - -(define* (slim-service #:key (slim slim) - (allow-empty-passwords? #t) auto-login? - (default-user "") - (xauth xauth) (dmd dmd) (bash bash) - startx) - "Return a service that spawns the SLiM graphical login manager, which in -turn start the X display server with STARTX, a command as returned by -'xorg-start-command'. - -When ALLOW-EMPTY-PASSWORDS? is true, allow logins with an empty password. -When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER." - (define (slim.cfg) - ;; TODO: Run "bash -login ~/.xinitrc %session". - (mlet %store-monad ((startx (or startx (xorg-start-command)))) - (text-file* "slim.cfg" " -default_path /run/current-system/bin -default_xserver " startx " -xserver_arguments :0 vt7 -xauth_path " xauth "/bin/xauth -authfile /var/run/slim.auth - -# The login command. '%session' is replaced by the chosen session name, one -# of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc. -login_cmd exec " ratpoison "/bin/ratpoison - -halt_cmd " dmd "/sbin/halt -reboot_cmd " dmd "/sbin/reboot -" (if auto-login? - (string-append "auto_login yes\ndefault_user " default-user) - "")))) - - (mlet %store-monad ((slim-bin (package-file slim "bin/slim")) - (bash-bin (package-file bash "bin/bash")) - (slim.cfg (slim.cfg))) - (return - (service - (documentation "Xorg display server") - (provision '(xorg-server)) - (requirement '(host-name)) - (start - ;; XXX: Work around the inability to specify env. vars. directly. - `(make-forkexec-constructor - ,bash-bin "-c" - ,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg) - " " slim-bin - " -nodaemon"))) - (stop `(make-kill-destructor)) - (inputs `(("slim" ,slim) - ("slim.cfg" ,slim.cfg) - ("bash" ,bash))) - (respawn? #t) - (pam-services - ;; Tell PAM about 'slim'. - (list (unix-pam-service - "slim" - #:allow-empty-passwords? allow-empty-passwords?))))))) - - -(define (dmd-configuration-file services etc) - "Return the dmd configuration file for SERVICES, that initializes /etc from -ETC on startup." - (define config - `(begin - (use-modules (ice-9 ftw)) - - (register-services - ,@(map (match-lambda - (($ documentation provision requirement - respawn? start stop) - `(make - #:docstring ,documentation - #:provides ',provision - #:requires ',requirement - #:respawn? ,respawn? - #:start ,start - #:stop ,stop))) - services)) - - ;; /etc is a mixture of static and dynamic settings. Here is where we - ;; initialize it from the static part. - (format #t "populating /etc from ~a...~%" ,etc) - (let ((rm-f (lambda (f) - (false-if-exception (delete-file f))))) - (rm-f "/etc/static") - (symlink ,etc "/etc/static") - (for-each (lambda (file) - ;; TODO: Handle 'shadow' specially so that changed - ;; password aren't lost. - (let ((target (string-append "/etc/" file)) - (source (string-append "/etc/static/" file))) - (rm-f target) - (symlink source target))) - (scandir ,etc - (lambda (file) - (not (member file '("." "..")))))) - - ;; Prevent ETC from being GC'd. - (rm-f "/var/nix/gcroots/etc-directory") - (symlink ,etc "/var/nix/gcroots/etc-directory")) - - (format #t "starting services...~%") - (for-each start ',(append-map service-provision services)))) - - (text-file "dmd.conf" (object->string config))) - -;;; dmd.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index dea7d0599b..3c0ea8a351 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -44,8 +44,8 @@ (define-module (gnu system vm) #:use-module (gnu system linux) #:use-module (gnu system linux-initrd) #:use-module (gnu system grub) - #:use-module (gnu system dmd) #:use-module (gnu system) + #:use-module (gnu services) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 5bb14c4383..7799ccbc47 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -36,7 +36,7 @@ (define %user-module (for-each (lambda (iface) (module-use! module (resolve-interface iface))) '((gnu system) - (gnu system dmd) + (gnu services) (gnu system shadow))) module)) -- cgit v1.2.3 From 8b198abecde8c846eaa464ac1b41cbc18556b5e8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 19 Feb 2014 21:08:28 +0100 Subject: gnu: Define '%base-services'. * gnu/services/base.scm (%base-services): New variable. * gnu/system.scm ()[services]: Change the default value to %BASE-SERVICES. * doc/guix.texi (Using the Configuration System): Change '%standard-services' to '%base-services'. --- doc/guix.texi | 7 ++++--- gnu/services/base.scm | 17 ++++++++++++++++- gnu/system.scm | 20 +------------------- 3 files changed, 21 insertions(+), 23 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 9a0deeac59..34f6810f34 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2562,7 +2562,7 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this: @findex operating-system @lisp -(use-modules (gnu services base) +(use-modules (gnu services base) ; for '%base-services' (gnu services ssh) ; for 'lsh-service' (gnu system shadow) ; for 'user-account' (gnu packages base) ; Coreutils, grep, etc. @@ -2591,7 +2591,7 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this: procps psmisc zile less)) (services (cons (lsh-service #:port 2222 #:allow-root-login? #t) - %standard-services)))) + %base-services)))) @end lisp This example should be self-describing. The @code{packages} field lists @@ -2601,8 +2601,9 @@ visible on the system, for all user accounts---i.e., in every user's @code{PATH} environment variable---in addition to the per-user profiles (@pxref{Invoking guix package}). +@vindex %base-services The @code{services} field lists @dfn{system services} to be made -available when the system starts. The @var{%standard-services} list, +available when the system starts. The @var{%base-services} list, from the @code{(gnu services base)} module, provides the basic services one would expect from a GNU system: a login service (mingetty) on each tty, syslogd, libc's name service cache daemon (nscd), etc. diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 3d684a5bec..d6c1707c6a 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -32,7 +32,8 @@ (define-module (gnu services base) mingetty-service nscd-service syslog-service - guix-service)) + guix-service + %base-services)) ;;; Commentary: ;;; @@ -173,4 +174,18 @@ (define* (guix-service #:key (guix guix) (builder-group "guixbuild") (members (map user-account-name user-accounts))))))))) +(define %base-services + ;; Convenience variable holding the basic services. + (let ((motd (text-file "motd" " +This is the GNU operating system, welcome!\n\n"))) + (list (mingetty-service "tty1" #:motd motd) + (mingetty-service "tty2" #:motd motd) + (mingetty-service "tty3" #:motd motd) + (mingetty-service "tty4" #:motd motd) + (mingetty-service "tty5" #:motd motd) + (mingetty-service "tty6" #:motd motd) + (syslog-service) + (guix-service) + (nscd-service)))) + ;;; base.scm ends here diff --git a/gnu/system.scm b/gnu/system.scm index f05b7a092a..e6346106a2 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -29,8 +29,6 @@ (define-module (gnu system) #:use-module (gnu services) #:use-module (gnu services dmd) #:use-module (gnu services base) - #:use-module ((gnu services networking) - #:select (static-networking-service)) #:use-module (gnu system grub) #:use-module (gnu system shadow) #:use-module (gnu system linux) @@ -107,23 +105,7 @@ (define-record-type* operating-system (locale operating-system-locale) ; string (services operating-system-services ; list of monadic services - (default - (let ((motd (text-file "motd" " -This is the GNU operating system, welcome!\n\n"))) - (list (mingetty-service "tty1" #:motd motd) - (mingetty-service "tty2" #:motd motd) - (mingetty-service "tty3" #:motd motd) - (mingetty-service "tty4" #:motd motd) - (mingetty-service "tty5" #:motd motd) - (mingetty-service "tty6" #:motd motd) - (syslog-service) - (guix-service) - (nscd-service) - - ;; QEMU networking settings. - (static-networking-service "eth0" "10.0.2.10" - #:name-servers '("10.0.2.3") - #:gateway "10.0.2.2")))))) + (default %base-services))) -- cgit v1.2.3 From 0b14d1d7e36eb9b4fa38898d2a1e7e414cbbe735 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 19 Feb 2014 21:10:12 +0100 Subject: gnu: vm: Remove '%demo-operating-system'. * gnu/system/vm.scm (%demo-operating-system): Remove. (system-qemu-image, system-qemu-image/shared-store, system-qemu-image/shared-store-script): Adjust accordingly. --- gnu/system/vm.scm | 36 +++--------------------------------- 1 file changed, 3 insertions(+), 33 deletions(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 3c0ea8a351..b8b0274f1f 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -414,36 +414,6 @@ (define (graph-from-file file) ;;; Stand-alone VM image. ;;; -(define %demo-operating-system - (operating-system - (host-name "gnu") - (timezone "Europe/Paris") - (locale "en_US.UTF-8") - (users (list (user-account - (name "guest") - (password "") - (uid 1000) (gid 100) - (comment "Guest of GNU") - (home-directory "/home/guest")))) - (packages (list coreutils - bash - guile-2.0 - dmd - gcc-final - ld-wrapper ; must come before BINUTILS - binutils-final - glibc-final - inetutils - findutils - grep - sed - procps - psmisc - zile - less - tzdata - guix)))) - (define (operating-system-build-gid os) "Return as a monadic value the group id for build users of OS, or #f." (anym %store-monad @@ -489,7 +459,7 @@ (define (user-directories user) ,@(append-map user-directories (operating-system-users os)))))) -(define* (system-qemu-image #:optional (os %demo-operating-system) +(define* (system-qemu-image os #:key (disk-image-size (* 900 (expt 2 20)))) "Return the derivation of a QEMU image of DISK-IMAGE-SIZE bytes of the GNU system as described by OS." @@ -505,7 +475,7 @@ (define* (system-qemu-image #:optional (os %demo-operating-system) #:inputs-to-copy `(("system" ,os-drv))))) (define* (system-qemu-image/shared-store - #:optional (os %demo-operating-system) + os #:key (disk-image-size (* 15 (expt 2 20)))) "Return a derivation that builds a QEMU image of OS that shares its store with the host." @@ -520,7 +490,7 @@ (define* (system-qemu-image/shared-store #:disk-image-size disk-image-size))) (define* (system-qemu-image/shared-store-script - #:optional (os %demo-operating-system) + os #:key (qemu (package (inherit qemu) ;; FIXME/TODO: Use 9p instead of this hack. -- cgit v1.2.3 From 9038298cbf645cc85ab85e5fe47cab9737a15c50 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 19 Feb 2014 21:30:16 +0100 Subject: gnu: Add /etc/shells. * gnu/system.scm (etc-directory): Add /etc/shells. --- gnu/system.scm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/gnu/system.scm b/gnu/system.scm index e6346106a2..d28738140f 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -227,6 +227,11 @@ (define* (etc-directory #:key (group (group-file groups)) (pam.d (pam-services->directory pam-services)) (login.defs (text-file "login.defs" "# Empty for now.\n")) + (shells (text-file "shells" ; used by xterm and others + "\ +/bin/sh +/run/current-system/bin/sh +/run/current-system/bin/bash\n")) (issue (text-file "issue" " This is an alpha preview of the GNU system. Welcome. @@ -260,6 +265,7 @@ (define* (etc-directory #:key ("pam.d" ,(derivation->output-path pam.d)) ("login.defs" ,login.defs) ("issue" ,issue) + ("shells" ,shells) ("profile" ,(derivation->output-path bashrc)) ("localtime" ,tz-file) ("passwd" ,passwd) -- cgit v1.2.3 From a438d540b11f380d9dc69ccebeb1d444311b488c Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Wed, 19 Feb 2014 16:02:32 -0600 Subject: gnu: calcurse: New module MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/calcurse.scm: New file * gnu-system.am (GNU_SYSTEM_MODULES): Add it Signed-off-by: Ludovic Courtès --- gnu-system.am | 1 + gnu/packages/calcurse.scm | 49 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 50 insertions(+) create mode 100644 gnu/packages/calcurse.scm diff --git a/gnu-system.am b/gnu-system.am index 857c9bf663..897cc443a1 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -42,6 +42,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/bison.scm \ gnu/packages/boost.scm \ gnu/packages/bootstrap.scm \ + gnu/packages/calcurse.scm \ gnu/packages/cdrom.scm \ gnu/packages/cflow.scm \ gnu/packages/check.scm \ diff --git a/gnu/packages/calcurse.scm b/gnu/packages/calcurse.scm new file mode 100644 index 0000000000..84dab0c53c --- /dev/null +++ b/gnu/packages/calcurse.scm @@ -0,0 +1,49 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Eric Bavier +;;; +;;; 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 . + +(define-module (gnu packages autogen) + #:use-module (guix packages) + #:use-module (guix licenses) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages) + #:use-module (gnu packages ncurses)) + +(define-public calcurse + (package + (name "calcurse") + (version "3.1.4") + (source + (origin + (method url-fetch) + (uri (string-append "http://calcurse.org/files/calcurse-" + version ".tar.gz")) + (sha256 + (base32 + "1qwhffwhfg7bjxrviwlcrhnfw0976d39da8kfspq6dgd9nqv68a1")))) + (build-system gnu-build-system) + (inputs `(("ncurses" ,ncurses))) + (home-page "http://www.calcurse.org") + (synopsis "Text-based calendar and scheduling") + (description + "Calcurse is a text-based calendar and scheduling application. It helps +keep track of events, appointments and everyday tasks. A configurable +notification system reminds user of upcoming deadlines, and the curses based +interface can be customized to suit user needs. All of the commands are +documented within an online help system.") + (license bsd-2))) -- cgit v1.2.3 From 6ee5a658f7bbce1107be1fed6a0dfcd89f402c55 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 18 Feb 2014 10:34:04 -0500 Subject: gnu: shishi: Add more inputs for libidn and PAM support. * gnu/packages/shishi.scm (shishi): Add 'pkg-config' native-input. Add 'libidn' and 'linux-pam' inputs. --- gnu/packages/shishi.scm | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/gnu/packages/shishi.scm b/gnu/packages/shishi.scm index 0523a4eef5..47e7802213 100644 --- a/gnu/packages/shishi.scm +++ b/gnu/packages/shishi.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Nikita Karetnikov ;;; Copyright © 2012 Ludovic Courtès +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,6 +23,9 @@ (define-module (gnu packages shishi) #:use-module (gnu packages) #:use-module (gnu packages gnutls) #:use-module (gnu packages gnupg) + #:use-module (gnu packages libidn) + #:use-module (gnu packages linux) + #:use-module (gnu packages pkg-config) #:use-module (gnu packages compression) #:use-module (guix packages) #:use-module (guix download) @@ -40,8 +44,11 @@ (define-public shishi (base32 "032qf72cpjdfffq1yq54gz3ahgqf2ijca4vl31sfabmjzq9q370d")))) (build-system gnu-build-system) + (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("gnutls" ,gnutls) + ("libidn" ,libidn) + ("linux-pam" ,linux-pam) ("zlib" ,zlib) ;; libgcrypt 1.6 fails because of the following test: ;; #include -- cgit v1.2.3 From 68640c3c09c6c9ddcaae8d50754f0876b273d42a Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 19 Feb 2014 19:20:53 -0500 Subject: gnu: gpgme: Make 'libgpg-error' a propagated input. * gnu/packages/gnupg.scm (gpgme): Make 'libgpg-error' a propagated input. --- gnu/packages/gnupg.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index 499b20097f..85ce0767b7 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -226,10 +226,12 @@ (define-public gpgme (base32 "15h429h6pd67iiv580bjmwbkadpxsdppw0xrqpcm4dvm24jc271d")))) (build-system gnu-build-system) + (propagated-inputs + ;; Needs to be propagated because gpgme.h includes gpg-error.h. + `(("libgpg-error" ,libgpg-error))) (inputs `(("gnupg" ,gnupg) - ("libassuan" ,libassuan) - ("libgpg-error" ,libgpg-error))) + ("libassuan" ,libassuan))) (home-page "http://www.gnupg.org/related_software/gpgme/") (synopsis "library providing simplified access to GnuPG functionality") (description -- cgit v1.2.3 From 681a6588b20eeb665e5cc620a158726f68ea2fdd Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 18 Feb 2014 23:08:04 -0500 Subject: gnu: Add gmime. * gnu/packages/mail.scm (gmime): New variable. --- gnu/packages/mail.scm | 54 +++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 52 insertions(+), 2 deletions(-) diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index bdb3d52070..8d67629c6b 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,11 +34,15 @@ (define-module (gnu packages mail) #:use-module (gnu packages perl) #:use-module (gnu packages readline) #:use-module (gnu packages texinfo) + #:use-module (gnu packages compression) + #:use-module (gnu packages glib) + #:use-module (gnu packages pkg-config) #:use-module ((guix licenses) - #:select (gpl2+ gpl3+ lgpl3+)) + #:select (gpl2+ gpl3+ lgpl2.1+ lgpl3+)) #:use-module (guix packages) #:use-module (guix download) - #:use-module (guix build-system gnu)) + #:use-module (guix build-system gnu) + #:use-module (srfi srfi-1)) (define-public mailutils (package @@ -162,3 +167,48 @@ (define-public mutt "Mutt is a small but very powerful text-based mail client for Unix operating systems.") (license gpl2+))) + +(define-public gmime + (package + (name "gmime") + (version "2.6.19") + (source (origin + (method url-fetch) + (uri (string-append "http://download.gnome.org/sources/gmime/" + (string-join (take (string-split version #\.) + 2) + ".") + "/gmime-" version ".tar.xz")) + (sha256 + (base32 + "0jm1fgbjgh496rsc0il2y46qd4bqq2ln9168p4zzh68mk4ml1yxg")))) + (build-system gnu-build-system) + (native-inputs + `(("pkg-config" ,pkg-config) + ("gnupg" ,gnupg))) ; for tests only + (inputs `(("glib" ,glib) + ("gpgme" ,gpgme) + ("zlib" ,zlib))) + (arguments + `(#:phases + (alist-cons-after + 'unpack 'patch-paths-in-tests + (lambda _ + ;; The test programs run several programs using 'system' + ;; with hard-coded paths. Here we patch them all. We also + ;; change "gpg" to "gpg2". + (substitute* (find-files "tests" "\\.c$") + (("(system *\\(\")(/[^ ]*)" all pre prog-path) + (let* ((base (basename prog-path)) + (prog (which (if (string=? base "gpg") "gpg2" base)))) + (string-append pre (or prog (error "not found: " base))))))) + %standard-phases))) + (home-page "http://spruce.sourceforge.net/gmime/") + (synopsis "MIME message parser and creator library") + (description + "GMime provides a core library and set of utilities which may be used for +the creation and parsing of messages using the Multipurpose Internet Mail +Extension (MIME).") + (license (list lgpl2.1+ gpl2+ gpl3+)))) + +;;; mail.scm ends here -- cgit v1.2.3 From 62d4575de2871cbd97157a12fcbcce63a460d93b Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 19 Feb 2014 02:06:13 -0500 Subject: gnu: tor: Upgrade to 0.2.4.20. * gnu/packages/tor.scm (tor): Upgrade to 0.2.4.20. --- gnu/packages/tor.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/tor.scm b/gnu/packages/tor.scm index adcd11f40e..772b2a3c17 100644 --- a/gnu/packages/tor.scm +++ b/gnu/packages/tor.scm @@ -31,14 +31,14 @@ (define-module (gnu packages tor) (define-public tor (package (name "tor") - (version "0.2.4.19") + (version "0.2.4.20") (source (origin (method url-fetch) (uri (string-append "https://www.torproject.org/dist/tor-" version ".tar.gz")) (sha256 (base32 - "08g1g6wkvg1a5hpjbjzr31sabqp65h9hrkjar4lif5pmqdw898jk")))) + "17sd54pfz1w2x5bd0j83vac8d1lazy9wdm9liijqzyfbrd3igifc")))) (build-system gnu-build-system) (inputs `(("zlib" ,zlib) -- cgit v1.2.3 From c6d37be9511f6f10b766541977311341a9115ee9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 20 Feb 2014 12:25:14 +0100 Subject: guix hash: Don't load the whole file in memory. * guix/scripts/hash.scm (guix-hash)[eof->null]: Remove. (guix-hash): Use 'port-sha256' to compute the hash instead of 'get-bytevector-all' and co. --- guix/scripts/hash.scm | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index ca3928b8e3..4e66aa0f3e 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. @@ -99,11 +99,6 @@ (define (parse-options) (alist-cons 'argument arg result)) %default-options)) - (define (eof->null x) - (if (eof-object? x) - #vu8() - x)) - (let* ((opts (parse-options)) (args (filter-map (match-lambda (('argument . value) @@ -117,8 +112,7 @@ (define (eof->null x) (catch 'system-error (lambda () (format #t "~a~%" - (call-with-input-file file - (compose fmt sha256 eof->null get-bytevector-all)))) + (fmt (call-with-input-file file port-sha256)))) (lambda args (leave (_ "~a~%") (strerror (system-error-errno args)))))) -- cgit v1.2.3 From 396b3c8b55344e3833d57b5b179830f5719c1746 Mon Sep 17 00:00:00 2001 From: Manolis Ragkousis Date: Thu, 20 Feb 2014 15:27:25 +0000 Subject: gnu: hurd: Add MiG. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/hurd.scm (mig): New variable. Co-authored-by: Ludovic Courtès Signed-off-by: Ludovic Courtès --- gnu/packages/hurd.scm | 33 ++++++++++++++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm index f915eda9cb..3edccbdd1c 100644 --- a/gnu/packages/hurd.scm +++ b/gnu/packages/hurd.scm @@ -20,7 +20,9 @@ (define-module (gnu packages hurd) #:use-module (guix licenses) #:use-module (guix download) #:use-module (guix packages) - #:use-module (guix build-system gnu)) + #:use-module (guix build-system gnu) + #:use-module (gnu packages flex) + #:use-module (gnu packages bison)) (define-public gnumach-headers (package @@ -55,3 +57,32 @@ (define-public gnumach-headers (description "Headers of the GNU Mach kernel.") (license gpl2+))) + +(define-public mig + (package + (name "mig") + (version "1.4") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/mig/mig-" + version ".tar.gz")) + (sha256 + (base32 + "1jgzggnbp22sa8z5dilm43zy12vlf1pjxfb3kh13xrfhcay0l97b")))) + (build-system gnu-build-system) + (inputs `(("gnumach-headers" ,gnumach-headers))) + (native-inputs + `(("flex" ,flex) + ("bison" ,bison))) + (arguments `(#:tests? #f)) + (home-page "http://www.gnu.org/software/hurd/microkernel/mach/mig/gnu_mig.html") + (synopsis "Mach 3.0 interface generator for the Hurd") + (description + "GNU MIG is the GNU distribution of the Mach 3.0 interface generator +MIG, as maintained by the GNU Hurd developers for the GNU project. +You need this tool to compile the GNU Mach and GNU Hurd distributions, +and to compile the GNU C library for the Hurd. Also,you will need it +for other software in the GNU system that uses Mach-based inter-process +communication.") + (license gpl2+))) -- cgit v1.2.3 From 75630043013f4d9d69f6ae45bf84e69965b840d1 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Fri, 21 Feb 2014 12:04:48 +0100 Subject: gnu: gmime: Use gnome mirror for download. * gnu/packages/mail.scm (gmime): Use gnome mirror, fixes download problems with automatic https redirection. --- gnu/packages/mail.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/mail.scm b/gnu/packages/mail.scm index 8d67629c6b..703762eed3 100644 --- a/gnu/packages/mail.scm +++ b/gnu/packages/mail.scm @@ -174,7 +174,7 @@ (define-public gmime (version "2.6.19") (source (origin (method url-fetch) - (uri (string-append "http://download.gnome.org/sources/gmime/" + (uri (string-append "mirror://gnome/sources/gmime/" (string-join (take (string-split version #\.) 2) ".") -- cgit v1.2.3 From 8ec773a8b841966422777599bd18f05492f19d7b Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 21 Feb 2014 03:21:57 -0500 Subject: gnu: Add giflib. * gnu/packages/giflib.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. --- gnu-system.am | 1 + gnu/packages/giflib.scm | 76 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 77 insertions(+) create mode 100644 gnu/packages/giflib.scm diff --git a/gnu-system.am b/gnu-system.am index 897cc443a1..8308480c42 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -81,6 +81,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/geeqie.scm \ gnu/packages/gettext.scm \ gnu/packages/ghostscript.scm \ + gnu/packages/giflib.scm \ gnu/packages/gkrellm.scm \ gnu/packages/gl.scm \ gnu/packages/glib.scm \ diff --git a/gnu/packages/giflib.scm b/gnu/packages/giflib.scm new file mode 100644 index 0000000000..849586ed71 --- /dev/null +++ b/gnu/packages/giflib.scm @@ -0,0 +1,76 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Mark H Weaver +;;; +;;; 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 . + +(define-module (gnu packages giflib) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (srfi srfi-1) + #:use-module (gnu packages xorg) + #:use-module (gnu packages perl)) + +(define-public giflib + (package + (name "giflib") + (version "4.2.3") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/giflib/giflib-" + (first (string-split version #\.)) + ".x/giflib-" version ".tar.bz2")) + (sha256 + (base32 "0rmp7ipzk42r841bggd7bfqk4p8qsssbp4wcck4qnz7p4rkxbj0a")))) + (build-system gnu-build-system) + (outputs '("bin" ; utility programs + "out")) ; library + (inputs `(("libx11" ,libx11) + ("libice" ,libice) + ("libsm" ,libsm) + ("perl" ,perl))) + (arguments + `(#:phases (alist-cons-after + 'unpack 'disable-html-doc-gen + (lambda _ + (substitute* "doc/Makefile.in" + (("^all: allhtml manpages") ""))) + (alist-cons-after + 'install 'install-manpages + (lambda* (#:key outputs #:allow-other-keys) + (let* ((bin (assoc-ref outputs "bin")) + (man1dir (string-append bin "/share/man/man1"))) + (mkdir-p man1dir) + (for-each (lambda (file) + (let ((base (basename file))) + (format #t "installing `~a' to `~a'~%" + base man1dir) + (copy-file file + (string-append + man1dir "/" base)))) + (find-files "doc" "\\.1")))) + %standard-phases)))) + (synopsis "Tools and library for working with GIF images") + (description + "giflib is a library for reading and writing GIF images. It is API and +ABI compatible with libungif which was in wide use while the LZW compression +algorithm was patented. Tools are also included to convert, manipulate, +compose, and analyze GIF images.") + (home-page "http://giflib.sourceforge.net/") + (license x11))) + +;;; giflib.scm ends here -- cgit v1.2.3 From 504a83af42a552b753561bce440d44b047144986 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 21 Feb 2014 04:48:22 -0500 Subject: gnu: emacs: Add more inputs: giflib, libice, libsm, alsa-lib. * gnu/packages/emacs.scm (emacs): Add 'giflib', 'libice', 'libsm', and 'alsa-lib' inputs. Remove "--with-gif=no" from configure arguments. --- gnu/packages/emacs.scm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/gnu/packages/emacs.scm b/gnu/packages/emacs.scm index cecfd6025d..87c4e894c5 100644 --- a/gnu/packages/emacs.scm +++ b/gnu/packages/emacs.scm @@ -33,6 +33,8 @@ (define-module (gnu packages emacs) #:use-module (gnu packages libjpeg) #:use-module (gnu packages libtiff) #:use-module (gnu packages libpng) + #:use-module (gnu packages giflib) + #:use-module (gnu packages linux) #:use-module ((gnu packages compression) #:renamer (symbol-prefix-proc 'compression:)) #:use-module (gnu packages xml) @@ -54,8 +56,7 @@ (define-public emacs (arguments '(#:configure-flags (list (string-append "--with-crt-dir=" (assoc-ref %build-inputs "libc") - "/lib") - "--with-gif=no") ; XXX: add libungif + "/lib")) #:phases (alist-cons-before 'configure 'fix-/bin/pwd (lambda _ @@ -73,7 +74,7 @@ (define-public emacs ("gtk+" ,gtk+-2) ("libXft" ,libxft) ("libtiff" ,libtiff) - ;; ("libungif" ,libungif) + ("giflib" ,giflib) ("libjpeg" ,libjpeg-8) ;; When looking for libpng `configure' links with `-lpng -lz', so we @@ -83,6 +84,9 @@ (define-public emacs ("libXpm" ,libxpm) ("libxml2" ,libxml2) + ("libice" ,libice) + ("libsm" ,libsm) + ("alsa-lib" ,alsa-lib) ("dbus" ,dbus))) (native-inputs `(("pkg-config" ,pkg-config) -- cgit v1.2.3 From 86d07a5514d859772980ef87e39f6e2b668655c0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Feb 2014 01:00:49 +0100 Subject: gnu: mpc123: Add patch that fixes a segfault. * gnu/packages/patches/mpc123-initialize-ao.patch: New file. * gnu/packages/mp3.scm (mpc123): Use it. * gnu-system.am (dist_patch_DATA): Add it. --- gnu-system.am | 1 + gnu/packages/mp3.scm | 3 ++- gnu/packages/patches/mpc123-initialize-ao.patch | 19 +++++++++++++++++++ 3 files changed, 22 insertions(+), 1 deletion(-) create mode 100644 gnu/packages/patches/mpc123-initialize-ao.patch diff --git a/gnu-system.am b/gnu-system.am index 8308480c42..e7c7bb2141 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -298,6 +298,7 @@ dist_patch_DATA = \ gnu/packages/patches/make-impure-dirs.patch \ gnu/packages/patches/mcron-install.patch \ gnu/packages/patches/mit-krb5-init-fix.patch \ + gnu/packages/patches/mpc123-initialize-ao.patch \ gnu/packages/patches/patchelf-page-size.patch \ gnu/packages/patches/perl-no-sys-dirs.patch \ gnu/packages/patches/plotutils-libpng-jmpbuf.patch \ diff --git a/gnu/packages/mp3.scm b/gnu/packages/mp3.scm index 7e324703a6..c64efe4c03 100644 --- a/gnu/packages/mp3.scm +++ b/gnu/packages/mp3.scm @@ -298,7 +298,8 @@ (define-public mpc123 version "/mpc123-" version ".tar.gz")) (sha256 (base32 - "0sf4pns0245009z6mbxpx7kqy4kwl69bc95wz9v23wgappsvxgy1")))) + "0sf4pns0245009z6mbxpx7kqy4kwl69bc95wz9v23wgappsvxgy1")) + (patches (list (search-patch "mpc123-initialize-ao.patch"))))) (build-system gnu-build-system) (arguments '(#:phases (alist-replace diff --git a/gnu/packages/patches/mpc123-initialize-ao.patch b/gnu/packages/patches/mpc123-initialize-ao.patch new file mode 100644 index 0000000000..85e461f896 --- /dev/null +++ b/gnu/packages/patches/mpc123-initialize-ao.patch @@ -0,0 +1,19 @@ +Description: Zero ao_sample_format structure to cope with libao 1.0.0 +Author: Colin Watson +Bug-Debian: http://bugs.debian.org/591396 +Bug-Ubuntu: https://bugs.launchpad.net/bugs/710268 +Forwarded: no +Last-Update: 2013-05-07 + +Index: b/ao.c +=================================================================== +--- a/ao.c ++++ b/ao.c +@@ -123,6 +123,7 @@ + + /* initialize ao_format struct */ + /* XXX VERY WRONG */ ++ memset(&ao_fmt, 0, sizeof(ao_fmt)); + ao_fmt.bits=16; /*tmp_stream_info.average_bitrate;*/ + ao_fmt.rate=streaminfo->sample_freq; + ao_fmt.channels=streaminfo->channels; -- cgit v1.2.3 From a93e91ff484005e05491621664ab71f888ad2ba2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Feb 2014 17:37:55 +0100 Subject: nar: 'write-file' can write to non-file ports. * guix/nar.scm (write-contents): Use 'sendfile' only when P is a file port. * tests/nar.scm ("write-file supports non-file output ports"): New test. --- guix/nar.scm | 3 ++- tests/nar.scm | 7 +++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/guix/nar.scm b/guix/nar.scm index 4bc2deb229..89a71302e0 100644 --- a/guix/nar.scm +++ b/guix/nar.scm @@ -112,7 +112,8 @@ (define (call-with-binary-input-file file proc) (write-long-long size p) (call-with-binary-input-file file ;; Use `sendfile' when available (Guile 2.0.8+). - (if (compile-time-value (defined? 'sendfile)) + (if (and (compile-time-value (defined? 'sendfile)) + (file-port? p)) (cut sendfile p <> size 0) (cut dump <> p size))) (write-padding size p)) diff --git a/tests/nar.scm b/tests/nar.scm index 9f21f990c8..7ae8cf0aa7 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -183,6 +183,13 @@ (define-syntax-rule (let/ec k exp...) (test-begin "nar") +(test-assert "write-file supports non-file output ports" + (let ((input (string-append (dirname (search-path %load-path "guix.scm")) + "/guix")) + (output (%make-void-port "w"))) + (write-file input output) + #t)) + (test-assert "write-file + restore-file" (let* ((input (string-append (dirname (search-path %load-path "guix.scm")) "/guix")) -- cgit v1.2.3 From c1d52c71aa4fc8085a9737ad1b235ca53a854649 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Feb 2014 17:45:04 +0100 Subject: ui: Handle SRFI-35 '&message' conditions. * guix/ui.scm (call-with-error-handling): Add case for 'message-condition?'. * po/Makevars: Fix typo in comment. --- guix/ui.scm | 6 +++++- po/Makevars | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/guix/ui.scm b/guix/ui.scm index d6058f806b..c232b32674 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -31,6 +31,7 @@ (define-module (guix ui) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) #:autoload (ice-9 ftw) (scandir) #:use-module (ice-9 match) @@ -186,7 +187,10 @@ (define (call-with-error-handling thunk) ((nix-protocol-error? c) ;; FIXME: Server-provided error messages aren't i18n'd. (leave (_ "build failed: ~a~%") - (nix-protocol-error-message c)))) + (nix-protocol-error-message c))) + ((message-condition? c) + ;; Normally '&message' error conditions have an i18n'd message. + (leave (_ "~a~%") (gettext (condition-message c))))) ;; Catch EPIPE and the likes. (catch 'system-error thunk diff --git a/po/Makevars b/po/Makevars index ade615a452..d45ea4b979 100644 --- a/po/Makevars +++ b/po/Makevars @@ -6,7 +6,7 @@ subdir = po top_builddir = .. # These options get passed to xgettext. We want to catch standard -# gettext uses, package synopses and descriptions, and SRFI-34 error +# gettext uses, package synopses and descriptions, and SRFI-35 error # condition messages. XGETTEXT_OPTIONS = \ --language=Scheme --from-code=UTF-8 \ -- cgit v1.2.3 From 3140f2df423d1235c3766e3478a429ac89d882ed Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Feb 2014 17:54:32 +0100 Subject: guix hash: Add '--recursive'. * guix/scripts/hash.scm (show-help): Add --recursive. (%options): Likewise. (guix-hash)[file-hash]: New procedure. Honor --recursive. Use it. * guix/nar.scm (write-file): Add missing field to the &nar-error condition raised upon unsupported file type; change its message to be more descriptive. * tests/guix-hash.sh: Add tests with -r. * doc/guix.texi (Invoking guix hash): Document --recursive. --- doc/guix.texi | 13 +++++++++++++ guix/nar.scm | 4 ++-- guix/scripts/hash.scm | 25 +++++++++++++++++++++---- tests/guix-hash.sh | 22 +++++++++++++++++++++- 4 files changed, 57 insertions(+), 7 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 34f6810f34..ce011959ad 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1958,6 +1958,19 @@ If the @option{--format} option is not specified, @command{guix hash} will output the hash in @code{nix-base32}. This representation is used in the definitions of packages. +@item --recursive +@itemx -r +Compute the hash on @var{file} recursively. + +In this case, the hash is computed on an archive containing @var{file}, +including its children if it is a directory. Some of @var{file}'s +meta-data is part of the archive; for instance, when @var{file} is a +regular file, the hash is different depending on whether @var{file} is +executable or not. Meta-data such as time stamps has no impact on the +hash (@pxref{Invoking guix archive}). +@c FIXME: Replace xref above with xref to an ``Archive'' section when +@c it exists. + @end table @node Invoking guix refresh diff --git a/guix/nar.scm b/guix/nar.scm index 89a71302e0..9ba6e4ce2c 100644 --- a/guix/nar.scm +++ b/guix/nar.scm @@ -195,8 +195,8 @@ (define p port) (write-string "target" p) (write-string (readlink f) p)) (else - (raise (condition (&message (message "ENOSYS")) - (&nar-error))))) + (raise (condition (&message (message "unsupported file type")) + (&nar-error (file f) (port port)))))) (write-string ")" p)))) (define (restore-file port file) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index 4e66aa0f3e..ea8c2ada6b 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -20,12 +20,14 @@ (define-module (guix scripts hash) #:use-module (guix base32) #:use-module (guix hash) + #:use-module (guix nar) #:use-module (guix ui) #:use-module (guix utils) #:use-module (rnrs io ports) #:use-module (rnrs files) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:export (guix-hash)) @@ -43,10 +45,12 @@ (define (show-help) (display (_ "Usage: guix hash [OPTION] FILE Return the cryptographic hash of FILE. -Supported formats: 'nix-base32' (default), 'base32', and 'base16' -('hex' and 'hexadecimal' can be used as well).\n")) +Supported formats: 'nix-base32' (default), 'base32', and 'base16' ('hex' +and 'hexadecimal' can be used as well).\n")) (format #t (_ " -f, --format=FMT write the hash in the given format")) + (format #t (_ " + -r, --recursive compute the hash on FILE recursively")) (newline) (display (_ " -h, --help display this help and exit")) @@ -73,6 +77,9 @@ (define fmt-proc (alist-cons 'format fmt-proc (alist-delete 'format result)))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive? #t result))) (option '(#\h "help") #f #f (lambda args @@ -107,12 +114,22 @@ (define (parse-options) (reverse opts))) (fmt (assq-ref opts 'format))) + (define (file-hash file) + ;; Compute the hash of FILE. + ;; Catch and gracefully report possible '&nar-error' conditions. + (with-error-handling + (if (assoc-ref opts 'recursive?) + (let-values (((port get-hash) (open-sha256-port))) + (write-file file port) + (flush-output-port port) + (get-hash)) + (call-with-input-file file port-sha256)))) + (match args ((file) (catch 'system-error (lambda () - (format #t "~a~%" - (fmt (call-with-input-file file port-sha256)))) + (format #t "~a~%" (fmt (file-hash file)))) (lambda args (leave (_ "~a~%") (strerror (system-error-errno args)))))) diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh index 53325ce1f4..23df01d417 100644 --- a/tests/guix-hash.sh +++ b/tests/guix-hash.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2013 Ludovic Courtès +# Copyright © 2013, 2014 Ludovic Courtès # # This file is part of GNU Guix. # @@ -22,7 +22,27 @@ guix hash --version +tmpdir="guix-hash-$$" +trap 'rm -rf "$tmpdir"' EXIT + test `guix hash /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73 test `guix hash -f nix-base32 /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73 test `guix hash -f hex /dev/null` = e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855 test `guix hash -f base32 /dev/null` = 4oymiquy7qobjgx36tejs35zeqt24qpemsnzgtfeswmrw6csxbkq + +mkdir "$tmpdir" +echo -n executable > "$tmpdir/exe" +chmod +x "$tmpdir/exe" +( cd "$tmpdir" ; ln -s exe symlink ) +mkdir "$tmpdir/subdir" + +test `guix hash -r "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p + +# Without '-r', this should fail. +if guix hash "$tmpdir" +then false; else true; fi + +# This should fail because /dev/null is a character device, which +# the archive format doesn't support. +if guix hash -r /dev/null +then false; else true; fi -- cgit v1.2.3 From 36bbbbd150f75c2a6dab2473643c3723e606e41d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Feb 2014 23:03:19 +0100 Subject: derivations: Add support for recursive fixed-output derivations. * guix/derivations.scm (): Add 'recursive?' field. Adjust 'make-derivation-output' callers. (%read-derivation) : When HASH-ALGO starts with 'r:', set the 'recursive?' field and drop 'r:' from the hash algo name. (write-derivation)[write-output]: Write the algo as 'r:HASH-ALGO' when the RECURSIVE? field is set. (derivation-hash) : Prepend "r:" when RECURSIVE? is set. (fixed-output-path): New procedure. (derivation): Add #:recursive? parameter. Use 'fixed-output-path' to compute the output file name of a fixed output derivation. (build-expression->derivation): Add #:recursive? parameter. Pass it to 'derivation'. * tests/derivations.scm ("fixed-output derivation, recursive", "build-expression->derivation produces recursive fixed-output", "build-expression->derivation uses recursive fixed-output"): New tests. * doc/guix.texi (Derivations): Document #:recursive? for 'derivation'. Add #:recursive? for 'build-expression->derivation'. --- doc/guix.texi | 9 ++++--- guix/derivations.scm | 71 ++++++++++++++++++++++++++++++++++++++------------- tests/derivations.scm | 70 ++++++++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 127 insertions(+), 23 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index ce011959ad..b2733fbec9 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1478,7 +1478,7 @@ a derivation is the @code{derivation} procedure: @deffn {Scheme Procedure} derivation @var{store} @var{name} @var{builder} @ @var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @ - [#:hash-mode #f] [#:inputs '()] [#:env-vars '()] @ + [#:recursive? #f] [#:hash-mode #f] [#:inputs '()] [#:env-vars '()] @ [#:system (%current-system)] [#:references-graphs #f] @ [#:local-build? #f] Build a derivation with the given arguments, and return the resulting @@ -1486,7 +1486,10 @@ Build a derivation with the given arguments, and return the resulting When @var{hash}, @var{hash-algo}, and @var{hash-mode} are given, a @dfn{fixed-output derivation} is created---i.e., one whose result is -known in advance, such as a file download. +known in advance, such as a file download. If, in addition, +@var{recursive?} is true, then that fixed output may be an executable +file or a directory and @var{hash} must be the hash of an archive +containing this output. When @var{references-graphs} is true, it must be a list of file name/store path pairs. In that case, the reference graph of each store @@ -1526,7 +1529,7 @@ the caller to directly pass a Guile expression as the build script: @var{name} @var{exp} @ [#:system (%current-system)] [#:inputs '()] @ [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @ - [#:env-vars '()] [#:modules '()] @ + [#:recursive? #f] [#:env-vars '()] [#:modules '()] @ [#:references-graphs #f] [#:local-build? #f] [#:guile-for-build #f] Return a derivation that executes Scheme expression @var{exp} as a builder for derivation @var{name}. @var{inputs} must be a list of diff --git a/guix/derivations.scm b/guix/derivations.scm index cc8e37c973..4f060a6aa2 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -47,6 +47,7 @@ (define-module (guix derivations) derivation-output-path derivation-output-hash-algo derivation-output-hash + derivation-output-recursive? derivation-input? @@ -91,11 +92,12 @@ (define-record-type (file-name derivation-file-name)) ; the .drv file name (define-record-type - (make-derivation-output path hash-algo hash) + (make-derivation-output path hash-algo hash recursive?) derivation-output? (path derivation-output-path) ; store path (hash-algo derivation-output-hash-algo) ; symbol | #f - (hash derivation-output-hash)) ; bytevector | #f + (hash derivation-output-hash) ; bytevector | #f + (recursive? derivation-output-recursive?)) ; Boolean (define-record-type (make-derivation-input path sub-derivations) @@ -241,14 +243,19 @@ (define (outputs->alist x) (match output ((name path "" "") (alist-cons name - (make-derivation-output path #f #f) + (make-derivation-output path #f #f #f) result)) ((name path hash-algo hash) ;; fixed-output - (let ((algo (string->symbol hash-algo)) - (hash (base16-string->bytevector hash))) + (let* ((rec? (string-prefix? "r:" hash-algo)) + (algo (string->symbol + (if rec? + (string-drop hash-algo 2) + hash-algo))) + (hash (base16-string->bytevector hash))) (alist-cons name - (make-derivation-output path algo hash) + (make-derivation-output path algo + hash rec?) result))))) '() x)) @@ -368,9 +375,12 @@ (define (coalesce-duplicate-inputs inputs) (define (write-output output port) (match output - ((name . ($ path hash-algo hash)) + ((name . ($ path hash-algo hash recursive?)) (write-tuple (list name path - (or (and=> hash-algo symbol->string) "") + (if hash-algo + (string-append (if recursive? "r:" "") + (symbol->string hash-algo)) + "") (or (and=> hash bytevector->base16-string) "")) write @@ -476,11 +486,14 @@ (define derivation-hash ; `hashDerivationModulo' in derivations.cc "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector." (match drv (($ ((_ . ($ path - (? symbol? hash-algo) (? bytevector? hash))))) + (? symbol? hash-algo) (? bytevector? hash) + (? boolean? recursive?))))) ;; A fixed-output derivation. (sha256 (string->utf8 - (string-append "fixed:out:" (symbol->string hash-algo) + (string-append "fixed:out:" + (if recursive? "r:" "") + (symbol->string hash-algo) ":" (bytevector->base16-string hash) ":" path)))) (($ outputs inputs sources @@ -527,17 +540,33 @@ (define (output-path output hash name) ; makeOutputPath name (string-append name "-" output)))) +(define (fixed-output-path output hash-algo hash recursive? name) + "Return an output path for the fixed output OUTPUT defined by HASH of type +HASH-ALGO, of the derivation NAME. RECURSIVE? has the same meaning as for +'add-to-store'." + (if (and recursive? (eq? hash-algo 'sha256)) + (store-path "source" hash name) + (let ((tag (string-append "fixed:" output ":" + (if recursive? "r:" "") + (symbol->string hash-algo) ":" + (bytevector->base16-string hash) ":"))) + (store-path (string-append "output:" output) + (sha256 (string->utf8 tag)) + name)))) + (define* (derivation store name builder args #:key (system (%current-system)) (env-vars '()) (inputs '()) (outputs '("out")) - hash hash-algo hash-mode + hash hash-algo hash-mode recursive? references-graphs local-build?) "Build a derivation with the given arguments, and return the resulting object. When HASH, HASH-ALGO, and HASH-MODE are given, a fixed-output derivation is created---i.e., one whose result is known in -advance, such as a file download. +advance, such as a file download. If, in addition, RECURSIVE? is true, then +that fixed output may be an executable file or a directory and HASH must be +the hash of an archive containing this output. When REFERENCES-GRAPHS is true, it must be a list of file name/store path pairs. In that case, the reference graph of each store path is exported in @@ -555,12 +584,16 @@ (define (add-output-paths drv) (let* ((drv-hash (derivation-hash drv)) (outputs (map (match-lambda ((output-name . ($ - _ algo hash)) - (let ((path (output-path output-name - drv-hash name))) + _ algo hash rec?)) + (let ((path (if hash + (fixed-output-path output-name + algo hash + rec? name) + (output-path output-name + drv-hash name)))) (cons output-name (make-derivation-output path algo - hash))))) + hash rec?))))) outputs))) (make-derivation outputs inputs sources system builder args (map (match-lambda @@ -618,7 +651,8 @@ (define (set-file-name drv file) (let* ((outputs (map (lambda (name) ;; Return outputs with an empty path. (cons name - (make-derivation-output "" hash-algo hash))) + (make-derivation-output "" hash-algo + hash recursive?))) outputs)) (inputs (map (match-lambda (((? derivation? drv)) @@ -909,7 +943,7 @@ (define* (build-expression->derivation store name exp (system (%current-system)) (inputs '()) (outputs '("out")) - hash hash-algo + hash hash-algo recursive? (env-vars '()) (modules '()) guile-for-build @@ -1056,6 +1090,7 @@ (define %build-inputs env-vars) #:hash hash #:hash-algo hash-algo + #:recursive? recursive? #:outputs outputs #:references-graphs references-graphs #:local-build? local-build?))) diff --git a/tests/derivations.scm b/tests/derivations.scm index f7cedde505..f31b00b8a2 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,7 +23,8 @@ (define-module (test-derivations) #:use-module (guix utils) #:use-module (guix hash) #:use-module (guix base32) - #:use-module ((guix packages) #:select (package-derivation)) + #:use-module ((guix packages) #:select (package-derivation base32)) + #:use-module ((guix build utils) #:select (executable-file?)) #:use-module ((gnu packages) #:select (search-bootstrap-binary)) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages guile) #:select (guile-1.8)) @@ -190,6 +191,23 @@ (define prefix-len (string-length dir)) (equal? (derivation->output-path drv1) (derivation->output-path drv2))))) +(test-assert "fixed-output derivation, recursive" + (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" + "echo -n hello > $out" '())) + (hash (sha256 (string->utf8 "hello"))) + (drv (derivation %store "fixed-rec" + %bash `(,builder) + #:inputs `((,builder)) + #:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa") + #:hash-algo 'sha256 + #:recursive? #t)) + (succeeded? (build-derivations %store (list drv)))) + (and succeeded? + (let ((p (derivation->output-path drv))) + (and (equal? (string->utf8 "hello") + (call-with-input-file p get-bytevector-all)) + (bytevector? (query-path-hash %store p))))))) + (test-assert "derivation with a fixed-output input" ;; A derivation D using a fixed-output derivation F doesn't has the same ;; output path when passed F or F', as long as F and F' have the same output @@ -637,6 +655,54 @@ (define %coreutils (derivation-file-name final1))) (build-derivations %store (list final1 final2))))) +(test-assert "build-expression->derivation produces recursive fixed-output" + (let* ((builder '(begin + (use-modules (srfi srfi-26)) + (mkdir %output) + (chdir %output) + (call-with-output-file "exe" + (cut display "executable" <>)) + (chmod "exe" #o777) + (symlink "exe" "symlink") + (mkdir "subdir"))) + (drv (build-expression->derivation %store "fixed-rec" builder + #:hash-algo 'sha256 + #:hash (base32 + "10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p") + #:recursive? #t))) + (and (build-derivations %store (list drv)) + (let* ((dir (derivation->output-path drv)) + (exe (string-append dir "/exe")) + (link (string-append dir "/symlink")) + (subdir (string-append dir "/subdir"))) + (and (executable-file? exe) + (string=? "executable" + (call-with-input-file exe get-string-all)) + (string=? "exe" (readlink link)) + (file-is-directory? subdir)))))) + +(test-assert "build-expression->derivation uses recursive fixed-output" + (let* ((builder '(call-with-output-file %output + (lambda (port) + (display "hello" port)))) + (fixed (build-expression->derivation %store "small-fixed-rec" + builder + #:hash-algo 'sha256 + #:hash (base32 + "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa") + #:recursive? #t)) + (in (derivation->output-path fixed)) + (builder `(begin + (mkdir %output) + (chdir %output) + (symlink ,in "symlink"))) + (drv (build-expression->derivation %store "fixed-rec-user" + builder + #:inputs `(("fixed" ,fixed))))) + (and (build-derivations %store (list drv)) + (let ((out (derivation->output-path drv))) + (string=? (readlink (string-append out "/symlink")) in))))) + (test-assert "build-expression->derivation with #:references-graphs" (let* ((input (add-text-to-store %store "foo" "hello" (list %bash %mkdir))) -- cgit v1.2.3 From 96c7448f370227c9777a6acdac4ac65f1884fb43 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Feb 2014 20:17:29 +0100 Subject: nar: Produce archives with files sorted in C collation order. * guix/nar.scm (write-file) : Pass 'string '("." "..")) - (scandir f)))) + (let* ((select? (negate (cut member <> '("." "..")))) + + ;; 'scandir' defaults to 'string-locale Date: Fri, 21 Feb 2014 20:22:57 +0100 Subject: doc: More on what's special about the archive format. * doc/guix.texi (Invoking guix archive): Expound on what sets the Nar format apart. --- doc/guix.texi | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index b2733fbec9..36e68668ef 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1095,11 +1095,19 @@ the target machine's store. The @code{--missing} option can help figure out which items are missing from the target's store. Archives are stored in the ``Nix archive'' or ``Nar'' format, which is -comparable in spirit to `tar'. When exporting, the daemon digitally -signs the contents of the archive, and that digital signature is -appended. When importing, the daemon verifies the signature and rejects -the import in case of an invalid signature or if the signing key is not -authorized. +comparable in spirit to `tar', but with a few noteworthy differences +that make it more appropriate for our purposes. First, rather than +recording all Unix meta-data for each file, the Nar format only mentions +the file type (regular, directory, or symbolic link); Unix permissions +and owner/group are dismissed. Second, the order in which directory +entries are stored always follows the order of file names according to +the C locale collation order. This makes archive production fully +deterministic. + +When exporting, the daemon digitally signs the contents of the archive, +and that digital signature is appended. When importing, the daemon +verifies the signature and rejects the import in case of an invalid +signature or if the signing key is not authorized. @c FIXME: Add xref to daemon doc about signatures. The main options are: -- cgit v1.2.3 From 9b5b5c17409ce0174d171903f03c1d53dfb455c5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Feb 2014 23:41:11 +0100 Subject: Add (guix git-download). * guix/git-download.scm, guix/build/git.scm: New files. * Makefile.am (MODULES): Add them. * guix/packages.scm (): Fix comment for 'method' field. --- Makefile.am | 2 ++ guix/build/git.scm | 45 ++++++++++++++++++++++++++ guix/git-download.scm | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++ guix/packages.scm | 4 +-- 4 files changed, 138 insertions(+), 2 deletions(-) create mode 100644 guix/build/git.scm create mode 100644 guix/git-download.scm diff --git a/Makefile.am b/Makefile.am index 6ad8eb9914..56cb6d2354 100644 --- a/Makefile.am +++ b/Makefile.am @@ -34,6 +34,7 @@ MODULES = \ guix/pki.scm \ guix/utils.scm \ guix/download.scm \ + guix/git-download.scm \ guix/monads.scm \ guix/profiles.scm \ guix/serialization.scm \ @@ -54,6 +55,7 @@ MODULES = \ guix/ui.scm \ guix/build/download.scm \ guix/build/cmake-build-system.scm \ + guix/build/git.scm \ guix/build/gnome.scm \ guix/build/gnu-build-system.scm \ guix/build/gnu-dist.scm \ diff --git a/guix/build/git.scm b/guix/build/git.scm new file mode 100644 index 0000000000..4245594c38 --- /dev/null +++ b/guix/build/git.scm @@ -0,0 +1,45 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (guix build git) + #:use-module (guix build utils) + #:export (git-fetch)) + +;;; Commentary: +;;; +;;; This is the build-side support code of (guix git-download). It allows a +;;; Git repository to be cloned and checked out at a specific commit. +;;; +;;; Code: + +(define* (git-fetch url commit directory + #:key (git-command "git")) + "Fetch COMMIT from URL into DIRECTORY. COMMIT must be a valid Git commit +identifier. Return #t on success, #f otherwise." + (and (zero? (system* git-command "clone" url directory)) + (with-directory-excursion directory + (system* git-command "tag" "-l") + (and (zero? (system* git-command "checkout" commit)) + (begin + ;; The contents of '.git' vary as a function of the current + ;; status of the Git repo. Since we want a fixed output, this + ;; directory needs to be taken out. + (delete-file-recursively ".git") + #t))))) + +;;; git.scm ends here diff --git a/guix/git-download.scm b/guix/git-download.scm new file mode 100644 index 0000000000..472bf756ce --- /dev/null +++ b/guix/git-download.scm @@ -0,0 +1,89 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (guix git-download) + #:use-module (guix records) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module (ice-9 match) + #:export (git-reference + git-reference? + git-reference-url + git-reference-commit + + git-fetch)) + +;;; Commentary: +;;; +;;; An method that fetches a specific commit from a Git repository. +;;; The repository URL and commit hash are specified with a +;;; object. +;;; +;;; Code: + +(define-record-type* + git-reference make-git-reference + git-reference? + (url git-reference-url) + (commit git-reference-commit)) + +(define* (git-fetch store ref hash-algo hash + #:optional name + #:key (system (%current-system)) guile git) + "Return a fixed-output derivation in STORE that fetches REF, a + object. The output is expected to have recursive hash HASH of +type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if +#f." + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages base))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system))))) + + (define git-for-build + (match git + ((? package?) + (package-derivation store git system)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages version-control))) + (git (module-ref distro 'git))) + (package-derivation store git system))))) + + (let* ((command (string-append (derivation->output-path git-for-build) + "/bin/git")) + (builder `(begin + (use-modules (guix build git)) + (git-fetch ',(git-reference-url ref) + ',(git-reference-commit ref) + %output + #:git-command ',command)))) + (build-expression->derivation store (or name "git-checkout") builder + #:system system + #:local-build? #t + #:inputs `(("git" ,git-for-build)) + #:hash-algo hash-algo + #:hash hash + #:recursive? #t + #:modules '((guix build git) + (guix build utils)) + #:guile-for-build guile-for-build))) + +;;; git-download.scm ends here diff --git a/guix/packages.scm b/guix/packages.scm index daf431f5e4..d345900f79 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -106,7 +106,7 @@ (define-record-type* origin make-origin origin? (uri origin-uri) ; string - (method origin-method) ; symbol + (method origin-method) ; procedure (sha256 origin-sha256) ; bytevector (file-name origin-file-name (default #f)) ; optional file name (patches origin-patches (default '())) ; list of file names -- cgit v1.2.3 From 93cc13aabbbac3341a06a27bb8016d94622350cd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Feb 2014 23:44:52 +0100 Subject: gnu: Add libwebsockets. * gnu/packages/libwebsockets.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. --- gnu-system.am | 1 + gnu/packages/libwebsockets.scm | 83 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 84 insertions(+) create mode 100644 gnu/packages/libwebsockets.scm diff --git a/gnu-system.am b/gnu-system.am index e7c7bb2141..d63a80f62a 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -132,6 +132,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/libunistring.scm \ gnu/packages/libusb.scm \ gnu/packages/libunwind.scm \ + gnu/packages/libwebsockets.scm \ gnu/packages/lightning.scm \ gnu/packages/linux.scm \ gnu/packages/lout.scm \ diff --git a/gnu/packages/libwebsockets.scm b/gnu/packages/libwebsockets.scm new file mode 100644 index 0000000000..3f900aef72 --- /dev/null +++ b/gnu/packages/libwebsockets.scm @@ -0,0 +1,83 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu packages libwebsockets) + #:use-module (guix packages) + #:use-module (guix git-download) + #:use-module (guix build-system gnu) + #:use-module ((guix licenses) + #:select (lgpl2.1)) + #:use-module (gnu packages autotools) + #:use-module ((gnu packages compression) #:select (zlib)) + #:use-module (gnu packages perl) + #:use-module (gnu packages openssl)) + +(define-public libwebsockets + (package + (name "libwebsockets") + (version "1.2") + (source (origin + ;; The project does not publish tarballs, so we have to take + ;; things from Git. + (method git-fetch) + (uri (git-reference + (url "git://git.libwebsockets.org/libwebsockets") + (commit (string-append "v" version + "-chrome26-firefox18")))) + (sha256 + (base32 + "1293hbz8qj4p27m1qjf8dn97r10xjyiwdpq491m87zi025s558cl")) + (file-name (string-append name "-" version)))) + + ;; The package has both CMake and GNU build systems, but the latter is + ;; apparently better supported (CMake-generated makefiles lack an + ;; 'install' target, for instance.) + (build-system gnu-build-system) + + (arguments + '(#:phases (alist-replace + 'unpack + ;; FIXME: Remove this when gnu-build-system handles that + ;; case correctly. + (lambda* (#:key source #:allow-other-keys) + (mkdir "source") + (chdir "source") + (copy-recursively source ".") + #t) + + (alist-cons-before + 'configure 'bootstrap + (lambda _ + (chmod "libwebsockets-api-doc.html" #o666) + (zero? (system* "./autogen.sh"))) + %standard-phases)))) + (native-inputs `(("autoconf" ,autoconf) + ("automake" ,automake) + ("libtool" ,libtool "bin") + ("perl" ,perl))) ; to build the HTML doc + (inputs `(("zlib" ,zlib) + ("openssl" ,openssl))) + (synopsis "WebSockets library written in C") + (description + "libwebsockets is a library that allows C programs to establish client +and server WebSockets connections---a protocol layered above HTTP that allows +for efficient socket-like bidirectional reliable communication channels.") + (home-page "http://libwebsockets.org/") + + ;; This is LGPLv2.1-only with extra exceptions specified in 'LICENSE'. + (license lgpl2.1))) -- cgit v1.2.3 From 2096ef47aad57a9988c8fdfaa46a70770a0e0b12 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Feb 2014 23:48:56 +0100 Subject: derivations: Remove unused 'derivation' parameter. * guix/derivations.scm (derivation): Remove unused #:hash-mode parameter. * doc/guix.texi (Derivations): Adjust accordingly. --- doc/guix.texi | 4 ++-- guix/derivations.scm | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 36e68668ef..78736fadf2 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1486,13 +1486,13 @@ a derivation is the @code{derivation} procedure: @deffn {Scheme Procedure} derivation @var{store} @var{name} @var{builder} @ @var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @ - [#:recursive? #f] [#:hash-mode #f] [#:inputs '()] [#:env-vars '()] @ + [#:recursive? #f] [#:inputs '()] [#:env-vars '()] @ [#:system (%current-system)] [#:references-graphs #f] @ [#:local-build? #f] Build a derivation with the given arguments, and return the resulting @code{} object. -When @var{hash}, @var{hash-algo}, and @var{hash-mode} are given, a +When @var{hash} and @var{hash-algo} are given, a @dfn{fixed-output derivation} is created---i.e., one whose result is known in advance, such as a file download. If, in addition, @var{recursive?} is true, then that fixed output may be an executable diff --git a/guix/derivations.scm b/guix/derivations.scm index 4f060a6aa2..82a0173232 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -558,11 +558,11 @@ (define* (derivation store name builder args #:key (system (%current-system)) (env-vars '()) (inputs '()) (outputs '("out")) - hash hash-algo hash-mode recursive? + hash hash-algo recursive? references-graphs local-build?) "Build a derivation with the given arguments, and return the resulting - object. When HASH, HASH-ALGO, and HASH-MODE are given, a + object. When HASH and HASH-ALGO are given, a fixed-output derivation is created---i.e., one whose result is known in advance, such as a file download. If, in addition, RECURSIVE? is true, then that fixed output may be an executable file or a directory and HASH must be -- cgit v1.2.3