me
/
guix
Archived
1
0
Fork 0
Code

Merge branch 'master' into staging

master
Marius Bakke 2020-03-06 00:17:50 +01:00
parent e32aea5472 bc8b2ffdac
commit b6f946f039
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
68 changed files with 2127 additions and 1154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Makefile.am
View File

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU # GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> # Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Andreas Enge <andreas@enge.fr> # Copyright © 2013 Andreas Enge <andreas@enge.fr>
# Copyright © 2015, 2017 Alex Kost <alezost@gmail.com> # Copyright © 2015, 2017 Alex Kost <alezost@gmail.com>
# Copyright © 2016, 2018 Mathieu Lirzin <mthl@gnu.org> # Copyright © 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
@ -510,9 +510,7 @@ endif !CAN_RUN_TESTS
check-system: $(GOBJECTS) check-system: $(GOBJECTS)
$(AM_V_at)$(top_builddir)/pre-inst-env \ $(AM_V_at)$(top_builddir)/pre-inst-env \
$(GUILE) --no-auto-compile \ guix build -m $(top_srcdir)/etc/system-tests.scm -K
-e '(@@ (run-system-tests) run-system-tests)' \
$(top_srcdir)/build-aux/run-system-tests.scm
# Public keys used to sign substitutes. # Public keys used to sign substitutes.
dist_pkgdata_DATA = \ dist_pkgdata_DATA = \
@ -543,6 +541,7 @@ EXTRA_DIST += \
scripts/guix.in \ scripts/guix.in \
etc/guix-install.sh \ etc/guix-install.sh \
etc/news.scm \ etc/news.scm \
etc/system-tests.scm \
build-aux/build-self.scm \ build-aux/build-self.scm \
build-aux/compile-all.scm \ build-aux/compile-all.scm \
build-aux/hydra/evaluate.scm \ build-aux/hydra/evaluate.scm \
@ -560,7 +559,6 @@ EXTRA_DIST += \
build-aux/test-driver.scm \ build-aux/test-driver.scm \
build-aux/update-guix-package.scm \ build-aux/update-guix-package.scm \
build-aux/update-NEWS.scm \ build-aux/update-NEWS.scm \
build-aux/run-system-tests.scm \
d3.v3.js \ d3.v3.js \
graph.js \ graph.js \
tests/test.drv \ tests/test.drv \

4
build-aux/hydra/gnu-system.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
;;; ;;;
@ -31,7 +31,7 @@
;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
;; port to the bit bucket, let us write to the error port instead. ;; port to the bit bucket, let us write to the error port instead.
(setvbuf (current-error-port) _IOLBF) (setvbuf (current-error-port) 'line)
(set-current-output-port (current-error-port)) (set-current-output-port (current-error-port))
(define (find-current-checkout arguments) (define (find-current-checkout arguments)

4
build-aux/hydra/guix-modular.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -33,7 +33,7 @@
;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
;; port to the bit bucket, let us write to the error port instead. ;; port to the bit bucket, let us write to the error port instead.
(setvbuf (current-error-port) _IOLBF) (setvbuf (current-error-port) 'line)
(set-current-output-port (current-error-port)) (set-current-output-port (current-error-port))
(define* (build-job store source version system) (define* (build-job store source version system)

115
build-aux/run-system-tests.scm
View File

@ -1,115 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (run-system-tests)
#:use-module (gnu tests)
#:use-module (gnu packages package-management)
#:use-module ((gnu ci) #:select (channel-instance->package))
#:use-module (guix store)
#:use-module ((guix status) #:select (with-status-verbosity))
#:use-module (guix monads)
#:use-module (guix channels)
#:use-module (guix derivations)
#:use-module ((guix git-download) #:select (git-predicate))
#:use-module (guix utils)
#:use-module (guix ui)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (ice-9 match)
#:export (run-system-tests))
(define (built-derivations* drv)
(lambda (store)
(guard (c ((store-protocol-error? c)
(values #f store)))
(values (build-derivations store drv) store))))
(define (filterm mproc lst) ;XXX: move to (guix monads)
(with-monad %store-monad
(>>= (foldm %store-monad
(lambda (item result)
(mlet %store-monad ((keep? (mproc item)))
(return (if keep?
(cons item result)
result))))
'()
lst)
(lift1 reverse %store-monad))))
(define (tests-for-channel-instance instance)
"Return a list of tests for perform, using Guix from INSTANCE, a channel
instance."
;; Honor the 'TESTS' environment variable so that one can select a subset
;; of tests to run in the usual way:
;;
;; make check-system TESTS=installed-os
(parameterize ((current-guix-package
(channel-instance->package instance)))
(match (getenv "TESTS")
(#f
(all-system-tests))
((= string-tokenize (tests ...))
(filter (lambda (test)
(member (system-test-name test) tests))
(all-system-tests))))))
(define (run-system-tests . args)
(define source
(string-append (current-source-directory) "/.."))
(with-store store
(with-status-verbosity 2
(run-with-store store
;; Intern SOURCE so that 'build-from-source' in (guix channels) sees
;; "fresh" file names and thus doesn't find itself loading .go files
;; from ~/.cache/guile when it loads 'build-aux/build-self.scm'.
;; XXX: It would be best to not do it upfront because we may need it.
(mlet* %store-monad ((source (interned-file source "guix-source"
#:recursive? #t
#:select?
(or (git-predicate source)
(const #t))))
(instance -> (checkout->channel-instance source))
(tests -> (tests-for-channel-instance instance))
(drv (mapm %store-monad system-test-value tests))
(out -> (map derivation->output-path drv)))
(format (current-error-port) "Running ~a system tests...~%"
(length tests))
(mbegin %store-monad
(show-what-to-build* drv)
(set-build-options* #:keep-going? #t #:keep-failed? #t
#:print-build-trace #t
#:print-extended-build-trace? #t
#:fallback? #t)
(built-derivations* drv)
(mlet %store-monad ((valid (filterm (store-lift valid-path?)
out))
(failed (filterm (store-lift
(negate valid-path?))
out)))
(format #t "TOTAL: ~a\n" (length drv))
(for-each (lambda (item)
(format #t "PASS: ~a~%" item))
valid)
(for-each (lambda (item)
(format #t "FAIL: ~a~%" item))
failed)
(exit (null? failed)))))))))

94
etc/system-tests.scm 100644
View File

@ -0,0 +1,94 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(use-modules (gnu tests)
(gnu packages package-management)
((gnu ci) #:select (channel-source->package))
((guix git-download) #:select (git-predicate))
((guix utils) #:select (current-source-directory))
(git)
(ice-9 match))
(define (source-commit directory)
"Return the commit of the head of DIRECTORY or #f if it could not be
determined."
(let ((repository #f))
(catch 'git-error
(lambda ()
(set! repository (repository-open directory))
(let* ((head (repository-head repository))
(target (reference-target head))
(commit (oid->string target)))
(repository-close! repository)
commit))
(lambda _
(when repository
(repository-close! repository))
#f))))
(define (tests-for-current-guix source commit)
"Return a list of tests for perform, using Guix built from SOURCE, a channel
instance."
;; Honor the 'TESTS' environment variable so that one can select a subset
;; of tests to run in the usual way:
;;
;; make check-system TESTS=installed-os
(parameterize ((current-guix-package
(channel-source->package source #:commit commit)))
(match (getenv "TESTS")
(#f
(all-system-tests))
((= string-tokenize (tests ...))
(filter (lambda (test)
(member (system-test-name test) tests))
(all-system-tests))))))
(define (system-test->manifest-entry test)
"Return a manifest entry for TEST, a system test."
(manifest-entry
(name (string-append "test." (system-test-name test)))
(version "0")
(item test)))
(define (system-test-manifest)
"Return a manifest containing all the system tests, or all those selected by
the 'TESTS' environment variable."
(define source
(string-append (current-source-directory) "/.."))
(define commit
;; Fetch the current commit ID so we can potentially build the same
;; derivation as ci.guix.gnu.org.
(source-commit source))
;; Intern SOURCE so that 'build-from-source' in (guix channels) sees
;; "fresh" file names and thus doesn't find itself loading .go files
;; from ~/.cache/guile when it loads 'build-aux/build-self.scm'.
(let* ((source (local-file source "guix-source"
#:recursive? #t
#:select?
(or (git-predicate source)
(const #t))))
(tests (tests-for-current-guix source commit)))
(format (current-error-port) "Selected ~a system tests...~%"
(length tests))
(manifest (map system-test->manifest-entry tests))))
;; Return the manifest.
(system-test-manifest)

125
gnu/ci.scm
View File

@ -28,6 +28,7 @@
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix build-system) #:use-module (guix build-system)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix gexp)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module ((guix licenses) #:use-module ((guix licenses)
#:select (gpl3+ license? license-name)) #:select (gpl3+ license? license-name))
@ -54,7 +55,7 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (channel-instance->package #:export (channel-source->package
hydra-jobs)) hydra-jobs))
;;; Commentary: ;;; Commentary:
@ -135,6 +136,49 @@ SYSTEM."
"i686-w64-mingw32" "i686-w64-mingw32"
"x86_64-w64-mingw32")) "x86_64-w64-mingw32"))
(define (cross-jobs store system)
"Return a list of cross-compilation jobs for SYSTEM."
(define (from-32-to-64? target)
;; Return true if SYSTEM is 32-bit and TARGET is 64-bit. This hack
;; prevents known-to-fail cross-builds from i686-linux or armhf-linux to
;; mips64el-linux-gnuabi64.
(and (or (string-prefix? "i686-" system)
(string-prefix? "i586-" system)
(string-prefix? "armhf-" system))
(string-contains target "64"))) ;x86_64, mips64el, aarch64, etc.
(define (same? target)
;; Return true if SYSTEM and TARGET are the same thing. This is so we
;; don't try to cross-compile to 'mips64el-linux-gnu' from
;; 'mips64el-linux'.
(or (string-contains target system)
(and (string-prefix? "armhf" system) ;armhf-linux
(string-prefix? "arm" target)))) ;arm-linux-gnueabihf
(define (pointless? target)
;; Return #t if it makes no sense to cross-build to TARGET from SYSTEM.
(match system
((or "x86_64-linux" "i686-linux")
(if (string-contains target "mingw")
(not (string=? "x86_64-linux" system))
#f))
(_
;; Don't try to cross-compile from non-Intel platforms: this isn't
;; very useful and these are often brittle configurations.
#t)))
(define (either proc1 proc2 proc3)
(lambda (x)
(or (proc1 x) (proc2 x) (proc3 x))))
(append-map (lambda (target)
(map (lambda (package)
(package-cross-job store (job-name package)
package target system))
%packages-to-cross-build))
(remove (either from-32-to-64? same? pointless?)
%cross-targets)))
(define %guixsd-supported-systems (define %guixsd-supported-systems
'("x86_64-linux" "i686-linux" "armhf-linux")) '("x86_64-linux" "i686-linux" "armhf-linux"))
@ -196,29 +240,39 @@ system.")
(define channel-build-system (define channel-build-system
;; Build system used to "convert" a channel instance to a package. ;; Build system used to "convert" a channel instance to a package.
(let* ((build (lambda* (store name inputs (let* ((build (lambda* (store name inputs
#:key instance system #:key source commit system
#:allow-other-keys) #:allow-other-keys)
(run-with-store store (run-with-store store
(channel-instances->derivation (list instance)) ;; SOURCE can be a lowerable object such as <local-file>
;; or a file name. Adjust accordingly.
(mlet* %store-monad ((source (if (string? source)
(return source)
(lower-object source)))
(instance
-> (checkout->channel-instance
source #:commit commit)))
(channel-instances->derivation (list instance)))
#:system system))) #:system system)))
(lower (lambda* (name #:key system instance #:allow-other-keys) (lower (lambda* (name #:key system source commit
#:allow-other-keys)
(bag (bag
(name name) (name name)
(system system) (system system)
(build build) (build build)
(arguments `(#:instance ,instance)))))) (arguments `(#:source ,source
#:commit ,commit))))))
(build-system (name 'channel) (build-system (name 'channel)
(description "Turn a channel instance into a package.") (description "Turn a channel instance into a package.")
(lower lower)))) (lower lower))))
(define (channel-instance->package instance) (define* (channel-source->package source #:key commit)
"Return a package for the given channel INSTANCE." "Return a package for the given channel SOURCE, a lowerable object."
(package (package
(inherit guix) (inherit guix)
(version (or (string-take (channel-instance-commit instance) 7) (version (string-append (package-version guix) "+"))
(string-append (package-version guix) "+")))
(build-system channel-build-system) (build-system channel-build-system)
(arguments `(#:instance ,instance)) (arguments `(#:source ,source
#:commit ,commit))
(inputs '()) (inputs '())
(native-inputs '()) (native-inputs '())
(propagated-inputs '()))) (propagated-inputs '())))
@ -226,9 +280,6 @@ system.")
(define* (system-test-jobs store system (define* (system-test-jobs store system
#:key source commit) #:key source commit)
"Return a list of jobs for the system tests." "Return a list of jobs for the system tests."
(define instance
(checkout->channel-instance source #:commit commit))
(define (test->thunk test) (define (test->thunk test)
(lambda () (lambda ()
(define drv (define drv
@ -265,7 +316,7 @@ system.")
;; expensive. It also makes sure we get a valid Guix package when this ;; expensive. It also makes sure we get a valid Guix package when this
;; code is not running from a checkout. ;; code is not running from a checkout.
(parameterize ((current-guix-package (parameterize ((current-guix-package
(channel-instance->package instance))) (channel-source->package source #:commit commit)))
(map ->job (all-system-tests))) (map ->job (all-system-tests)))
'())) '()))
@ -417,48 +468,6 @@ Return #f if no such checkout is found."
(define source (define source
(assq-ref checkout 'file-name)) (assq-ref checkout 'file-name))
(define (cross-jobs system)
(define (from-32-to-64? target)
;; Return true if SYSTEM is 32-bit and TARGET is 64-bit. This hack
;; prevents known-to-fail cross-builds from i686-linux or armhf-linux to
;; mips64el-linux-gnuabi64.
(and (or (string-prefix? "i686-" system)
(string-prefix? "i586-" system)
(string-prefix? "armhf-" system))
(string-contains target "64"))) ;x86_64, mips64el, aarch64, etc.
(define (same? target)
;; Return true if SYSTEM and TARGET are the same thing. This is so we
;; don't try to cross-compile to 'mips64el-linux-gnu' from
;; 'mips64el-linux'.
(or (string-contains target system)
(and (string-prefix? "armhf" system) ;armhf-linux
(string-prefix? "arm" target)))) ;arm-linux-gnueabihf
(define (pointless? target)
;; Return #t if it makes no sense to cross-build to TARGET from SYSTEM.
(match system
((or "x86_64-linux" "i686-linux")
(if (string-contains target "mingw")
(not (string=? "x86_64-linux" system))
#f))
(_
;; Don't try to cross-compile from non-Intel platforms: this isn't
;; very useful and these are often brittle configurations.
#t)))
(define (either proc1 proc2 proc3)
(lambda (x)
(or (proc1 x) (proc2 x) (proc3 x))))
(append-map (lambda (target)
(map (lambda (package)
(package-cross-job store (job-name package)
package target system))
%packages-to-cross-build))
(remove (either from-32-to-64? same? pointless?)
%cross-targets)))
;; Turn off grafts. Grafting is meant to happen on the user's machines. ;; Turn off grafts. Grafting is meant to happen on the user's machines.
(parameterize ((%graft? #f)) (parameterize ((%graft? #f))
;; Return one job for each package, except bootstrap packages. ;; Return one job for each package, except bootstrap packages.
@ -483,14 +492,14 @@ Return #f if no such checkout is found."
#:source source #:source source
#:commit commit) #:commit commit)
(tarball-jobs store system) (tarball-jobs store system)
(cross-jobs system)))) (cross-jobs store system))))
((core) ((core)
;; Build core packages only. ;; Build core packages only.
(append (map (lambda (package) (append (map (lambda (package)
(package-job store (job-name package) (package-job store (job-name package)
package system)) package system))
%core-packages) %core-packages)
(cross-jobs system))) (cross-jobs store system)))
((hello) ((hello)
;; Build hello package only. ;; Build hello package only.
(if (string=? system (%current-system)) (if (string=? system (%current-system))

21
gnu/installer.scm
View File

@ -26,6 +26,8 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module ((guix self) #:select (make-config.scm)) #:use-module ((guix self) #:select (make-config.scm))
#:use-module (guix packages)
#:use-module (guix git-download)
#:use-module (gnu installer utils) #:use-module (gnu installer utils)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module (gnu packages base) #:use-module (gnu packages base)
@ -280,6 +282,25 @@ selected keymap."
((installer-final-page current-installer) ((installer-final-page current-installer)
result prev-steps)))))))) result prev-steps))))))))
(define guile-newt
;; Guile-Newt with 'form-watch-fd'.
;; TODO: Remove once a new release is out.
(let ((commit "b3c885d42cfac327d3531c9d064939514ce6bf12")
(revision "1"))
(package
(inherit (@ (gnu packages guile-xyz) guile-newt))
(name "guile-newt")
(version (git-version "0.0.1" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://gitlab.com/mothacehe/guile-newt")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"02p0bi6c05699idgx6gfkljhqgi8zf09clhzx81i8wa064s70r1y")))))))
(define (installer-program) (define (installer-program)
"Return a file-like object that runs the given INSTALLER." "Return a file-like object that runs the given INSTALLER."
(define init-gettext (define init-gettext

98
gnu/installer/final.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -28,6 +28,12 @@
#:use-module (gnu build accounts) #:use-module (gnu build accounts)
#:use-module ((gnu system shadow) #:prefix sys:) #:use-module ((gnu system shadow) #:prefix sys:)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:use-module (ice-9 ftw)
#:use-module (ice-9 popen)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (ice-9 rdelim)
#:export (install-system)) #:export (install-system))
(define %seed (define %seed
@ -97,24 +103,92 @@ USERS."
(write-passwd password (string-append etc "/passwd")) (write-passwd password (string-append etc "/passwd"))
(write-shadow shadow (string-append etc "/shadow"))) (write-shadow shadow (string-append etc "/shadow")))
(define* (kill-cow-users cow-path #:key (spare '("udevd")))
"Kill all processes that have references to the given COW-PATH in their
'maps' file. The process whose names are in SPARE list are spared."
(define %not-nul
(char-set-complement (char-set #\nul)))
(let ((pids
(filter-map (lambda (pid)
(call-with-input-file
(string-append "/proc/" pid "/maps")
(lambda (port)
(and (string-contains (get-string-all port)
cow-path)
(string->number pid)))))
(scandir "/proc" string->number))))
(for-each (lambda (pid)
;; cmdline does not always exist.
(false-if-exception
(call-with-input-file
(string-append "/proc/" (number->string pid) "/cmdline")
(lambda (port)
(match (string-tokenize (read-string port) %not-nul)
((argv0 _ ...)
(unless (member (pk (basename argv0)) spare)
(syslog "Killing process ~a~%" pid)
(kill pid SIGKILL)))
(_ #f))))))
pids)))
(define (umount-cow-store) (define (umount-cow-store)
"Remove the store overlay and the bind-mount on /tmp created by the "Remove the store overlay and the bind-mount on /tmp created by the
cow-store service." cow-store service. This procedure is very fragile and a better approach would
(let ((tmp-dir "/remove")) be much appreciated."
(mkdir-p tmp-dir)
(mount (%store-directory) tmp-dir "" MS_MOVE) ;; Remove when integrated in (gnu services herd).
(umount tmp-dir) (define (restart-service name)
(umount "/tmp"))) (with-shepherd-action name ('restart) result
result))
(catch #t
(lambda ()
(let ((tmp-dir "/remove"))
(mkdir-p tmp-dir)
(mount (%store-directory) tmp-dir "" MS_MOVE)
;; The guix-daemon has possibly opened files from the cow-store,
;; restart it.
(restart-service 'guix-daemon)
;; Kill all processes started while the cow-store was active (logins
;; on other TTYs for instance).
(kill-cow-users tmp-dir)
;; Try to umount the store overlay. Some process such as udevd
;; workers might still be active, so do some retries.
(let loop ((try 5))
(sleep 1)
(let ((umounted? (false-if-exception (umount tmp-dir))))
(if (and (not umounted?) (> try 0))
(loop (- try 1))
(if umounted?
(syslog "Umounted ~a successfully.~%" tmp-dir)
(syslog "Failed to umount ~a.~%" tmp-dir)))))
(umount "/tmp")))
(lambda args
(syslog "~a~%" args))))
(define* (install-system locale #:key (users '())) (define* (install-system locale #:key (users '()))
"Create /etc/shadow and /etc/passwd on the installation target for USERS. "Create /etc/shadow and /etc/passwd on the installation target for USERS.
Start COW-STORE service on target directory and launch guix install command in Start COW-STORE service on target directory and launch guix install command in
a subshell. LOCALE must be the locale name under which that command will run, a subshell. LOCALE must be the locale name under which that command will run,
or #f. Return #t on success and #f on failure." or #f. Return #t on success and #f on failure."
(let ((install-command (let* ((options (catch 'system-error
(format #f "guix system init --fallback ~a ~a" (lambda ()
(%installer-configuration-file) ;; If this file exists, it can provide
(%installer-target-dir)))) ;; additional command-line options.
(call-with-input-file
"/tmp/installer-system-init-options"
read))
(const '())))
(install-command (append (list "guix" "system" "init"
"--fallback")
options
(list (%installer-configuration-file)
(%installer-target-dir)))))
(mkdir-p (%installer-target-dir)) (mkdir-p (%installer-target-dir))
;; We want to initialize user passwords but we don't want to store them in ;; We want to initialize user passwords but we don't want to store them in
@ -128,7 +202,7 @@ or #f. Return #t on success and #f on failure."
(lambda () (lambda ()
(start-service 'cow-store (list (%installer-target-dir)))) (start-service 'cow-store (list (%installer-target-dir))))
(lambda () (lambda ()
(run-shell-command install-command #:locale locale)) (run-command install-command #:locale locale))
(lambda () (lambda ()
(stop-service 'cow-store) (stop-service 'cow-store)
;; Remove the store overlay created at cow-store service start. ;; Remove the store overlay created at cow-store service start.

40
gnu/installer/newt/final.scm
View File

@ -63,28 +63,38 @@ This will take a few minutes.")
(&installer-step-abort))))))) (&installer-step-abort)))))))
(define (run-install-success-page) (define (run-install-success-page)
(message-window (match (current-clients)
(G_ "Installation complete") (()
(G_ "Reboot") (message-window
(G_ "Congratulations! Installation is now complete. \ (G_ "Installation complete")
(G_ "Reboot")
(G_ "Congratulations! Installation is now complete. \
You may remove the device containing the installation image and \ You may remove the device containing the installation image and \
press the button to reboot.")) press the button to reboot.")))
(_
;; When there are clients connected, send them a message and keep going.
(send-to-clients '(installation-complete))))
;; Return success so that the installer happily reboots. ;; Return success so that the installer happily reboots.
'success) 'success)
(define (run-install-failed-page) (define (run-install-failed-page)
(match (choice-window (match (current-clients)
(G_ "Installation failed") (()
(G_ "Resume") (match (choice-window
(G_ "Restart the installer") (G_ "Installation failed")
(G_ "The final system installation step failed. You can resume from \ (G_ "Resume")
(G_ "Restart the installer")
(G_ "The final system installation step failed. You can resume from \
a specific step, or restart the installer.")) a specific step, or restart the installer."))
(1 (raise (1 (raise
(condition (condition
(&installer-step-abort)))) (&installer-step-abort))))
(2 (2
;; Keep going, the installer will be restarted later on. ;; Keep going, the installer will be restarted later on.
#t)))
(_
(send-to-clients '(installation-failure))
#t))) #t)))
(define* (run-install-shell locale (define* (run-install-shell locale

10
gnu/installer/newt/network.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -119,6 +119,10 @@ network devices were found. Do you want to continue anyway?"))
(define (wait-service-online) (define (wait-service-online)
"Display a newt scale until connman detects an Internet access. Do "Display a newt scale until connman detects an Internet access. Do
FULL-VALUE tentatives, spaced by 1 second." FULL-VALUE tentatives, spaced by 1 second."
(define (online?)
(or (connman-online?)
(file-exists? "/tmp/installer-assume-online")))
(let* ((full-value 5)) (let* ((full-value 5))
(run-scale-page (run-scale-page
#:title (G_ "Checking connectivity") #:title (G_ "Checking connectivity")
@ -127,10 +131,10 @@ FULL-VALUE tentatives, spaced by 1 second."
#:scale-update-proc #:scale-update-proc
(lambda (value) (lambda (value)
(sleep 1) (sleep 1)
(if (connman-online?) (if (online?)
full-value full-value
(+ value 1)))) (+ value 1))))
(unless (connman-online?) (unless (online?)
(run-error-page (run-error-page
(G_ "The selected network does not provide access to the \ (G_ "The selected network does not provide access to the \
Internet, please try again.") Internet, please try again.")

569
gnu/installer/newt/page.scm
View File

@ -19,6 +19,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer newt page) (define-module (gnu installer newt page)
#:use-module (gnu installer steps)
#:use-module (gnu installer utils) #:use-module (gnu installer utils)
#:use-module (gnu installer newt utils) #:use-module (gnu installer newt utils)
#:use-module (guix i18n) #:use-module (guix i18n)
@ -26,7 +27,10 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 receive) #:use-module (ice-9 receive)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (newt) #:use-module (newt)
#:export (draw-info-page #:export (draw-info-page
draw-connecting-page draw-connecting-page
@ -36,7 +40,9 @@
run-listbox-selection-page run-listbox-selection-page
run-scale-page run-scale-page
run-checkbox-tree-page run-checkbox-tree-page
run-file-textbox-page)) run-file-textbox-page
run-form-with-clients))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -49,9 +55,123 @@
;;; ;;;
;;; Code: ;;; Code:
(define* (watch-clients! form #:optional (clients (current-clients)))
"Have FORM watch the file descriptors corresponding to current client
connections. Consequently, FORM may exit with the 'exit-fd-ready' reason."
(when (current-server-socket)
(form-watch-fd form (fileno (current-server-socket))
FD-READ))
(for-each (lambda (client)
(form-watch-fd form (fileno client)
(logior FD-READ FD-EXCEPT)))
clients))
(define close-port-and-reuse-fd
(let ((bit-bucket #f))
(lambda (port)
"Close PORT and redirect its underlying FD to point to a valid open file
descriptor."
(let ((fd (fileno port)))
(unless bit-bucket
(set! bit-bucket (car (pipe))))
(close-port port)
;; FIXME: We're leaking FD.
(dup2 (fileno bit-bucket) fd)))))
(define* (run-form-with-clients form exp)
"Run FORM such as it watches the file descriptors beneath CLIENTS after
sending EXP to all the clients.
Automatically restart the form when it exits with 'exit-fd-ready but without
an actual client reply--e.g., it got a connection request or a client
disconnect.
Like 'run-form', return two values: the exit reason, and an \"argument\"."
(define* (discard-client! port #:optional errno)
(if errno
(syslog "removing client ~d due to ~s~%"
(fileno port) (strerror errno))
(syslog "removing client ~d due to EOF~%"
(fileno port)))
;; XXX: Watch out! There's no 'form-unwatch-fd' procedure in Newt so we
;; cheat: we keep PORT's file descriptor open, but make it a duplicate of
;; a valid but inactive FD. Failing to do that, 'run-form' would
;; select(2) on the now-closed port and keep spinning as select(2) returns
;; EBADF.
(close-port-and-reuse-fd port)
(current-clients (delq port (current-clients)))
(close-port port))
(define title
;; Title of FORM.
(match exp
(((? symbol? tag) alist ...)
(match (assq 'title alist)
((_ title) title)
(_ tag)))
(((? symbol? tag) _ ...)
tag)
(_
'unknown)))
;; Send EXP to all the currently-connected clients.
(send-to-clients exp)
(let loop ()
(syslog "running form ~s (~s) with ~d clients~%"
form title (length (current-clients)))
;; Call 'watch-clients!' within the loop because there might be new
;; clients.
(watch-clients! form)
(let-values (((reason argument) (run-form form)))
(match reason
('exit-fd-ready
(match (fdes->ports argument)
((port _ ...)
(if (memq port (current-clients))
;; Read a reply from a client or handle its departure.
(catch 'system-error
(lambda ()
(match (read port)
((? eof-object? eof)
(discard-client! port)
(loop))
(obj
(syslog "form ~s (~s): client ~d replied ~s~%"
form title (fileno port) obj)
(values 'exit-fd-ready obj))))
(lambda args
(discard-client! port (system-error-errno args))
(loop)))
;; Accept a new client and send it EXP.
(match (accept port)
((client . _)
(syslog "accepting new client ~d while on form ~s~%"
(fileno client) form)
(catch 'system-error
(lambda ()
(write exp client)
(newline client)
(force-output client)
(current-clients (cons client (current-clients))))
(lambda _
(close-port client)))
(loop)))))))
(_
(values reason argument))))))
(define (draw-info-page text title) (define (draw-info-page text title)
"Draw an informative page with the given TEXT as content. Set the title of "Draw an informative page with the given TEXT as content. Set the title of
this page to TITLE." this page to TITLE."
(send-to-clients `(info (title ,title) (text ,text)))
(let* ((text-box (let* ((text-box
(make-reflowed-textbox -1 -1 text 40 (make-reflowed-textbox -1 -1 text 40
#:flags FLAG-BORDER)) #:flags FLAG-BORDER))
@ -126,20 +246,25 @@ input box, such as FLAG-PASSWORD."
(G_ "Empty input"))))) (G_ "Empty input")))))
(let loop () (let loop ()
(receive (exit-reason argument) (receive (exit-reason argument)
(run-form form) (run-form-with-clients form
(let ((input (entry-value input-entry))) `(input (title ,title) (text ,text)
(if (and (not allow-empty-input?) (default ,default-text)))
(eq? exit-reason 'exit-component) (let ((input (if (eq? exit-reason 'exit-fd-ready)
(string=? input "")) argument
(begin (entry-value input-entry))))
;; Display the error page. (cond ((not input) ;client disconnect or something
(error-page) (loop))
;; Set the focus back to the input input field. ((and (not allow-empty-input?)
(set-current-component form input-entry) (eq? exit-reason 'exit-component)
(loop)) (string=? input ""))
(begin ;; Display the error page.
(destroy-form-and-pop form) (error-page)
input)))))))) ;; Set the focus back to the input input field.
(set-current-component form input-entry)
(loop))
(else
(destroy-form-and-pop form)
input))))))))
(define (run-error-page text title) (define (run-error-page text title)
"Run a page to inform the user of an error. The page contains the given TEXT "Run a page to inform the user of an error. The page contains the given TEXT
@ -160,7 +285,8 @@ of the page is set to TITLE."
(newt-set-color COLORSET-ROOT "white" "red") (newt-set-color COLORSET-ROOT "white" "red")
(add-components-to-form form text-box ok-button) (add-components-to-form form text-box ok-button)
(make-wrapped-grid-window grid title) (make-wrapped-grid-window grid title)
(run-form form) (run-form-with-clients form
`(error (title ,title) (text ,text)))
;; Restore the background to its original color. ;; Restore the background to its original color.
(newt-set-color COLORSET-ROOT "white" "blue") (newt-set-color COLORSET-ROOT "white" "blue")
(destroy-form-and-pop form))) (destroy-form-and-pop form)))
@ -187,17 +313,23 @@ of the page is set to TITLE."
(make-wrapped-grid-window grid title) (make-wrapped-grid-window grid title)
(receive (exit-reason argument) (receive (exit-reason argument)
(run-form form) (run-form-with-clients form
`(confirmation (title ,title)
(text ,text)))
(dynamic-wind (dynamic-wind
(const #t) (const #t)
(lambda () (lambda ()
(case exit-reason (match exit-reason
((exit-component) ('exit-component
(cond (cond
((components=? argument ok-button) ((components=? argument ok-button)
#t) #t)
((components=? argument exit-button) ((components=? argument exit-button)
(exit-button-procedure)))))) (exit-button-procedure))))
('exit-fd-ready
(if argument
#t
(exit-button-procedure)))))
(lambda () (lambda ()
(destroy-form-and-pop form)))))) (destroy-form-and-pop form))))))
@ -222,6 +354,8 @@ of the page is set to TITLE."
(const #t)) (const #t))
(listbox-callback-procedure (listbox-callback-procedure
identity) identity)
(client-callback-procedure
listbox-callback-procedure)
(hotkey-callback-procedure (hotkey-callback-procedure
(const #t))) (const #t)))
"Run a page asking the user to select an item in a listbox. The page "Run a page asking the user to select an item in a listbox. The page
@ -254,9 +388,9 @@ Each time the listbox current item changes, call SKIP-ITEM-PROCEDURE? with the
current listbox item as argument. If it returns #t, skip the element and jump current listbox item as argument. If it returns #t, skip the element and jump
to the next/previous one depending on the previous item, otherwise do to the next/previous one depending on the previous item, otherwise do
nothing." nothing."
(let loop ()
(define (fill-listbox listbox items) (define (fill-listbox listbox items)
"Append the given ITEMS to LISTBOX, once they have been converted to text "Append the given ITEMS to LISTBOX, once they have been converted to text
with LISTBOX-ITEM->TEXT. Each item appended to the LISTBOX is given a key by with LISTBOX-ITEM->TEXT. Each item appended to the LISTBOX is given a key by
newt. Save this key by returning an association list under the form: newt. Save this key by returning an association list under the form:
@ -264,144 +398,165 @@ newt. Save this key by returning an association list under the form:
where NEWT-LISTBOX-KEY is the key returned by APPEND-ENTRY-TO-LISTBOX, when where NEWT-LISTBOX-KEY is the key returned by APPEND-ENTRY-TO-LISTBOX, when
ITEM was inserted into LISTBOX." ITEM was inserted into LISTBOX."
(map (lambda (item) (map (lambda (item)
(let* ((text (listbox-item->text item)) (let* ((text (listbox-item->text item))
(key (append-entry-to-listbox listbox text))) (key (append-entry-to-listbox listbox text)))
(cons key item))) (cons key item)))
items)) items))
(define (sort-listbox-items listbox-items) (define (sort-listbox-items listbox-items)
"Return LISTBOX-ITEMS sorted using the 'string-locale<?' procedure on the text "Return LISTBOX-ITEMS sorted using the 'string-locale<?' procedure on the text
corresponding to each item in the list." corresponding to each item in the list."
(let* ((items (map (lambda (item) (let* ((items (map (lambda (item)
(cons item (listbox-item->text item))) (cons item (listbox-item->text item)))
listbox-items)) listbox-items))
(sorted-items (sorted-items
(sort items (lambda (a b) (sort items (lambda (a b)
(let ((text-a (cdr a)) (let ((text-a (cdr a))
(text-b (cdr b))) (text-b (cdr b)))
(string-locale<? text-a text-b)))))) (string-locale<? text-a text-b))))))
(map car sorted-items))) (map car sorted-items)))
;; Store the last selected listbox item's key. ;; Store the last selected listbox item's key.
(define last-listbox-key (make-parameter #f)) (define last-listbox-key (make-parameter #f))
(define (previous-key keys key) (define (previous-key keys key)
(let ((index (list-index (cut eq? key <>) keys))) (let ((index (list-index (cut eq? key <>) keys)))
(and index (and index
(> index 0) (> index 0)
(list-ref keys (- index 1))))) (list-ref keys (- index 1)))))
(define (next-key keys key) (define (next-key keys key)
(let ((index (list-index (cut eq? key <>) keys))) (let ((index (list-index (cut eq? key <>) keys)))
(and index (and index
(< index (- (length keys) 1)) (< index (- (length keys) 1))
(list-ref keys (+ index 1))))) (list-ref keys (+ index 1)))))
(define (set-default-item listbox listbox-keys default-item) (define (set-default-item listbox listbox-keys default-item)
"Set the default item of LISTBOX to DEFAULT-ITEM. LISTBOX-KEYS is the "Set the default item of LISTBOX to DEFAULT-ITEM. LISTBOX-KEYS is the
association list returned by the FILL-LISTBOX procedure. It is used because association list returned by the FILL-LISTBOX procedure. It is used because
the current listbox item has to be selected by key." the current listbox item has to be selected by key."
(for-each (match-lambda (for-each (match-lambda
((key . item) ((key . item)
(when (equal? item default-item) (when (equal? item default-item)
(set-current-listbox-entry-by-key listbox key)))) (set-current-listbox-entry-by-key listbox key))))
listbox-keys)) listbox-keys))
(let* ((listbox (make-listbox (let* ((listbox (make-listbox
-1 -1 -1 -1
listbox-height listbox-height
(logior FLAG-SCROLL FLAG-BORDER FLAG-RETURNEXIT (logior FLAG-SCROLL FLAG-BORDER FLAG-RETURNEXIT
(if listbox-allow-multiple? (if listbox-allow-multiple?
FLAG-MULTIPLE FLAG-MULTIPLE
0)))) 0))))
(form (make-form #:flags FLAG-NOF12)) (form (make-form #:flags FLAG-NOF12))
(info-textbox (info-textbox
(make-reflowed-textbox -1 -1 info-text (make-reflowed-textbox -1 -1 info-text
info-textbox-width info-textbox-width
#:flags FLAG-BORDER)) #:flags FLAG-BORDER))
(button (make-button -1 -1 button-text)) (button (make-button -1 -1 button-text))
(button2 (and button2-text (button2 (and button2-text
(make-button -1 -1 button2-text))) (make-button -1 -1 button2-text)))
(grid (vertically-stacked-grid (grid (vertically-stacked-grid
GRID-ELEMENT-COMPONENT info-textbox GRID-ELEMENT-COMPONENT info-textbox
GRID-ELEMENT-COMPONENT listbox GRID-ELEMENT-COMPONENT listbox
GRID-ELEMENT-SUBGRID GRID-ELEMENT-SUBGRID
(apply (apply
horizontal-stacked-grid horizontal-stacked-grid
GRID-ELEMENT-COMPONENT button GRID-ELEMENT-COMPONENT button
`(,@(if button2 `(,@(if button2
(list GRID-ELEMENT-COMPONENT button2) (list GRID-ELEMENT-COMPONENT button2)
'()))))) '())))))
(sorted-items (if sort-listbox-items? (sorted-items (if sort-listbox-items?
(sort-listbox-items listbox-items) (sort-listbox-items listbox-items)
listbox-items)) listbox-items))
(keys (fill-listbox listbox sorted-items))) (keys (fill-listbox listbox sorted-items)))
;; On every listbox element change, check if we need to skip it. If yes, (define (choice->item str)
;; depending on the 'last-listbox-key', jump forward or backward. If no, ;; Return the item that corresponds to STR.
;; do nothing. (match (find (match-lambda
(add-component-callback ((key . item)
listbox (string=? str (listbox-item->text item))))
(lambda (component) keys)
(let* ((current-key (current-listbox-entry listbox)) ((key . item) item)
(listbox-keys (map car keys)) (#f (raise (condition (&installer-step-abort))))))
(last-key (last-listbox-key))
(item (assoc-ref keys current-key))
(prev-key (previous-key listbox-keys current-key))
(next-key (next-key listbox-keys current-key)))
;; Update last-listbox-key before a potential call to
;; set-current-listbox-entry-by-key, because it will immediately
;; cause this callback to be called for the new entry.
(last-listbox-key current-key)
(when (skip-item-procedure? item)
(when (eq? prev-key last-key)
(if next-key
(set-current-listbox-entry-by-key listbox next-key)
(set-current-listbox-entry-by-key listbox prev-key)))
(when (eq? next-key last-key)
(if prev-key
(set-current-listbox-entry-by-key listbox prev-key)
(set-current-listbox-entry-by-key listbox next-key)))))))
(when listbox-default-item ;; On every listbox element change, check if we need to skip it. If yes,
(set-default-item listbox keys listbox-default-item)) ;; depending on the 'last-listbox-key', jump forward or backward. If no,
;; do nothing.
(add-component-callback
listbox
(lambda (component)
(let* ((current-key (current-listbox-entry listbox))
(listbox-keys (map car keys))
(last-key (last-listbox-key))
(item (assoc-ref keys current-key))
(prev-key (previous-key listbox-keys current-key))
(next-key (next-key listbox-keys current-key)))
;; Update last-listbox-key before a potential call to
;; set-current-listbox-entry-by-key, because it will immediately
;; cause this callback to be called for the new entry.
(last-listbox-key current-key)
(when (skip-item-procedure? item)
(when (eq? prev-key last-key)
(if next-key
(set-current-listbox-entry-by-key listbox next-key)
(set-current-listbox-entry-by-key listbox prev-key)))
(when (eq? next-key last-key)
(if prev-key
(set-current-listbox-entry-by-key listbox prev-key)
(set-current-listbox-entry-by-key listbox next-key)))))))
(when allow-delete? (when listbox-default-item
(form-add-hotkey form KEY-DELETE)) (set-default-item listbox keys listbox-default-item))
(add-form-to-grid grid form #t) (when allow-delete?
(make-wrapped-grid-window grid title) (form-add-hotkey form KEY-DELETE))
(receive (exit-reason argument) (add-form-to-grid grid form #t)
(run-form form) (make-wrapped-grid-window grid title)
(dynamic-wind
(const #t) (receive (exit-reason argument)
(lambda () (run-form-with-clients form
(case exit-reason `(list-selection (title ,title)
((exit-component) (multiple-choices?
(cond ,listbox-allow-multiple?)
((components=? argument button) (items
(button-callback-procedure)) ,(map listbox-item->text
((and button2 listbox-items))))
(components=? argument button2)) (dynamic-wind
(button2-callback-procedure)) (const #t)
((components=? argument listbox) (lambda ()
(if listbox-allow-multiple? (match exit-reason
(let* ((entries (listbox-selection listbox)) ('exit-component
(items (map (lambda (entry) (cond
(assoc-ref keys entry)) ((components=? argument button)
entries))) (button-callback-procedure))
(listbox-callback-procedure items)) ((and button2
(let* ((entry (current-listbox-entry listbox)) (components=? argument button2))
(item (assoc-ref keys entry))) (button2-callback-procedure))
(listbox-callback-procedure item)))))) ((components=? argument listbox)
((exit-hotkey) (if listbox-allow-multiple?
(let* ((entry (current-listbox-entry listbox)) (let* ((entries (listbox-selection listbox))
(item (assoc-ref keys entry))) (items (map (lambda (entry)
(hotkey-callback-procedure argument item))))) (assoc-ref keys entry))
(lambda () entries)))
(destroy-form-and-pop form)))))) (listbox-callback-procedure items))
(let* ((entry (current-listbox-entry listbox))
(item (assoc-ref keys entry)))
(listbox-callback-procedure item))))))
('exit-fd-ready
(let* ((choice argument)
(item (if listbox-allow-multiple?
(map choice->item choice)
(choice->item choice))))
(client-callback-procedure item)))
('exit-hotkey
(let* ((entry (current-listbox-entry listbox))
(item (assoc-ref keys entry)))
(hotkey-callback-procedure argument item)))))
(lambda ()
(destroy-form-and-pop form)))))))
(define* (run-scale-page #:key (define* (run-scale-page #:key
title title
@ -498,48 +653,65 @@ ITEMS when 'Ok' is pressed."
items items
selection)) selection))
(let* ((checkbox-tree (let loop ()
(make-checkboxtree -1 -1 (let* ((checkbox-tree
checkbox-tree-height (make-checkboxtree -1 -1
FLAG-BORDER)) checkbox-tree-height
(info-textbox FLAG-BORDER))
(make-reflowed-textbox -1 -1 info-text (info-textbox
info-textbox-width (make-reflowed-textbox -1 -1 info-text
#:flags FLAG-BORDER)) info-textbox-width
(ok-button (make-button -1 -1 (G_ "OK"))) #:flags FLAG-BORDER))
(exit-button (make-button -1 -1 (G_ "Exit"))) (ok-button (make-button -1 -1 (G_ "OK")))
(grid (vertically-stacked-grid (exit-button (make-button -1 -1 (G_ "Exit")))
GRID-ELEMENT-COMPONENT info-textbox (grid (vertically-stacked-grid
GRID-ELEMENT-COMPONENT checkbox-tree GRID-ELEMENT-COMPONENT info-textbox
GRID-ELEMENT-SUBGRID GRID-ELEMENT-COMPONENT checkbox-tree
(horizontal-stacked-grid GRID-ELEMENT-SUBGRID
GRID-ELEMENT-COMPONENT ok-button (horizontal-stacked-grid
GRID-ELEMENT-COMPONENT exit-button))) GRID-ELEMENT-COMPONENT ok-button
(keys (fill-checkbox-tree checkbox-tree items)) GRID-ELEMENT-COMPONENT exit-button)))
(form (make-form #:flags FLAG-NOF12))) (keys (fill-checkbox-tree checkbox-tree items))
(form (make-form #:flags FLAG-NOF12)))
(add-form-to-grid grid form #t) (define (choice->item str)
(make-wrapped-grid-window grid title) ;; Return the item that corresponds to STR.
(match (find (match-lambda
((key . item)
(string=? str (item->text item))))
keys)
((key . item) item)
(#f (raise (condition (&installer-step-abort))))))
(receive (exit-reason argument) (add-form-to-grid grid form #t)
(run-form form) (make-wrapped-grid-window grid title)
(dynamic-wind
(const #t) (receive (exit-reason argument)
(lambda () (run-form-with-clients form
(case exit-reason `(checkbox-list (title ,title)
((exit-component) (text ,info-text)
(cond (items
((components=? argument ok-button) ,(map item->text items))))
(let* ((entries (current-checkbox-selection checkbox-tree)) (dynamic-wind
(current-items (map (lambda (entry) (const #t)
(assoc-ref keys entry))
entries))) (lambda ()
(ok-button-callback-procedure) (match exit-reason
current-items)) ('exit-component
((components=? argument exit-button) (cond
(exit-button-callback-procedure)))))) ((components=? argument ok-button)
(lambda () (let* ((entries (current-checkbox-selection checkbox-tree))
(destroy-form-and-pop form)))))) (current-items (map (lambda (entry)
(assoc-ref keys entry))
entries)))
(ok-button-callback-procedure)
current-items))
((components=? argument exit-button)
(exit-button-callback-procedure))))
('exit-fd-ready
(map choice->item argument))))
(lambda ()
(destroy-form-and-pop form)))))))
(define* (edit-file file #:key locale) (define* (edit-file file #:key locale)
"Spawn an editor for FILE." "Spawn an editor for FILE."
@ -547,9 +719,8 @@ ITEMS when 'Ok' is pressed."
(newt-suspend) (newt-suspend)
;; Use Nano because it syntax-highlights Scheme by default. ;; Use Nano because it syntax-highlights Scheme by default.
;; TODO: Add a menu to choose an editor? ;; TODO: Add a menu to choose an editor?
(run-shell-command (string-append "/run/current-system/profile/bin/nano " (run-command (list "/run/current-system/profile/bin/nano" file)
file) #:locale locale)
#:locale locale)
(newt-resume)) (newt-resume))
(define* (run-file-textbox-page #:key (define* (run-file-textbox-page #:key
@ -606,13 +777,16 @@ ITEMS when 'Ok' is pressed."
text)) text))
(receive (exit-reason argument) (receive (exit-reason argument)
(run-form form) (run-form-with-clients form
`(file-dialog (title ,title)
(text ,info-text)
(file ,file)))
(define result (define result
(dynamic-wind (dynamic-wind
(const #t) (const #t)
(lambda () (lambda ()
(case exit-reason (match exit-reason
((exit-component) ('exit-component
(cond (cond
((components=? argument ok-button) ((components=? argument ok-button)
(ok-button-callback-procedure)) (ok-button-callback-procedure))
@ -621,10 +795,15 @@ ITEMS when 'Ok' is pressed."
(exit-button-callback-procedure)) (exit-button-callback-procedure))
((and edit-button? ((and edit-button?
(components=? argument edit-button)) (components=? argument edit-button))
(edit-file file)))))) (edit-file file))))
('exit-fd-ready
(if argument
(ok-button-callback-procedure)
(exit-button-callback-procedure)))))
(lambda () (lambda ()
(destroy-form-and-pop form)))) (destroy-form-and-pop form))))
(if (components=? argument edit-button) (if (and (eq? exit-reason 'exit-component)
(components=? argument edit-button))
(loop) ;recurse in tail position (loop) ;recurse in tail position
result))))) result)))))

8
gnu/installer/newt/partition.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -682,6 +682,12 @@ by pressing the Exit button.~%~%")))
#:allow-delete? #t #:allow-delete? #t
#:button-text (G_ "OK") #:button-text (G_ "OK")
#:button-callback-procedure button-ok-action #:button-callback-procedure button-ok-action
;; Consider client replies equivalent to hitting the "OK" button.
;; XXX: In practice this means that clients cannot do anything but
;; approve the predefined list of partitions.
#:client-callback-procedure (lambda (_) (button-ok-action))
#:button2-text (G_ "Exit") #:button2-text (G_ "Exit")
#:button2-callback-procedure button-exit-action #:button2-callback-procedure button-exit-action
#:listbox-callback-procedure listbox-action #:listbox-callback-procedure listbox-action

64
gnu/installer/newt/user.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -23,6 +23,7 @@
#:use-module ((gnu installer steps) #:select (&installer-step-abort)) #:use-module ((gnu installer steps) #:select (&installer-step-abort))
#:use-module (gnu installer newt page) #:use-module (gnu installer newt page)
#:use-module (gnu installer newt utils) #:use-module (gnu installer newt utils)
#:use-module (gnu installer utils)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (newt) #:use-module (newt)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -115,6 +116,7 @@ REAL-NAME, and HOME-DIRECTORY as the initial values in the form."
GRID-ELEMENT-SUBGRID entry-grid GRID-ELEMENT-SUBGRID entry-grid
GRID-ELEMENT-SUBGRID button-grid) GRID-ELEMENT-SUBGRID button-grid)
title) title)
(let ((error-page (let ((error-page
(lambda () (lambda ()
(run-error-page (G_ "Empty inputs are not allowed.") (run-error-page (G_ "Empty inputs are not allowed.")
@ -230,33 +232,45 @@ administrator (\"root\").")
(set-current-component form ok-button)) (set-current-component form ok-button))
(receive (exit-reason argument) (receive (exit-reason argument)
(run-form form) (run-form-with-clients form '(add-users))
(dynamic-wind (dynamic-wind
(const #t) (const #t)
(lambda () (lambda ()
(when (eq? exit-reason 'exit-component) (match exit-reason
(cond ('exit-component
((components=? argument add-button) (cond
(run (cons (run-user-add-page) users))) ((components=? argument add-button)
((components=? argument del-button) (run (cons (run-user-add-page) users)))
(let* ((current-user-key (current-listbox-entry listbox)) ((components=? argument del-button)
(users (let* ((current-user-key (current-listbox-entry listbox))
(map (cut assoc-ref <> 'user) (users
(remove (lambda (element) (map (cut assoc-ref <> 'user)
(equal? (assoc-ref element 'key) (remove (lambda (element)
current-user-key)) (equal? (assoc-ref element 'key)
listbox-elements)))) current-user-key))
(run users))) listbox-elements))))
((components=? argument ok-button) (run users)))
(when (null? users) ((components=? argument ok-button)
(run-error-page (G_ "Please create at least one user.") (when (null? users)
(G_ "No user")) (run-error-page (G_ "Please create at least one user.")
(run users)) (G_ "No user"))
(reverse users)) (run users))
((components=? argument exit-button) (reverse users))
(raise ((components=? argument exit-button)
(condition (raise
(&installer-step-abort))))))) (condition
(&installer-step-abort))))))
('exit-fd-ready
;; Read the complete user list at once.
(match argument
((('user ('name names) ('real-name real-names)
('home-directory homes) ('password passwords))
..1)
(map (lambda (name real-name home password)
(user (name name) (real-name real-name)
(home-directory home)
(password password)))
names real-names homes passwords))))))
(lambda () (lambda ()
(destroy-form-and-pop form)))))) (destroy-form-and-pop form))))))

44
gnu/installer/newt/welcome.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -11,16 +12,20 @@
;;; GNU Guix is distributed in the hope that it will be useful, but ;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; ;;;
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer newt welcome) (define-module (gnu installer newt welcome)
#:use-module (gnu installer steps)
#:use-module (gnu installer utils) #:use-module (gnu installer utils)
#:use-module (gnu installer newt page)
#:use-module (gnu installer newt utils) #:use-module (gnu installer newt utils)
#:use-module (guix build syscalls) #:use-module (guix build syscalls)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 receive) #:use-module (ice-9 receive)
#:use-module (newt) #:use-module (newt)
@ -66,24 +71,43 @@ we want this page to occupy all the screen space available."
GRID-ELEMENT-COMPONENT options-listbox)) GRID-ELEMENT-COMPONENT options-listbox))
(form (make-form))) (form (make-form)))
(define (choice->item str)
;; Return the item that corresponds to STR.
(match (find (match-lambda
((key . item)
(string=? str (listbox-item->text item))))
keys)
((key . item) item)
(#f (raise (condition (&installer-step-abort))))))
(set-textbox-text logo-textbox (read-all logo)) (set-textbox-text logo-textbox (read-all logo))
(add-form-to-grid grid form #t) (add-form-to-grid grid form #t)
(make-wrapped-grid-window grid title) (make-wrapped-grid-window grid title)
(receive (exit-reason argument) (receive (exit-reason argument)
(run-form form) (run-form-with-clients form
`(menu (title ,title)
(text ,info-text)
(items
,(map listbox-item->text
listbox-items))))
(dynamic-wind (dynamic-wind
(const #t) (const #t)
(lambda () (lambda ()
(when (eq? exit-reason 'exit-component) (match exit-reason
(cond ('exit-component
((components=? argument options-listbox) (let* ((entry (current-listbox-entry options-listbox))
(let* ((entry (current-listbox-entry options-listbox)) (item (assoc-ref keys entry)))
(item (assoc-ref keys entry))) (match item
(match item ((text . proc)
((text . proc) (proc)))))
(proc)))))))) ('exit-fd-ready
(let* ((choice argument)
(item (choice->item choice)))
(match item
((text . proc)
(proc)))))))
(lambda () (lambda ()
(destroy-form-and-pop form)))))) (destroy-form-and-pop form))))))

25
gnu/installer/steps.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,6 +20,7 @@
(define-module (gnu installer steps) (define-module (gnu installer steps)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (gnu installer utils)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 pretty-print) #:use-module (ice-9 pretty-print)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -185,13 +187,18 @@ return the accumalated result so far."
#:todo-steps rest-steps #:todo-steps rest-steps
#:done-steps (append done-steps (list step)))))))) #:done-steps (append done-steps (list step))))))))
(call-with-prompt 'raise-above ;; Ignore SIGPIPE so that we don't die if a client closes the connection
(lambda () ;; prematurely.
(run '() (sigaction SIGPIPE SIG_IGN)
#:todo-steps steps
#:done-steps '())) (with-server-socket
(lambda (k condition) (call-with-prompt 'raise-above
(raise condition)))) (lambda ()
(run '()
#:todo-steps steps
#:done-steps '()))
(lambda (k condition)
(raise condition)))))
(define (find-step-by-id steps id) (define (find-step-by-id steps id)
"Find and return the step in STEPS whose id is equal to ID." "Find and return the step in STEPS whose id is equal to ID."
@ -249,3 +256,7 @@ found in RESULTS."
(pretty-print part port))) (pretty-print part port)))
configuration) configuration)
(flush-output-port port)))) (flush-output-port port))))
;;; Local Variables:
;;; eval: (put 'with-server-socket 'scheme-indent-function 0)
;;; End:

340
gnu/installer/tests.scm 100644
View File

@ -0,0 +1,340 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer tests)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 pretty-print)
#:export (&pattern-not-matched
pattern-not-matched?
%installer-socket-file
open-installer-socket
converse
conversation-log-port
choose-locale+keyboard
enter-host-name+passwords
choose-services
choose-partitioning
conclude-installation
edit-configuration-file))
;;; Commentary:
;;;
;;; This module provides tools to test the guided "graphical" installer in a
;;; non-interactive fashion. The core of it is 'converse': it allows you to
;;; state Expect-style dialogues, which happen over the Unix-domain socket the
;;; installer listens to. Higher-level procedures such as
;;; 'choose-locale+keyboard' are provided to perform specific parts of the
;;; dialogue.
;;;
;;; Code:
(define %installer-socket-file
;; Socket the installer listens to.
"/var/guix/installer-socket")
(define* (open-installer-socket #:optional (file %installer-socket-file))
"Return a socket connected to the installer."
(let ((sock (socket AF_UNIX SOCK_STREAM 0)))
(connect sock AF_UNIX file)
sock))
(define-condition-type &pattern-not-matched &error
pattern-not-matched?
(pattern pattern-not-matched-pattern)
(sexp pattern-not-matched-sexp))
(define (pattern-error pattern sexp)
(raise (condition
(&pattern-not-matched
(pattern pattern) (sexp sexp)))))
(define conversation-log-port
;; Port where debugging info is logged
(make-parameter (current-error-port)))
(define (converse-debug pattern)
(format (conversation-log-port)
"conversation expecting pattern ~s~%"
pattern))
(define-syntax converse
(lambda (s)
"Convert over PORT: read sexps from there, match them against each
PATTERN, and send the corresponding REPLY. Raise to '&pattern-not-matched'
when one of the PATTERNs is not matched."
;; XXX: Strings that appear in PATTERNs must be in the language the
;; installer is running in. In the future, we should add support to allow
;; writing English strings in PATTERNs and have the pattern matcher
;; automatically translate them.
;; Here we emulate 'pmatch' syntax on top of 'match'. This is ridiculous
;; but that's because 'pmatch' compares objects with 'eq?', making it
;; pretty useless, and it doesn't support ellipses and such.
(define (quote-pattern s)
;; Rewrite the pattern S from pmatch style (a ,b) to match style like
;; ('a b).
(with-ellipsis :::
(syntax-case s (unquote _ ...)
((unquote id) #'id)
(_ #'_)
(... #'...)
(id
(identifier? #'id)
#''id)
((lst :::) (map quote-pattern #'(lst :::)))
(pattern #'pattern))))
(define (match-pattern s)
;; Match one pattern without a guard.
(syntax-case s ()
((port (pattern reply) continuation)
(with-syntax ((pattern (quote-pattern #'pattern)))
#'(let ((pat 'pattern))
(converse-debug pat)
(match (read port)
(pattern
(let ((data (call-with-values (lambda () reply)
list)))
(for-each (lambda (obj)
(write obj port)
(newline port))
data)
(force-output port)
(continuation port)))
(sexp
(pattern-error pat sexp))))))))
(syntax-case s ()
((_ port (pattern reply) rest ...)
(match-pattern #'(port (pattern reply)
(lambda (port)
(converse port rest ...)))))
((_ port (pattern guard reply) rest ...)
#`(let ((skip? (not guard))
(next (lambda (p)
(converse p rest ...))))
(if skip?
(next port)
#,(match-pattern #'(port (pattern reply) next)))))
((_ port)
#t))))
(define* (choose-locale+keyboard port
#:key
(language "English")
(location "Hong Kong")
(timezone '("Europe" "Zagreb"))
(keyboard
'("English (US)"
"English (intl., with AltGr dead keys)")))
"Converse over PORT with the guided installer to choose the specified
LANGUAGE, LOCATION, TIMEZONE, and KEYBOARD."
(converse port
((list-selection (title "Locale language")
(multiple-choices? #f)
(items _))
language)
((list-selection (title "Locale location")
(multiple-choices? #f)
(items _))
location)
((menu (title "GNU Guix install")
(text _)
(items (,guided _ ...))) ;"Guided graphical installation"
guided)
((list-selection (title "Timezone")
(multiple-choices? #f)
(items _))
(first timezone))
((list-selection (title "Timezone")
(multiple-choices? #f)
(items _))
(second timezone))
((list-selection (title "Layout")
(multiple-choices? #f)
(items _))
(first keyboard))
((list-selection (title "Variant")
(multiple-choices? #f)
(items _))
(second keyboard))))
(define* (enter-host-name+passwords port
#:key
(host-name "guix")
(root-password "foo")
(users '(("alice" "pass1")
("bob" "pass2")
("charlie" "pass3"))))
"Converse over PORT with the guided installer to choose HOST-NAME,
ROOT-PASSWORD, and USERS."
(converse port
((input (title "Hostname") (text _) (default _))
host-name)
((input (title "System administrator password") (text _) (default _))
root-password)
((input (title "Password confirmation required") (text _) (default _))
root-password)
((add-users)
(match users
(((names passwords) ...)
(map (lambda (name password)
`(user (name ,name) (real-name ,(string-titlecase name))
(home-directory ,(string-append "/home/" name))
(password ,password)))
names passwords))))))
(define* (choose-services port
#:key
(desktop-environments '("GNOME"))
(choose-network-service?
(lambda (service)
(or (string-contains service "SSH")
(string-contains service "NSS"))))
(choose-network-management-tool?
(lambda (service)
(string-contains service "DHCP"))))
"Converse over PORT to choose networking services."
(converse port
((checkbox-list (title "Desktop environment") (text _)
(items _))
desktop-environments)
((checkbox-list (title "Network service") (text _)
(items ,services))
(filter choose-network-service? services))
;; The "Network management" dialog shows up only when no desktop
;; environments have been selected, hence the guard.
((list-selection (title "Network management")
(multiple-choices? #f)
(items ,services))
(null? desktop-environments)
(find choose-network-management-tool? services))))
(define (edit-configuration-file file)
"Edit FILE, an operating system configuration file generated by the
installer, by adding a marionette service such that the installed OS is
instrumented for further testing."
(define (read-expressions port)
(let loop ((result '()))
(match (read port)
((? eof-object?)
(reverse result))
(exp
(loop (cons exp result))))))
(define (edit exp)
(match exp
(('operating-system _ ...)
`(marionette-operating-system ,exp
#:imported-modules
'((gnu services herd)
(guix build utils)
(guix combinators))))
(_
exp)))
(let ((content (call-with-input-file file read-expressions)))
(call-with-output-file file
(lambda (port)
(format port "\
;; Operating system configuration edited for automated testing.~%~%")
(pretty-print '(use-modules (gnu tests)) port)
(for-each (lambda (exp)
(pretty-print (edit exp) port)
(newline port))
content)))
#t))
(define* (choose-partitioning port
#:key
(encrypted? #t)
(passphrase "thepassphrase")
(edit-configuration-file
edit-configuration-file))
"Converse over PORT to choose the partitioning method. When ENCRYPTED? is
true, choose full-disk encryption with PASSPHRASE as the LUKS passphrase.
This conversation goes past the final dialog box that shows the configuration
file, actually starting the installation process."
(converse port
((list-selection (title "Partitioning method")
(multiple-choices? #f)
(items (,not-encrypted ,encrypted _ ...)))
(if encrypted?
encrypted
not-encrypted))
((list-selection (title "Disk") (multiple-choices? #f)
(items (,disk _ ...)))
disk)
;; The "Partition table" dialog pops up only if there's not already a
;; partition table.
((list-selection (title "Partition table")
(multiple-choices? #f)
(items _))
"gpt")
((list-selection (title "Partition scheme")
(multiple-choices? #f)
(items (,one-partition _ ...)))
one-partition)
((list-selection (title "Guided partitioning")
(multiple-choices? #f)
(items (,disk _ ...)))
disk)
((input (title "Password required")
(text _) (default #f))
encrypted? ;only when ENCRYPTED?
passphrase)
((input (title "Password confirmation required")
(text _) (default #f))
encrypted?
passphrase)
((confirmation (title "Format disk?") (text _))
#t)
((info (title "Preparing partitions") _ ...)
(values)) ;nothing to return
((file-dialog (title "Configuration file")
(text _)
(file ,configuration-file))
(edit-configuration-file configuration-file))))
(define (conclude-installation port)
"Conclude the installation by checking over PORT that we get the final
messages once the 'guix system init' process has completed."
(converse port
((pause) ;"Press Enter to continue."
#t)
((installation-complete) ;congratulations!
(values))))
;;; Local Variables:
;;; eval: (put 'converse 'scheme-indent-function 1)
;;; eval: (put 'with-ellipsis 'scheme-indent-function 1)
;;; End:

152
gnu/installer/utils.scm
View File

@ -21,7 +21,9 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 format) #:use-module (ice-9 format)
@ -30,10 +32,15 @@
read-all read-all
nearest-exact-integer nearest-exact-integer
read-percentage read-percentage
run-shell-command run-command
syslog-port syslog-port
syslog)) syslog
with-server-socket
current-server-socket
current-clients
send-to-clients))
(define* (read-lines #:optional (port (current-input-port))) (define* (read-lines #:optional (port (current-input-port)))
"Read lines from PORT and return them as a list." "Read lines from PORT and return them as a list."
@ -61,44 +68,48 @@ number. If no percentage is found, return #f"
(and result (and result
(string->number (match:substring result 1))))) (string->number (match:substring result 1)))))
(define* (run-shell-command command #:key locale) (define* (run-command command #:key locale)
"Run COMMAND, a string, with Bash, and in the given LOCALE. Return true if "Run COMMAND, a list of strings, in the given LOCALE. Return true if
COMMAND exited successfully, #f otherwise." COMMAND exited successfully, #f otherwise."
(define env (environ))
(define (pause) (define (pause)
(format #t (G_ "Press Enter to continue.~%")) (format #t (G_ "Press Enter to continue.~%"))
(read-line (current-input-port))) (send-to-clients '(pause))
(environ env) ;restore environment variables
(match (select (cons (current-input-port) (current-clients))
'() '())
(((port _ ...) _ _)
(read-line port))))
(call-with-temporary-output-file (setenv "PATH" "/run/current-system/profile/bin")
(lambda (file port)
(when locale
(let ((supported? (false-if-exception
(setlocale LC_ALL locale))))
;; If LOCALE is not supported, then set LANGUAGE, which might at
;; least give us translated messages.
(if supported?
(format port "export LC_ALL=\"~a\"~%" locale)
(format port "export LANGUAGE=\"~a\"~%"
(string-take locale
(string-index locale #\_))))))
(format port "exec ~a~%" command) (when locale
(close port) (let ((supported? (false-if-exception
(setlocale LC_ALL locale))))
;; If LOCALE is not supported, then set LANGUAGE, which might at
;; least give us translated messages.
(if supported?
(setenv "LC_ALL" locale)
(setenv "LANGUAGE"
(string-take locale
(string-index locale #\_))))))
(guard (c ((invoke-error? c) (guard (c ((invoke-error? c)
(newline) (newline)
(format (current-error-port) (format (current-error-port)
(G_ "Command failed with exit code ~a.~%") (G_ "Command failed with exit code ~a.~%")
(invoke-error-exit-status c)) (invoke-error-exit-status c))
(syslog "command ~s failed with exit code ~a" (syslog "command ~s failed with exit code ~a"
command (invoke-error-exit-status c)) command (invoke-error-exit-status c))
(pause) (pause)
#f)) #f))
(syslog "running command ~s~%" command) (syslog "running command ~s~%" command)
(invoke "bash" "--init-file" file) (apply invoke command)
(syslog "command ~s succeeded~%" command) (syslog "command ~s succeeded~%" command)
(newline) (newline)
(pause) (pause)
#t)))) #t))
;;; ;;;
@ -134,3 +145,76 @@ COMMAND exited successfully, #f otherwise."
(with-syntax ((fmt (string-append "installer[~d]: " (with-syntax ((fmt (string-append "installer[~d]: "
(syntax->datum #'fmt)))) (syntax->datum #'fmt))))
#'(format (syslog-port) fmt (getpid) args ...)))))) #'(format (syslog-port) fmt (getpid) args ...))))))
;;;
;;; Client protocol.
;;;
(define %client-socket-file
;; Unix-domain socket where the installer accepts connections.
"/var/guix/installer-socket")
(define current-server-socket
;; Socket on which the installer is currently accepting connections, or #f.
(make-parameter #f))
(define current-clients
;; List of currently connected clients.
(make-parameter '()))
(define* (open-server-socket
#:optional (socket-file %client-socket-file))
"Open SOCKET-FILE as a Unix-domain socket to accept incoming connections and
return it."
(mkdir-p (dirname socket-file))
(when (file-exists? socket-file)
(delete-file socket-file))
(let ((sock (socket AF_UNIX SOCK_STREAM 0)))
(bind sock AF_UNIX socket-file)
(listen sock 0)
sock))
(define (call-with-server-socket thunk)
(if (current-server-socket)
(thunk)
(let ((socket (open-server-socket)))
(dynamic-wind
(const #t)
(lambda ()
(parameterize ((current-server-socket socket))
(thunk)))
(lambda ()
(close-port socket))))))
(define-syntax-rule (with-server-socket exp ...)
"Evaluate EXP with 'current-server-socket' parameterized to a currently
accepting socket."
(call-with-server-socket (lambda () exp ...)))
(define* (send-to-clients exp)
"Send EXP to all the current clients."
(define remainder
(fold (lambda (client remainder)
(catch 'system-error
(lambda ()
(write exp client)
(newline client)
(force-output client)
(cons client remainder))
(lambda args
;; We might get EPIPE if the client disconnects; when that
;; happens, remove CLIENT from the set of available clients.
(let ((errno (system-error-errno args)))
(if (memv errno (list EPIPE ECONNRESET ECONNABORTED))
(begin
(syslog "removing client ~s due to ~s while replying~%"
(fileno client) (strerror errno))
(false-if-exception (close-port client))
remainder)
(cons client remainder))))))
'()
(current-clients)))
(current-clients (reverse remainder))
exp)

8
gnu/local.mk
View File

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU # GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> # Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Andreas Enge <andreas@enge.fr> # Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Andreas Enge <andreas@enge.fr>
# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> # Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
# Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Mark H Weaver <mhw@netris.org> # Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Mark H Weaver <mhw@netris.org>
@ -656,6 +656,7 @@ INSTALLER_MODULES = \
%D%/installer/record.scm \ %D%/installer/record.scm \
%D%/installer/services.scm \ %D%/installer/services.scm \
%D%/installer/steps.scm \ %D%/installer/steps.scm \
%D%/installer/tests.scm \
%D%/installer/timezone.scm \ %D%/installer/timezone.scm \
%D%/installer/user.scm \ %D%/installer/user.scm \
%D%/installer/utils.scm \ %D%/installer/utils.scm \
@ -720,7 +721,6 @@ dist_patch_DATA = \
%D%/packages/patches/antiword-CVE-2014-8123.patch \ %D%/packages/patches/antiword-CVE-2014-8123.patch \
%D%/packages/patches/antlr3-3_1-fix-java8-compilation.patch \ %D%/packages/patches/antlr3-3_1-fix-java8-compilation.patch \
%D%/packages/patches/antlr3-3_3-fix-java8-compilation.patch \ %D%/packages/patches/antlr3-3_3-fix-java8-compilation.patch \
%D%/packages/patches/appstream-glib-2020.patch \
%D%/packages/patches/apr-skip-getservbyname-test.patch \ %D%/packages/patches/apr-skip-getservbyname-test.patch \
%D%/packages/patches/arm-trusted-firmware-disable-hdcp.patch \ %D%/packages/patches/arm-trusted-firmware-disable-hdcp.patch \
%D%/packages/patches/aspell-default-dict-dir.patch \ %D%/packages/patches/aspell-default-dict-dir.patch \
@ -771,9 +771,7 @@ dist_patch_DATA = \
%D%/packages/patches/catdoc-CVE-2017-11110.patch \ %D%/packages/patches/catdoc-CVE-2017-11110.patch \
%D%/packages/patches/cdparanoia-fpic.patch \ %D%/packages/patches/cdparanoia-fpic.patch \
%D%/packages/patches/cdrtools-3.01-mkisofs-isoinfo.patch \ %D%/packages/patches/cdrtools-3.01-mkisofs-isoinfo.patch \
%D%/packages/patches/ceph-boost-compat.patch \
%D%/packages/patches/ceph-disable-cpu-optimizations.patch \ %D%/packages/patches/ceph-disable-cpu-optimizations.patch \
%D%/packages/patches/ceph-volume-respect-PATH.patch \
%D%/packages/patches/chmlib-inttypes.patch \ %D%/packages/patches/chmlib-inttypes.patch \
%D%/packages/patches/clamav-config-llvm-libs.patch \ %D%/packages/patches/clamav-config-llvm-libs.patch \
%D%/packages/patches/clamav-system-tomsfastmath.patch \ %D%/packages/patches/clamav-system-tomsfastmath.patch \
@ -1097,7 +1095,6 @@ dist_patch_DATA = \
%D%/packages/patches/libexif-CVE-2018-20030.patch \ %D%/packages/patches/libexif-CVE-2018-20030.patch \
%D%/packages/patches/libextractor-exiv2.patch \ %D%/packages/patches/libextractor-exiv2.patch \
%D%/packages/patches/libgeotiff-adapt-test-script-for-proj-6.2.patch \ %D%/packages/patches/libgeotiff-adapt-test-script-for-proj-6.2.patch \
%D%/packages/patches/libgit2-avoid-python.patch \
%D%/packages/patches/libgit2-mtime-0.patch \ %D%/packages/patches/libgit2-mtime-0.patch \
%D%/packages/patches/libgnome-encoding.patch \ %D%/packages/patches/libgnome-encoding.patch \
%D%/packages/patches/libgnomeui-utf8.patch \ %D%/packages/patches/libgnomeui-utf8.patch \
@ -1411,6 +1408,7 @@ dist_patch_DATA = \
%D%/packages/patches/soundconverter-remove-gconf-dependency.patch \ %D%/packages/patches/soundconverter-remove-gconf-dependency.patch \
%D%/packages/patches/spice-fix-test-armhf.patch \ %D%/packages/patches/spice-fix-test-armhf.patch \
%D%/packages/patches/steghide-fixes.patch \ %D%/packages/patches/steghide-fixes.patch \
%D%/packages/patches/suitesparse-mongoose-cmake.patch \
%D%/packages/patches/superlu-dist-awpm-grid.patch \ %D%/packages/patches/superlu-dist-awpm-grid.patch \
%D%/packages/patches/superlu-dist-scotchmetis.patch \ %D%/packages/patches/superlu-dist-scotchmetis.patch \
%D%/packages/patches/supertux-unbundle-squirrel.patch \ %D%/packages/patches/supertux-unbundle-squirrel.patch \

2
gnu/packages/audio.scm
View File

@ -322,7 +322,7 @@ namespace ARDOUR { const char* revision = \"" version "\" ; }"))
("itstool" ,itstool) ("itstool" ,itstool)
("perl" ,perl) ("perl" ,perl)
("pkg-config" ,pkg-config))) ("pkg-config" ,pkg-config)))
(home-page "http://ardour.org") (home-page "https://ardour.org")
(synopsis "Digital audio workstation") (synopsis "Digital audio workstation")
(description (description
"Ardour is a multi-channel digital audio workstation, allowing users to "Ardour is a multi-channel digital audio workstation, allowing users to

6
gnu/packages/check.scm
View File

@ -756,7 +756,7 @@ interfaces and processes.")
(propagated-inputs (propagated-inputs
`(("python-six" ,python-six) `(("python-six" ,python-six)
("python-traceback2" ,python-traceback2))) ("python-traceback2" ,python-traceback2)))
(home-page "http://pypi.python.org/pypi/unittest2") (home-page "https://pypi.org/project/unittest2/")
(synopsis "Python unit testing library") (synopsis "Python unit testing library")
(description (description
"Unittest2 is a replacement for the unittest module in the Python "Unittest2 is a replacement for the unittest module in the Python
@ -1540,7 +1540,7 @@ the last py.test invocation.")
(synopsis "Py.test plugin to test server connections locally") (synopsis "Py.test plugin to test server connections locally")
(description "Pytest-localserver is a plugin for the pytest testing (description "Pytest-localserver is a plugin for the pytest testing
framework which enables you to test server connections locally.") framework which enables you to test server connections locally.")
(home-page "https://pypi.python.org/pypi/pytest-localserver") (home-page "https://pypi.org/project/pytest-localserver/")
(license license:expat))) (license license:expat)))
(define-public python-pytest-xprocess (define-public python-pytest-xprocess
@ -1994,7 +1994,7 @@ especially -cover-package.")
(base32 (base32
"0y8d0zwiqar51kxj8lzmkvwc3b8kazb04gk5zcb4nzg5k68zmhq5")))) "0y8d0zwiqar51kxj8lzmkvwc3b8kazb04gk5zcb4nzg5k68zmhq5"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "http://pypi.python.org/pypi/discover/") (home-page "https://pypi.org/project/discover/")
(synopsis (synopsis
"Python test discovery for unittest") "Python test discovery for unittest")
(description (description

5
gnu/packages/chemistry.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2018 Kei Kebreau <kkebreau@posteo.net> ;;; Copyright © 2018 Kei Kebreau <kkebreau@posteo.net>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -147,7 +148,7 @@ powerful plugin architecture.")
`(#:python ,python-2 `(#:python ,python-2
;; No test suite ;; No test suite
#:tests? #f)) #:tests? #f))
(home-page "http://dirac.cnrs-orleans.fr/DomainFinder") (home-page "http://dirac.cnrs-orleans.fr/DomainFinder.html")
(synopsis "Analysis of dynamical domains in proteins") (synopsis "Analysis of dynamical domains in proteins")
(description "DomainFinder is an interactive program for the determination (description "DomainFinder is an interactive program for the determination
and characterization of dynamical domains in proteins. It can infer dynamical and characterization of dynamical domains in proteins. It can infer dynamical
@ -290,7 +291,7 @@ analogy is that InChI is the bar-code for chemistry and chemical structures.")
;; Show documentation as PDF ;; Show documentation as PDF
(("PREFERENCES\\['documentation_style'\\] = 'html'") (("PREFERENCES\\['documentation_style'\\] = 'html'")
"PREFERENCES['documentation_style'] = 'pdf'") )))))) "PREFERENCES['documentation_style'] = 'pdf'") ))))))
(home-page "http://dirac.cnrs-orleans.fr/nMOLDYN/") (home-page "http://dirac.cnrs-orleans.fr/nMOLDYN.html")
(synopsis "Analysis software for Molecular Dynamics trajectories") (synopsis "Analysis software for Molecular Dynamics trajectories")
(description "nMOLDYN is an interactive analysis program for Molecular Dynamics (description "nMOLDYN is an interactive analysis program for Molecular Dynamics
simulations. It is especially designed for the computation and decomposition of simulations. It is especially designed for the computation and decomposition of

6
gnu/packages/compression.scm
View File

@ -25,6 +25,7 @@
;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz> ;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2019 Nicolas Goaziou <mail@nicolasgoaziou.fr> ;;; Copyright © 2019 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -410,7 +411,8 @@ compatible with bzip2 – both at file format and command line level.")
#:phases (modify-phases %standard-phases #:phases (modify-phases %standard-phases
(delete 'configure)) ; no configure script (delete 'configure)) ; no configure script
#:make-flags (list (string-append "PREFIX=" %output)))) #:make-flags (list (string-append "PREFIX=" %output))))
(home-page "http://compression.ca/pbzip2/") (home-page (string-append "https://web.archive.org/web/20180412020219/"
"http://compression.ca/pbzip2/"))
(synopsis "Parallel bzip2 implementation") (synopsis "Parallel bzip2 implementation")
(description (description
"Pbzip2 is a parallel implementation of the bzip2 block-sorting file "Pbzip2 is a parallel implementation of the bzip2 block-sorting file
@ -813,7 +815,7 @@ time for compression ratio.")
("lzo" ,lzo) ("lzo" ,lzo)
("xz" ,xz) ("xz" ,xz)
("zlib" ,zlib))) ("zlib" ,zlib)))
(home-page "http://squashfs.sourceforge.net/") (home-page "https://github.com/plougher/squashfs-tools")
(synopsis "Tools to create and extract squashfs file systems") (synopsis "Tools to create and extract squashfs file systems")
(description (description
"Squashfs is a highly compressed read-only file system for Linux. It uses "Squashfs is a highly compressed read-only file system for Linux. It uses

3
gnu/packages/coq.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Dan Frumin <dfrumin@cs.ru.nl> ;;; Copyright © 2019 Dan Frumin <dfrumin@cs.ru.nl>
;;; Copyright © 2020 Brett Gilio <brettg@gnu.org> ;;; Copyright © 2020 Brett Gilio <brettg@gnu.org>
;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -353,7 +354,7 @@ assistant.")
(string-append "COQLIB=" (assoc-ref outputs "out") (string-append "COQLIB=" (assoc-ref outputs "out")
"/lib/coq/") "/lib/coq/")
"install")))))) "install"))))))
(home-page "https://math-comp.github.io/math-comp/") (home-page "https://math-comp.github.io/")
(synopsis "Mathematical Components for Coq") (synopsis "Mathematical Components for Coq")
(description "Mathematical Components for Coq has its origins in the formal (description "Mathematical Components for Coq has its origins in the formal
proof of the Four Colour Theorem. Since then it has grown to cover many areas proof of the Four Colour Theorem. Since then it has grown to cover many areas

45
gnu/packages/cpp.scm
View File

@ -7,6 +7,7 @@
;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz> ;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2019 Jan Wielkiewicz <tona_kosmicznego_smiecia@interia.pl> ;;; Copyright © 2019 Jan Wielkiewicz <tona_kosmicznego_smiecia@interia.pl>
;;; Copyright © 2020 Nicolò Balzarotti <nicolo@nixo.xyz> ;;; Copyright © 2020 Nicolò Balzarotti <nicolo@nixo.xyz>
;;; Copyright © 2020 Roel Janssen <roel@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -439,3 +440,47 @@ create fluid interpolations when animating position, scale, rotation, frames or
other values of screen objects, by setting their values as the tween starting other values of screen objects, by setting their values as the tween starting
point and then, after each tween step, plugging back the result.") point and then, after each tween step, plugging back the result.")
(license license:expat))) (license license:expat)))
(define-public abseil-cpp
(package
(name "abseil-cpp")
(version "20200225")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/abseil/abseil-cpp.git")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"0wb04pszzrl39ny1pz9jvvq8lbbm355dd60jspcyqfwxnk6njgd1"))))
(build-system cmake-build-system)
(arguments
`(#:configure-flags (list "-DBUILD_SHARED_LIBS=ON"
"-DABSL_RUN_TESTS=ON"
;; Needed, else we get errors like:
;;
;; ld: CMakeFiles/absl_periodic_sampler_test.dir/internal/periodic_sampler_test.cc.o:
;; undefined reference to symbol '_ZN7testing4Mock16UnregisterLockedEPNS_8internal25UntypedFunctionMockerBaseE'
;; ld: /gnu/store/bxapb1f1l8frjpbjckk3zdxhmcig3xzk-googletest-1.10.0/lib/libgmock.so:
;; error adding symbols: DSO missing from command line
;; collect2: error: ld returned 1 exit status
"-DCMAKE_EXE_LINKER_FLAGS=-lgtest -lpthread -lgmock")
#:phases
(modify-phases %standard-phases
(add-before 'configure 'remove-gtest-check
;; The CMakeLists fails to find our googletest for some reason, but
;; it works nonetheless.
(lambda _
(substitute* "CMakeLists.txt"
(("check_target\\(gtest\\)") "")
(("check_target\\(gtest_main\\)") "")
(("check_target\\(gmock\\)") "")))))))
(native-inputs
`(("googletest" ,googletest)))
(home-page "https://abseil.io")
(synopsis "Augmented C++ standard library")
(description "Abseil is a collection of C++ library code designed to
augment the C++ standard library. The Abseil library code is collected from
Google's C++ code base.")
(license license:asl2.0)))

29
gnu/packages/cran.scm
View File

@ -7180,13 +7180,13 @@ and coverage methods to tune the choice of threshold.")
(define-public r-ggformula (define-public r-ggformula
(package (package
(name "r-ggformula") (name "r-ggformula")
(version "0.9.3") (version "0.9.4")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "ggformula" version)) (uri (cran-uri "ggformula" version))
(sha256 (sha256
(base32 "1bpsfp9hx001r91pxfiwgxcn5vw5bl1gclb865wz6g9l0jqjfk2p")))) (base32 "04vdhg1bbc1psrx9ggaphz7cx4fw5xsmhkqpqfcg2w4ba2bjy46f"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-ggforce" ,r-ggforce) `(("r-ggforce" ,r-ggforce)
@ -7196,8 +7196,7 @@ and coverage methods to tune the choice of threshold.")
("r-mosaiccore" ,r-mosaiccore) ("r-mosaiccore" ,r-mosaiccore)
("r-rlang" ,r-rlang) ("r-rlang" ,r-rlang)
("r-stringr" ,r-stringr) ("r-stringr" ,r-stringr)
("r-tibble" ,r-tibble) ("r-tibble" ,r-tibble)))
("r-tidyr" ,r-tidyr)))
(home-page "https://github.com/ProjectMOSAIC/ggformula/") (home-page "https://github.com/ProjectMOSAIC/ggformula/")
(synopsis "Formula interface for the @code{r-ggplot2}") (synopsis "Formula interface for the @code{r-ggplot2}")
(description (description
@ -8238,14 +8237,14 @@ Hothorn, Westfall, 2010, CRC Press).")
(define-public r-emmeans (define-public r-emmeans
(package (package
(name "r-emmeans") (name "r-emmeans")
(version "1.4.4") (version "1.4.5")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "emmeans" version)) (uri (cran-uri "emmeans" version))
(sha256 (sha256
(base32 (base32
"0l1qj6x834fmcvqbj807p7yz7462df925vw91xvg50faqm19d41x")))) "10fmvmd6q4zjr6b18hhc85mwrzv778qzj6lwl9kbs2fsfvsgw7mm"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-estimability" ,r-estimability) `(("r-estimability" ,r-estimability)
@ -11986,14 +11985,14 @@ users of rARPACK are advised to switch to the RSpectra package.")
(define-public r-compositions (define-public r-compositions
(package (package
(name "r-compositions") (name "r-compositions")
(version "1.40-3") (version "1.40-4")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "compositions" version)) (uri (cran-uri "compositions" version))
(sha256 (sha256
(base32 (base32
"103hbmibrf1n333pn4xpll1gqqsv4szms0n5gdq7zak31aar0bg4")))) "0z40llyij3cc80ac1vzzrpykk6ysp89bn6dyyh40fbnc4anwx69a"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-bayesm" ,r-bayesm) `(("r-bayesm" ,r-bayesm)
@ -19403,14 +19402,14 @@ analysis and natural language processing.")
(define-public r-spacyr (define-public r-spacyr
(package (package
(name "r-spacyr") (name "r-spacyr")
(version "1.2") (version "1.2.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "spacyr" version)) (uri (cran-uri "spacyr" version))
(sha256 (sha256
(base32 (base32
"1xsiz6zx89vs6ykrkkp011d8fz4ksdgnf5nyaq5ynjr6zv865vks")))) "1b2ccgwsiqkvp7w37x8k7699c676q16vfrybkrfvyczyhki4s6nw"))))
(properties `((upstream-name . "spacyr"))) (properties `((upstream-name . "spacyr")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
@ -20136,20 +20135,22 @@ Latent regression models and plausible value imputation are also supported.")
(define-public r-erm (define-public r-erm
(package (package
(name "r-erm") (name "r-erm")
(version "1.0-0") (version "1.0-1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "eRm" version)) (uri (cran-uri "eRm" version))
(sha256 (sha256
(base32 (base32
"11p8j61arq1ih2qi33wf0442vcdbp3zvknzm5aknsifwl4mbzzly")))) "0njqzznnhnkvalmhiq5yq1w7gwp2myki5cv61w42ydvd27hdyyg9"))))
(properties `((upstream-name . "eRm"))) (properties `((upstream-name . "eRm")))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-lattice" ,r-lattice) `(("r-colorspace" ,r-colorspace)
("r-lattice" ,r-lattice)
("r-mass" ,r-mass) ("r-mass" ,r-mass)
("r-matrix" ,r-matrix))) ("r-matrix" ,r-matrix)
("r-psych" ,r-psych)))
(native-inputs `(("gfortran" ,gfortran))) (native-inputs `(("gfortran" ,gfortran)))
(home-page "https://cran.r-project.org/package=eRm") (home-page "https://cran.r-project.org/package=eRm")
(synopsis "Extended Rasch modeling") (synopsis "Extended Rasch modeling")

4
gnu/packages/databases.scm
View File

@ -2284,13 +2284,13 @@ for ODBC.")
(define-public python-pyodbc (define-public python-pyodbc
(package (package
(name "python-pyodbc") (name "python-pyodbc")
(version "4.0.27") (version "4.0.30")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "pyodbc" version)) (uri (pypi-uri "pyodbc" version))
(sha256 (sha256
(base32 "1kd2i7hc1330cli72vawzby17c3039cqn1aba4i0zrjnpghjhmib")) (base32 "0skjpraar6hcwsy82612bpj8nw016ncyvvq88j5syrikxgp5saw5"))
(file-name (string-append name "-" version ".tar.gz")))) (file-name (string-append name "-" version ".tar.gz"))))
(build-system python-build-system) (build-system python-build-system)
(inputs (inputs

6
gnu/packages/disk.scm
View File

@ -3,7 +3,7 @@
;;; Copyright © 2015 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2015 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016, 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2016, 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2016, 2019 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016 Roel Janssen <roel@gnu.org> ;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016, 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2016, 2017 Marius Bakke <mbakke@fastmail.com>
@ -210,14 +210,14 @@ scheme.")
(define-public ddrescue (define-public ddrescue
(package (package
(name "ddrescue") (name "ddrescue")
(version "1.24") (version "1.25")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/ddrescue/ddrescue-" (uri (string-append "mirror://gnu/ddrescue/ddrescue-"
version ".tar.lz")) version ".tar.lz"))
(sha256 (sha256
(base32 "11qh0bbzf00mfb4yq35gnv5m260k4d7q9ixklry6bqvhvvp3ypab")))) (base32 "0qqh38izl5ppap9a5izf3hijh94k65s3zbfkczd4b7x04syqwlyf"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(home-page "https://www.gnu.org/software/ddrescue/ddrescue.html") (home-page "https://www.gnu.org/software/ddrescue/ddrescue.html")
(synopsis "Data recovery utility") (synopsis "Data recovery utility")

2
gnu/packages/django.scm
View File

@ -248,7 +248,7 @@ with arguments to the field constructor.")
("python-setuptools-scm" ,python-setuptools-scm))) ("python-setuptools-scm" ,python-setuptools-scm)))
(propagated-inputs (propagated-inputs
`(("python-pytest" ,python-pytest))) `(("python-pytest" ,python-pytest)))
(home-page "http://pytest-django.readthedocs.org/") (home-page "https://pytest-django.readthedocs.org/")
(synopsis "Django plugin for py.test") (synopsis "Django plugin for py.test")
(description "Pytest-django is a plugin for py.test that provides a set of (description "Pytest-django is a plugin for py.test that provides a set of
useful tools for testing Django applications and projects.") useful tools for testing Django applications and projects.")

82
gnu/packages/emacs-xyz.scm
View File

@ -60,6 +60,7 @@
;;; Copyright © 2020 Paul Garlick <pgarlick@tourbillion-technology.com> ;;; Copyright © 2020 Paul Garlick <pgarlick@tourbillion-technology.com>
;;; Copyright © 2020 Robert Smith <robertsmith@posteo.net> ;;; Copyright © 2020 Robert Smith <robertsmith@posteo.net>
;;; Copyright © 2020 Evan Straw <evan.straw99@gmail.com> ;;; Copyright © 2020 Evan Straw <evan.straw99@gmail.com>
;;; Copyright © 2020 Masaya Tojo <masaya@tojo.tokyo>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -17258,10 +17259,10 @@ leader key in vim), and much more.")
(license license:gpl3+)))) (license license:gpl3+))))
(define-public emacs-tldr (define-public emacs-tldr
(let ((commit "398b197c8d2238628b07e1b32d0f373876279f4c")) (let ((commit "7203d1be3dcbf12131846ffe06601933fa874d74"))
(package (package
(name "emacs-tldr") (name "emacs-tldr")
(version (git-version "0" "0" commit)) (version (git-version "0" "1" commit))
(home-page "https://github.com/kuanyui/tldr.el") (home-page "https://github.com/kuanyui/tldr.el")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
@ -17270,9 +17271,11 @@ leader key in vim), and much more.")
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"0iq7qlis6c6r2qkdpncrhh5vsihkhvy5x4y1y8cjb7zxkh62w33f")) "1bw6la463l2yfm7rp76ga4makfy4kpxgwi7ni5gxk31w11g26ryk"))
(file-name (git-file-name name version)))) (file-name (git-file-name name version))))
(build-system emacs-build-system) (build-system emacs-build-system)
(propagated-inputs
`(("emacs-request" ,emacs-request)))
(synopsis "Simplified and community-driven man pages for Emacs") (synopsis "Simplified and community-driven man pages for Emacs")
(description "@code{emacs-tldr} allows the user to access tldr pages (description "@code{emacs-tldr} allows the user to access tldr pages
from within emacs. The @code{tldr} pages are a community effort to simplify from within emacs. The @code{tldr} pages are a community effort to simplify
@ -17844,25 +17847,26 @@ Later you can insert it into an Org buffer using the command
(define-public emacs-amx (define-public emacs-amx
(package (package
(name "emacs-amx") (name "emacs-amx")
(version "3.2") (version "3.3")
(source (origin (source
(method git-fetch) (origin
(uri (git-reference (method git-fetch)
(url "https://github.com/DarwinAwardWinner/amx") (uri (git-reference
(commit (string-append "v" version)))) (url "https://github.com/DarwinAwardWinner/amx")
(file-name (git-file-name name version)) (commit (string-append "v" version))))
(sha256 (file-name (git-file-name name version))
(base32 (sha256
"0bb8y1dmzyqkrb4mg6zndcsxppby3glridv2aap2pv05gv8kx7mj")))) (base32 "0ikjzs119g57cwh2v3jmy63lggqc0ib99q5gsl93slkk4y2ihavw"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(propagated-inputs `(("emacs-s" ,emacs-s))) (propagated-inputs
`(("emacs-s" ,emacs-s)))
(home-page "https://github.com/DarwinAwardWinner/amx") (home-page "https://github.com/DarwinAwardWinner/amx")
(synopsis "Alternative interface for M-x") (synopsis "Alternative M-x interface for Emacs")
(description "Amx is an alternative interface for M-x in Emacs. It (description "Amx is an alternative interface for M-x in Emacs. It
provides several enhancements over the ordinary provides several enhancements over the ordinary
@code{execute-extended-command}, such as prioritizing your most-used commands @code{execute-extended-command}, such as prioritizing your most-used commands
in the completion list and showing keyboard shortcuts, and it supports several in the completion list and showing keyboard shortcuts, and it supports several
completion systems for selecting commands, such as ido and ivy.") completion systems for selecting commands, such as Ido and Ivy.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-lorem-ipsum (define-public emacs-lorem-ipsum
@ -21729,3 +21733,49 @@ supports generation of phonetic and numeric passwords.")
Separated Value) files. It follows the format as defined in RFC 4180 \"Common Separated Value) files. It follows the format as defined in RFC 4180 \"Common
Format and MIME Type for CSV Files\" (@url{http://tools.ietf.org/html/rfc4180}).") Format and MIME Type for CSV Files\" (@url{http://tools.ietf.org/html/rfc4180}).")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-ddskk
;; XXX: Upstream adds code names to their release tags, so version and code
;; name below need to be updated together.
(let ((version "16.3")
(code-name "Kutomatsunai"))
(package
(name "emacs-ddskk")
(version version)
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/skk-dev/ddskk")
(commit (string-append "ddskk-" version "_" code-name))))
(file-name (git-file-name name version))
(sha256
(base32 "0ln4x8f35z5y3kf9m718g223bn3lzcmw40jfjg2j5yi24ydf1wm9"))))
(build-system gnu-build-system)
(arguments
`(#:modules ((guix build gnu-build-system)
(guix build utils)
(guix build emacs-utils))
#:imported-modules (,@%gnu-build-system-modules
(guix build emacs-utils))
#:test-target "test"
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
(make-file-writable "SKK-MK")
(emacs-substitute-variables "SKK-MK"
("PREFIX" (assoc-ref outputs "out"))
("LISPDIR" '(expand-file-name "/share/emacs/site-lisp" PREFIX))
("SKK_PREFIX" "")
("SKK_INFODIR" '(expand-file-name "info" PREFIX)))
(for-each make-file-writable (find-files "./doc"))
#t)))))
(native-inputs
`(("emacs-minimal" ,emacs-minimal)))
(home-page "https://github.com/skk-dev/ddskk")
(synopsis "Simple Kana to Kanji conversion program")
(description
"Daredevil SKK is a version of @acronym{SKK, Simple Kana to Kanji
conversion program}, a Japanese input method on Emacs.")
(license license:gpl2+))))

4
gnu/packages/enchant.scm
View File

@ -36,7 +36,7 @@
(define-public enchant (define-public enchant
(package (package
(name "enchant") (name "enchant")
(version "2.2.7") (version "2.2.8")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/AbiWord/enchant/releases" (uri (string-append "https://github.com/AbiWord/enchant/releases"
@ -44,7 +44,7 @@
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"029smcna98hllgkm2gy94qa7qphxs4xaa8cdbg5kaaw16mhrf8hv")))) "0m9m564qqwbssvvf7y3dlz1yxzqsjiqy1yd2zsmb3l0d7y2y5df7"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:configure-flags '("--disable-static" '(#:configure-flags '("--disable-static"

38
gnu/packages/fontutils.scm
View File

@ -11,6 +11,7 @@
;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2020 Roel Janssen <roel@gnu.org> ;;; Copyright © 2020 Roel Janssen <roel@gnu.org>
;;; Copyright © 2020 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -45,6 +46,7 @@
#:use-module (gnu packages glib) #:use-module (gnu packages glib)
#:use-module (gnu packages gperf) #:use-module (gnu packages gperf)
#:use-module (gnu packages xorg) #:use-module (gnu packages xorg)
#:use-module (gnu packages fribidi)
#:use-module (gnu packages gtk) #:use-module (gnu packages gtk)
#:use-module (gnu packages xml) #:use-module (gnu packages xml)
#:use-module (gnu packages sqlite) #:use-module (gnu packages sqlite)
@ -678,7 +680,7 @@ files. UFO is a file format that stores fonts source files.")
(propagated-inputs (propagated-inputs
`(("python2-fonttools" ,python2-fonttools) `(("python2-fonttools" ,python2-fonttools)
("python2-ufolib" ,python2-ufolib))) ("python2-ufolib" ,python2-ufolib)))
(home-page "https://pypi.python.org/pypi/defcon") (home-page "https://pypi.org/project/defcon/")
(synopsis "Flexible objects for representing @acronym{UFO, unified font object} data") (synopsis "Flexible objects for representing @acronym{UFO, unified font object} data")
(description (description
"Defcon is a set of @acronym{UFO, unified font object} based objects "Defcon is a set of @acronym{UFO, unified font object} based objects
@ -836,3 +838,37 @@ work well with other GTK+ desktop environments.")
samples that show coverage of the font and are similar in appearance to samples that show coverage of the font and are similar in appearance to
Unicode Charts. It was developed for use with DejaVu Fonts project.") Unicode Charts. It was developed for use with DejaVu Fonts project.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public libraqm
(package
(name "libraqm")
(version "0.7.0")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/HOST-Oman/libraqm/"
"releases/download/v" version "/"
"raqm-" version ".tar.gz"))
(sha256
(base32 "0hgry3fj2y3qaq2fnmdgd93ixkk3ns5jds4vglkiv2jfvpn7b1g2"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags (list "--disable-static")))
(native-inputs
`(("gtk-doc" ,gtk-doc)
("pkg-config" ,pkg-config)
("python" ,python-wrapper)))
(inputs
`(("freetype" ,freetype)
("fribidi" ,fribidi)
("harfbuzz" ,harfbuzz)))
(home-page "https://github.com/HOST-Oman/libraqm")
(synopsis "Library for complex text layout")
(description
"Raqm is a small library that encapsulates the logic for complex text
layout and provides a convenient API.
It currently provides bidirectional text support (using FriBiDi),
shaping (using HarfBuzz), and proper script itemization. As a result, Raqm
can support most writing systems covered by Unicode.")
(license license:expat)))

4
gnu/packages/games.scm
View File

@ -5941,7 +5941,7 @@ affect gameplay).")
(package (package
(inherit chocolate-doom) (inherit chocolate-doom)
(name "crispy-doom") (name "crispy-doom")
(version "5.6.4") (version "5.7.1")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -5949,7 +5949,7 @@ affect gameplay).")
(commit (string-append "crispy-doom-" version)))) (commit (string-append "crispy-doom-" version))))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "1ls4v2kpb7vi7xji5yqbmyc5lfkz497h1vvj9w86wkrw8k59hlg2")))) (base32 "1gqivy4pxasy7phyznixsagylf9f70bk33b0knpfzzlks6cc6zzj"))))
(native-inputs (native-inputs
(append (append
(package-native-inputs chocolate-doom) (package-native-inputs chocolate-doom)

6
gnu/packages/gcc.scm
View File

@ -3,7 +3,7 @@
;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015, 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2015, 2016, 2017, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Carlos Sánchez de La Lama <csanchezdll@gmail.com> ;;; Copyright © 2016 Carlos Sánchez de La Lama <csanchezdll@gmail.com>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
@ -509,14 +509,14 @@ It also includes runtime support libraries for these languages.")))
(define-public gcc-8 (define-public gcc-8
(package (package
(inherit gcc-7) (inherit gcc-7)
(version "8.3.0") (version "8.4.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/gcc/gcc-" (uri (string-append "mirror://gnu/gcc/gcc-"
version "/gcc-" version ".tar.xz")) version "/gcc-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0b3xv411xhlnjmin2979nxcbnidgvzqdf4nbhix99x60dkzavfk4")) "1m1d3gfix56w4aq8myazzfffkl8bqcrx4jhhapnjf7qfs596w2p3"))
(patches (search-patches "gcc-8-strmov-store-file-names.patch" (patches (search-patches "gcc-8-strmov-store-file-names.patch"
"gcc-5.0-libvtv-runpath.patch")))))) "gcc-5.0-libvtv-runpath.patch"))))))

7
gnu/packages/glib.scm
View File

@ -670,7 +670,7 @@ useful for C++.")
(arguments (arguments
`(#:tests? #f ;segfaults during tests `(#:tests? #f ;segfaults during tests
#:configure-flags '("LIBS=-lcairo-gobject"))) #:configure-flags '("LIBS=-lcairo-gobject")))
(home-page "https://pypi.python.org/pypi/PyGObject") (home-page "https://pypi.org/project/PyGObject/")
(synopsis "Python bindings for GObject") (synopsis "Python bindings for GObject")
(description (description
"Python bindings for GLib, GObject, and GIO.") "Python bindings for GLib, GObject, and GIO.")
@ -898,16 +898,15 @@ programming language. It also contains the utility
(define-public appstream-glib (define-public appstream-glib
(package (package
(name "appstream-glib") (name "appstream-glib")
(version "0.7.16") (version "0.7.17")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://people.freedesktop.org/~hughsient/" (uri (string-append "https://people.freedesktop.org/~hughsient/"
"appstream-glib/releases/" "appstream-glib/releases/"
"appstream-glib-" version ".tar.xz")) "appstream-glib-" version ".tar.xz"))
(patches (search-patches "appstream-glib-2020.patch"))
(sha256 (sha256
(base32 (base32
"14jr1psx5kxywdprgbqn79w309yz8lrqlsq7288hfrf87gbr1wh4")))) "0jg58m1p5xfrh8zkpqhhg00nqs727z5i1qy6sb0a3vyc98fyk9vw"))))
(build-system meson-build-system) (build-system meson-build-system)
(native-inputs (native-inputs
`(("gettext" ,gettext-minimal) `(("gettext" ,gettext-minimal)

8
gnu/packages/gnome.scm
View File

@ -3671,7 +3671,7 @@ libxml to ease remote use of the RESTful API.")
(define-public libsoup (define-public libsoup
(package (package
(name "libsoup") (name "libsoup")
(version "2.68.3") (version "2.68.4")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnome/sources/libsoup/" (uri (string-append "mirror://gnome/sources/libsoup/"
@ -3679,7 +3679,7 @@ libxml to ease remote use of the RESTful API.")
"libsoup-" version ".tar.xz")) "libsoup-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1yxs0ax4rq3g0lgkbv7mz497rqj16iyyizddyc13gzxh6n7b0jsk")))) "151j5dc84gbl6a917pxvd0b372lw5za48n63lyv6llfc48lv2l1d"))))
(build-system meson-build-system) (build-system meson-build-system)
(outputs '("out" "doc")) (outputs '("out" "doc"))
(arguments (arguments
@ -5688,7 +5688,7 @@ wraps things up in a developer-friendly way.")
(define-public libgee (define-public libgee
(package (package
(name "libgee") (name "libgee")
(version "0.20.2") (version "0.20.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnome/sources/libgee/" (uri (string-append "mirror://gnome/sources/libgee/"
@ -5696,7 +5696,7 @@ wraps things up in a developer-friendly way.")
"libgee-" version ".tar.xz")) "libgee-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0g1mhl7nidg82v4cikkk8dakzc18hg7wv0dsf2pbyijzfm5mq0wy")))) "1pm525wm11dhwz24m8bpcln9547lmrigl6cxf3qsbg4cr3pyvdfh"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases

96
gnu/packages/gps.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Guillaume Le Vaillant <glv@posteo.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -24,17 +25,23 @@
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix git-download) #:use-module (guix git-download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system scons)
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages docbook) #:use-module (gnu packages docbook)
#:use-module (gnu packages image) #:use-module (gnu packages glib)
#:use-module (gnu packages xml)
#:use-module (gnu packages gtk) #:use-module (gnu packages gtk)
#:use-module (gnu packages image)
#:use-module (gnu packages libusb)
#:use-module (gnu packages linux)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages qt) #:use-module (gnu packages qt)
#:use-module (gnu packages sqlite)) #:use-module (gnu packages sqlite)
#:use-module (gnu packages xml))
(define-public gpsbabel (define-public gpsbabel
(package (package
@ -204,3 +211,84 @@ coordinates as well as partial support for adjustments in global coordinate syst
"GPXSee is a Qt-based GPS log file viewer and analyzer that supports "GPXSee is a Qt-based GPS log file viewer and analyzer that supports
all common GPS log file formats.") all common GPS log file formats.")
(license license:gpl3))) (license license:gpl3)))
(define-public gpsd
(package
(name "gpsd")
(version "3.19")
(source
(origin
(method url-fetch)
(uri (string-append "https://download-mirror.savannah.gnu.org"
"/releases/gpsd/gpsd-" version ".tar.gz"))
(sha256
(base32 "0faz2mvk82hi7ispxxih07lhpyz5dazs4gcknym9piiabga29p97"))))
(build-system scons-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("python" ,python)))
(inputs
`(("bluez" ,bluez)
("dbus" ,dbus)
("libcap" ,libcap)
("libusb" ,libusb)
("ncurses" ,ncurses)))
(arguments
`(#:scons-flags (list (string-append "prefix=" %output)
;; TODO: Install python bindings.
"python=no")
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-paths
(lambda* (#:key inputs #:allow-other-keys)
(let ((python3 (string-append (assoc-ref inputs "python")
"/bin/python3")))
(substitute* '("contrib/gpsData.py"
"contrib/ntpshmviz"
"contrib/skyview2svg"
"contrib/webgps.py"
"devtools/ais.py"
"devtools/aivdmtable"
"devtools/cycle_analyzer"
"devtools/flocktest"
"devtools/identify_failing_build_options.py"
"devtools/regress-builder"
"devtools/regressdiff"
"devtools/sizes"
"devtools/striplog"
"devtools/tablegen.py"
"devtools/test_json_validity.py"
"devtools/uninstall_cleanup.py"
"gegps"
"gps/gps.py"
"gpscat"
"gpsfake"
"gpsprof"
"jsongen.py"
"leapsecond.py"
"maskaudit.py"
"test_maidenhead.py"
"test_misc.py"
"test_xgps_deps.py"
"ubxtool"
"valgrind-audit.py"
"xgps"
"xgpsspeed"
"zerk")
(("/usr/bin/python") python3)
(("/usr/bin/env python") python3)))
#t))
(add-after 'fix-paths 'fix-build
(lambda _
(substitute* "SConstruct"
(("'PATH'")
"'PATH','CPATH','LIBRARY_PATH'"))
#t)))))
(synopsis "GPS service daemon")
(description
"@code{gpsd} is a service daemon that monitors one or more GPSes or AIS
receivers attached to a host computer through serial or USB ports, making all
data on the location/course/velocity of the sensors available to be queried on
TCP port 2947 of the host computer.")
(home-page "https://gpsd.gitlab.io/gpsd/")
(license license:bsd-2)))

2
gnu/packages/graph.scm
View File

@ -119,7 +119,7 @@ more.")
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config) `(("pkg-config" ,pkg-config)
("python-pytest" ,python-pytest))) ("python-pytest" ,python-pytest)))
(home-page "http://pypi.python.org/pypi/python-igraph") (home-page "https://pypi.org/project/python-igraph/")
(synopsis "Python bindings for the igraph network analysis library"))) (synopsis "Python bindings for the igraph network analysis library")))
(define-public r-igraph (define-public r-igraph

2
gnu/packages/graphviz.scm
View File

@ -308,7 +308,7 @@ structure and layout algorithms.")
("gtk+" ,gtk+) ("gtk+" ,gtk+)
("python-pycairo" ,python-pycairo) ("python-pycairo" ,python-pycairo)
("python-pygobject" ,python-pygobject))) ("python-pygobject" ,python-pygobject)))
(home-page "https://pypi.python.org/pypi/xdot") (home-page "https://pypi.org/project/xdot/")
(synopsis "Interactive viewer for graphviz dot files") (synopsis "Interactive viewer for graphviz dot files")
(description "Xdot is an interactive viewer for graphs written in (description "Xdot is an interactive viewer for graphs written in
@code{graphviz}’s dot language. Internally, it uses the xdot output format as @code{graphviz}’s dot language. Internally, it uses the xdot output format as

6
gnu/packages/gtk.scm
View File

@ -15,7 +15,7 @@
;;; Copyright © 2016 Patrick Hetu <patrick.hetu@auf.org> ;;; Copyright © 2016 Patrick Hetu <patrick.hetu@auf.org>
;;; Copyright © 2016 ng0 <ng0@n0.is> ;;; Copyright © 2016 ng0 <ng0@n0.is>
;;; Copyright © 2017 Roel Janssen <roel@gnu.org> ;;; Copyright © 2017 Roel Janssen <roel@gnu.org>
;;; Copyright © 2017, 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017, 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com> ;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
@ -1446,7 +1446,7 @@ and routines to assist in editing internationalized text.")
(define-public girara (define-public girara
(package (package
(name "girara") (name "girara")
(version "0.3.3") (version "0.3.4")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -1455,7 +1455,7 @@ and routines to assist in editing internationalized text.")
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "0q0yfv2777s72p473lw0ll435n7vz4v204cmp9naq8am7a6i6avn")))) (base32 "08rpw9hkaprm4r853xy1d35i2af1pji8c3mzzl01mmwmyr9p0x8k"))))
(native-inputs `(("pkg-config" ,pkg-config) (native-inputs `(("pkg-config" ,pkg-config)
("check" ,check) ("check" ,check)
("gettext" ,gettext-minimal) ("gettext" ,gettext-minimal)

50
gnu/packages/guile-xyz.scm
View File

@ -17,7 +17,7 @@
;;; Copyright © 2017 ng0 <ng0@n0.is> ;;; Copyright © 2017 ng0 <ng0@n0.is>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2018, 2019, 2020 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr> ;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2019 swedebugia <swedebugia@riseup.net> ;;; Copyright © 2019 swedebugia <swedebugia@riseup.net>
@ -80,8 +80,10 @@
#:use-module (gnu packages python) #:use-module (gnu packages python)
#:use-module (gnu packages readline) #:use-module (gnu packages readline)
#:use-module (gnu packages sdl) #:use-module (gnu packages sdl)
#:use-module (gnu packages search)
#:use-module (gnu packages slang) #:use-module (gnu packages slang)
#:use-module (gnu packages sqlite) #:use-module (gnu packages sqlite)
#:use-module (gnu packages swig)
#:use-module (gnu packages tex) #:use-module (gnu packages tex)
#:use-module (gnu packages texinfo) #:use-module (gnu packages texinfo)
#:use-module (gnu packages tls) #:use-module (gnu packages tls)
@ -3096,3 +3098,49 @@ currently a re-implementation of the lentes library for Clojure. Lenses
provide composable procedures, which can be used to focus, apply functions provide composable procedures, which can be used to focus, apply functions
over, or update a value in arbitrary data structures.") over, or update a value in arbitrary data structures.")
(license license:gpl3+)))) (license license:gpl3+))))
(define-public guile-xapian
(let ((commit "ede26b808188eb4d14c6b4181c933dfc09c0a22e")
(revision "0"))
(package
(name "guile-xapian")
(version (git-version "0" revision commit))
(home-page "https://git.systemreboot.net/guile-xapian")
(source
(origin
(method git-fetch)
(uri (git-reference (url home-page)
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"07a9fmqi3pm6mbbpzi01mjwrqwnljs2rnc3603sq49dz4lf663gb"))))
(build-system gnu-build-system)
(arguments
'(#:make-flags '("GUILE_AUTO_COMPILE=0"))) ; to prevent guild warnings
(inputs
`(("guile" ,guile-2.2)
("xapian" ,xapian)
("zlib" ,zlib)))
(native-inputs
`(("autoconf" ,autoconf)
("autoconf-archive" ,autoconf-archive)
("automake" ,automake)
("libtool" ,libtool)
("pkg-config" ,pkg-config)
("swig" ,swig)))
(synopsis "Guile bindings for Xapian")
(description "@code{guile-xapian} provides Guile bindings for Xapian, a
search engine library. Xapian is a highly adaptable toolkit which allows
developers to easily add advanced indexing and search facilities to their own
applications. It has built-in support for several families of weighting
models and also supports a rich set of boolean query operators.")
(license license:gpl2+))))
(define-public guile3.0-xapian
(package
(inherit guile-xapian)
(name "guile3.0-xapian")
(inputs
`(("guile" ,guile-next)
,@(alist-delete "guile" (package-inputs guile-xapian))))))

4
gnu/packages/ibus.scm
View File

@ -59,7 +59,7 @@
(define-public ibus (define-public ibus
(package (package
(name "ibus") (name "ibus")
(version "1.5.21") (version "1.5.22")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/ibus/ibus/" (uri (string-append "https://github.com/ibus/ibus/"
@ -67,7 +67,7 @@
version "/ibus-" version ".tar.gz")) version "/ibus-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1fd2d1jqpp1nn74x04zcilhhab0zar82n0kg614rma6n43kfbhdd")))) "0jmy2w01phpmqnjnfnak7nvfna57mpgfnl87jwc4iai8ijjynw41"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(arguments (arguments
`(#:tests? #f ; tests fail because there's no connection to dbus `(#:tests? #f ; tests fail because there's no connection to dbus

6
gnu/packages/java.scm
View File

@ -2353,6 +2353,12 @@ new Date();"))
(string-join (string-split version #\.) "u") (string-join (string-split version #\.) "u")
"-ga")))) "-ga"))))
(file-name (string-append name "-" version "-checkout")) (file-name (string-append name "-" version "-checkout"))
(modules '((guix build utils)))
(snippet
'(begin
;; Delete included gradle jar
(delete-file-recursively "gradle/wrapper")
#t))
(sha256 (sha256
(base32 (base32
"0yg38mwpivswccv9n96k06x3iv82i4px1a9xg9l8dswzwmfj259f")))) "0yg38mwpivswccv9n96k06x3iv82i4px1a9xg9l8dswzwmfj259f"))))

4
gnu/packages/kodi.scm
View File

@ -269,7 +269,7 @@ alternatives. In compilers, this can reduce the cascade of secondary errors.")
(define-public kodi (define-public kodi
(package (package
(name "kodi") (name "kodi")
(version "18.4") (version "18.6")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -278,7 +278,7 @@ alternatives. In compilers, this can reduce the cascade of secondary errors.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"1m0295czxabdcqyqf5m94av9d88pzhnzjvyfs1q07xqq82h313p7")) "0rwymipn5hljy5xrslzmrljmj6f9wb191wi7gjw20wl6sv44d0bk"))
(patches (search-patches "kodi-skip-test-449.patch" (patches (search-patches "kodi-skip-test-449.patch"
"kodi-increase-test-timeout.patch" "kodi-increase-test-timeout.patch"
"kodi-set-libcurl-ssl-parameters.patch")) "kodi-set-libcurl-ssl-parameters.patch"))

8
gnu/packages/lisp-xyz.scm
View File

@ -3008,7 +3008,7 @@ is a library for creating graphical user interfaces.")
(sbcl-package->cl-source-package sbcl-cl-cffi-gtk)) (sbcl-package->cl-source-package sbcl-cl-cffi-gtk))
(define-public sbcl-cl-webkit (define-public sbcl-cl-webkit
(let ((commit "cd2a9008e0c152e54755e8a7f07b050fe36bab31")) (let ((commit "79ad41996a1bd7fc8e53fe8d168e8f2030603b14"))
(package (package
(name "sbcl-cl-webkit") (name "sbcl-cl-webkit")
(version (git-version "2.4" "1" commit)) (version (git-version "2.4" "1" commit))
@ -3016,12 +3016,12 @@ is a library for creating graphical user interfaces.")
(origin (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
(url "https://github.com/jmercouris/cl-webkit") (url "https://github.com/joachifm/cl-webkit")
(commit commit))) (commit commit)))
(file-name (git-file-name "cl-webkit" version)) (file-name (git-file-name "cl-webkit" version))
(sha256 (sha256
(base32 (base32
"0f5lyn9i7xrn3g1bddga377mcbawkbxydijpg389q4n04gqj0vwf")))) "1gxvmxmss5k79v2ccigx92q46zbydxh9r7plnnqh8na348pffgcs"))))
(build-system asdf-build-system/sbcl) (build-system asdf-build-system/sbcl)
(inputs (inputs
`(("cffi" ,sbcl-cffi) `(("cffi" ,sbcl-cffi)
@ -3038,7 +3038,7 @@ is a library for creating graphical user interfaces.")
(("libwebkit2gtk" all) (("libwebkit2gtk" all)
(string-append (string-append
(assoc-ref inputs "webkitgtk") "/lib/" all)))))))) (assoc-ref inputs "webkitgtk") "/lib/" all))))))))
(home-page "https://github.com/jmercouris/cl-webkit") (home-page "https://github.com/joachifm/cl-webkit")
(synopsis "Binding to WebKitGTK+ for Common Lisp") (synopsis "Binding to WebKitGTK+ for Common Lisp")
(description (description
"@command{cl-webkit} is a binding to WebKitGTK+ for Common Lisp, "@command{cl-webkit} is a binding to WebKitGTK+ for Common Lisp,

26
gnu/packages/maths.scm
View File

@ -34,6 +34,7 @@
;;; Copyright © 2019 Steve Sprang <scs@stevesprang.com> ;;; Copyright © 2019 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2019 Robert Smith <robertsmith@posteo.net> ;;; Copyright © 2019 Robert Smith <robertsmith@posteo.net>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020 Felix Gruber <felgru@posteo.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -3405,16 +3406,18 @@ Fresnel integrals, and similar related functions as well.")
(define-public suitesparse (define-public suitesparse
(package (package
(name "suitesparse") (name "suitesparse")
(version "4.5.5") (version "5.7.1")
(source (source
(origin (origin
(method url-fetch) (method git-fetch)
(uri (string-append (uri (git-reference
"http://faculty.cse.tamu.edu/davis/SuiteSparse/SuiteSparse-" (url "https://github.com/DrTimothyAldenDavis/SuiteSparse.git")
version ".tar.gz")) (commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"1dnr6pmjzc2qmbkmb4shigx1l74ilf6abn7svyd6brxgvph8vadr")) "174p3l78kv9gaa0i5hflyai2ydwnjzh34k9938sl4aa3li0543s8"))
(patches (search-patches "suitesparse-mongoose-cmake.patch"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
;; Remove bundled metis source ;; Remove bundled metis source
@ -3429,6 +3432,14 @@ Fresnel integrals, and similar related functions as well.")
"BLAS=-lblas" "BLAS=-lblas"
"TBB=-ltbb" "TBB=-ltbb"
"MY_METIS_LIB=-lmetis" "MY_METIS_LIB=-lmetis"
;; Flags for cmake (required to build GraphBLAS and Mongoose)
(string-append "CMAKE_OPTIONS=-DCMAKE_INSTALL_PREFIX="
(assoc-ref %outputs "out")
" -DCMAKE_VERBOSE_MAKEFILE=ON"
" -DCMAKE_C_FLAGS_RELEASE=\"$(CFLAGS) $(CPPFLAGS)\""
" -DCMAKE_CXX_FLAGS_RELEASE=\"$(CXXFLAGS) $(CPPFLAGS)\""
" -DCMAKE_SKIP_RPATH=TRUE"
" -DCMAKE_BUILD_TYPE=Release")
(string-append "INSTALL_LIB=" (string-append "INSTALL_LIB="
(assoc-ref %outputs "out") "/lib") (assoc-ref %outputs "out") "/lib")
(string-append "INSTALL_INCLUDE=" (string-append "INSTALL_INCLUDE="
@ -3441,6 +3452,9 @@ Fresnel integrals, and similar related functions as well.")
`(("tbb" ,tbb) `(("tbb" ,tbb)
("lapack" ,lapack) ("lapack" ,lapack)
("metis" ,metis))) ("metis" ,metis)))
(native-inputs
`(("cmake" ,cmake)
("m4" ,m4)))
(home-page "http://faculty.cse.tamu.edu/davis/suitesparse.html") (home-page "http://faculty.cse.tamu.edu/davis/suitesparse.html")
(synopsis "Suite of sparse matrix software") (synopsis "Suite of sparse matrix software")
(description (description

31
gnu/packages/patches/appstream-glib-2020.patch
View File

@ -1,31 +0,0 @@
2020 is no longer the future.
Taken from upstream:
https://github.com/hughsie/appstream-glib/commit/953c8e529d7291e60a95e580967ed79ce2c9ccf0
diff --git a/data/tests/broken.appdata.xml b/data/tests/broken.appdata.xml
index f7a5386e..cf80f5b4 100644
--- a/data/tests/broken.appdata.xml
+++ b/data/tests/broken.appdata.xml
@@ -40,7 +40,7 @@
<p>This is a duplicate release on the same day!</p>
</description>
</release>
- <release date="2020-01-01" version="0.6.2">
+ <release date="2050-01-01" version="0.6.2">
<description>
<p>This is a release in the future!</p>
</description>
diff --git a/libappstream-glib/as-app-validate.c b/libappstream-glib/as-app-validate.c
index c1103ace..f50e4e41 100644
--- a/libappstream-glib/as-app-validate.c
+++ b/libappstream-glib/as-app-validate.c
@@ -864,7 +864,7 @@ as_app_validate_release (AsApp *app,
AS_PROBLEM_KIND_ATTRIBUTE_MISSING,
"<release> has no timestamp");
}
- if (timestamp > 20120101 && timestamp < 20251231) {
+ if (timestamp > 20120101 && timestamp < 20351231) {
ai_app_validate_add (helper,
AS_PROBLEM_KIND_ATTRIBUTE_INVALID,
"<release> timestamp should be a UNIX time");

81
gnu/packages/patches/ceph-boost-compat.patch
View File

@ -1,81 +0,0 @@
Fix compatibility with Boost 1.70.
Adapted for 14.2.5 from these upstream commits:
https://github.com/ceph/ceph/commit/064f142746ae97f54865069cdacf5aae2b1b14f6
https://github.com/ceph/ceph/commit/f1651b8c509d60787d10c4115e29fecfd2da237c
diff --git a/src/rgw/rgw_asio_frontend.cc b/src/rgw/rgw_asio_frontend.cc
--- a/src/rgw/rgw_asio_frontend.cc
+++ b/src/rgw/rgw_asio_frontend.cc
@@ -83,7 +83,8 @@
using SharedMutex = ceph::async::SharedMutex<boost::asio::io_context::executor_type>;
template <typename Stream>
-void handle_connection(RGWProcessEnv& env, Stream& stream,
+void handle_connection(boost::asio::io_context& context,
+ RGWProcessEnv& env, Stream& stream,
parse_buffer& buffer, bool is_ssl,
SharedMutex& pause_mutex,
rgw::dmclock::Scheduler *scheduler,
@@ -160,7 +161,7 @@
rgw::io::add_conlen_controlling(
&real_client))));
RGWRestfulIO client(cct, &real_client_io);
- auto y = optional_yield{socket.get_io_context(), yield};
+ auto y = optional_yield{context, yield};
process_request(env.store, env.rest, &req, env.uri_prefix,
*env.auth_registry, &client, env.olog, y, scheduler);
}
@@ -604,7 +605,7 @@
return;
}
buffer->consume(bytes);
- handle_connection(env, stream, *buffer, true, pause_mutex,
+ handle_connection(context, env, stream, *buffer, true, pause_mutex,
scheduler.get(), ec, yield);
if (!ec) {
// ssl shutdown (ignoring errors)
@@ -622,7 +623,7 @@
auto c = connections.add(conn);
auto buffer = std::make_unique<parse_buffer>();
boost::system::error_code ec;
- handle_connection(env, s, *buffer, false, pause_mutex,
+ handle_connection(context, env, s, *buffer, false, pause_mutex,
scheduler.get(), ec, yield);
s.shutdown(tcp::socket::shutdown_both, ec);
});
diff --git a/src/rgw/rgw_dmclock_async_scheduler.h b/src/rgw/rgw_dmclock_async_scheduler.h
--- a/src/rgw/rgw_dmclock_async_scheduler.h
+++ b/src/rgw/rgw_dmclock_async_scheduler.h
@@ -82,7 +82,12 @@ class AsyncScheduler : public md_config_obs_t, public Scheduler {
using Completion = async::Completion<Signature, async::AsBase<Request>>;
using Clock = ceph::coarse_real_clock;
+#if BOOST_VERSION < 107000
using Timer = boost::asio::basic_waitable_timer<Clock>;
+#else
+ using Timer = boost::asio::basic_waitable_timer<Clock,
+ boost::asio::wait_traits<Clock>, executor_type>;
+#endif
Timer timer; //< timer for the next scheduled request
CephContext *const cct;
diff --git a/src/rgw/rgw_reshard.h b/src/rgw/rgw_reshard.h
--- a/src/rgw/rgw_reshard.h
+++ b/src/rgw/rgw_reshard.h
@@ -183,7 +183,14 @@ class RGWReshardWait {
ceph::condition_variable cond;
struct Waiter : boost::intrusive::list_base_hook<> {
- boost::asio::basic_waitable_timer<Clock> timer;
+#if BOOST_VERSION < 107000
+ using Timer = boost::asio::basic_waitable_timer<Clock>;
+#else
+ using Executor = boost::asio::io_context::executor_type;
+ using Timer = boost::asio::basic_waitable_timer<Clock,
+ boost::asio::wait_traits<Clock>, Executor>;
+#endif
+ Timer timer;
explicit Waiter(boost::asio::io_context& ioc) : timer(ioc) {}
};
boost::intrusive::list<Waiter> waiters;

22
gnu/packages/patches/ceph-volume-respect-PATH.patch
View File

@ -1,22 +0,0 @@
Look for required tools in $PATH instead of just a handful locations.
diff --git a/src/ceph-volume/ceph_volume/util/system.py b/src/ceph-volume/ceph_volume/util/system.py
index b637f023a4..14516e1c65 100644
--- a/src/ceph-volume/ceph_volume/util/system.py
+++ b/src/ceph-volume/ceph_volume/util/system.py
@@ -33,14 +33,7 @@ def generate_uuid():
def which(executable):
"""find the location of an executable"""
- locations = (
- '/usr/local/bin',
- '/bin',
- '/usr/bin',
- '/usr/local/sbin',
- '/usr/sbin',
- '/sbin',
- )
+ locations = os.getenv('PATH').split(':')
for location in locations:
executable_path = os.path.join(location, executable)

322
gnu/packages/patches/libgit2-avoid-python.patch
View File

@ -1,322 +0,0 @@
This provides a Guile reimplementation of clar's "generate.py".
It makes it possible for us to remove Python from libgit2's build-time
dependencies.
libgit2 is used in order to fetch a lot of sources for guix packages.
Both Python2 and Python3 builds acted up in the past.
Hence this patch which makes the number of libgit2 dependencies very
small.
The reimplementation tries to keep as close as possible to the original
in both structure and runtime effect. Some things are thus overly
convoluted just to make them the same as in the original.
Both implementations basically do:
grep -r 'test_.*__.*' . > clar.suite
It is important that the directory traversal order of the original and
the reimplementation stay the same.
diff -ruN orig/libgit2-0.27.7/tests/CMakeLists.txt libgit2-0.27.7/tests/CMakeLists.txt
--- orig/libgit2-0.27.7/tests/CMakeLists.txt 1970-01-01 01:00:00.000000000 +0100
+++ libgit2-0.27.7/tests/CMakeLists.txt 2019-03-04 11:13:06.640118979 +0100
@@ -1,10 +1,3 @@
-FIND_PACKAGE(PythonInterp)
-
-IF(NOT PYTHONINTERP_FOUND)
- MESSAGE(FATAL_ERROR "Could not find a python interpeter, which is needed to build the tests. "
- "Make sure python is available, or pass -DBUILD_CLAR=OFF to skip building the tests")
-ENDIF()
-
SET(CLAR_FIXTURES "${CMAKE_CURRENT_SOURCE_DIR}/resources/")
SET(CLAR_PATH "${CMAKE_CURRENT_SOURCE_DIR}")
ADD_DEFINITIONS(-DCLAR_FIXTURE_PATH=\"${CLAR_FIXTURES}\")
@@ -21,7 +14,7 @@
ADD_CUSTOM_COMMAND(
OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/clar.suite
- COMMAND ${PYTHON_EXECUTABLE} generate.py -o "${CMAKE_CURRENT_BINARY_DIR}" -f -xonline -xstress -xperf .
+ COMMAND guile generate.scm -o "${CMAKE_CURRENT_BINARY_DIR}" -f -x online -x stress -x perf .
DEPENDS ${SRC_TEST}
WORKING_DIRECTORY ${CLAR_PATH}
)
diff -ruN orig/libgit2-0.27.7/tests/generate.scm libgit2-0.27.7/tests/generate.scm
--- orig/libgit2-0.27.7/tests/generate.scm 1970-01-01 01:00:00.000000000 +0100
+++ libgit2-0.27.7/tests/generate.scm 2019-03-04 12:18:00.688040975 +0100
@@ -0,0 +1,277 @@
+;; -*- geiser-scheme-implementation: guile -*-
+
+;;; Implementation: Danny Milosavljevic <dannym@scratchpost.org>
+;;; Based on: Implementation in Python by Vicent Marti.
+;;; License: ISC, like the original generate.py in clar.
+
+(use-modules (ice-9 ftw))
+(use-modules (ice-9 regex))
+(use-modules (ice-9 getopt-long))
+(use-modules (ice-9 rdelim))
+(use-modules (ice-9 match))
+(use-modules (ice-9 textual-ports))
+(use-modules (srfi srfi-1))
+
+(define (render-callback cb)
+ (if cb
+ (string-append " { \"" (assoc-ref cb "short-name") "\", &"
+ (assoc-ref cb "symbol") " }")
+ " { NULL, NULL }"))
+
+(define (replace needle replacement haystack)
+ "Replace all occurences of NEEDLE in HAYSTACK by REPLACEMENT.
+NEEDLE is a regular expression."
+ (regexp-substitute/global #f needle haystack 'pre replacement 'post))
+
+(define (skip-comments* text)
+ (call-with-input-string
+ text
+ (lambda (port)
+ (let loop ((result '())
+ (section #f))
+ (define (consume-char)
+ (cons (read-char port) result))
+ (define (skip-char)
+ (read-char port)
+ result)
+ (match section
+ (#f
+ (match (peek-char port)
+ (#\/ (loop (consume-char) 'almost-in-block-comment))
+ (#\" (loop (consume-char) 'in-string-literal))
+ (#\' (loop (consume-char) 'in-character-literal))
+ ((? eof-object?) result)
+ (_ (loop (consume-char) section))))
+ ('almost-in-block-comment
+ (match (peek-char port)
+ (#\* (loop (consume-char) 'in-block-comment))
+ (#\/ (loop (consume-char) 'in-line-comment))
+ ((? eof-object?) result)
+ (_ (loop (consume-char) #f))))
+ ('in-line-comment
+ (match (peek-char port)
+ (#\newline (loop (consume-char) #f))
+ ((? eof-object?) result)
+ (_ (loop (skip-char) section))))
+ ('in-block-comment
+ (match (peek-char port)
+ (#\* (loop (skip-char) 'almost-out-of-block-comment))
+ ((? eof-object?) result)
+ (_ (loop (skip-char) section))))
+ ('almost-out-of-block-comment
+ (match (peek-char port)
+ (#\/ (loop (cons (read-char port) (cons #\* result)) #f))
+ (#\* (loop (skip-char) 'almost-out-of-block-comment))
+ ((? eof-object?) result)
+ (_ (loop (skip-char) 'in-block-comment))))
+ ('in-string-literal
+ (match (peek-char port)
+ (#\\ (loop (consume-char) 'in-string-literal-escape))
+ (#\" (loop (consume-char) #f))
+ ((? eof-object?) result)
+ (_ (loop (consume-char) section))))
+ ('in-string-literal-escape
+ (match (peek-char port)
+ ((? eof-object?) result)
+ (_ (loop (consume-char) 'in-string-literal))))
+ ('in-character-literal
+ (match (peek-char port)
+ (#\\ (loop (consume-char) 'in-character-literal-escape))
+ (#\' (loop (consume-char) #f))
+ ((? eof-object?) result)
+ (_ (loop (consume-char) section))))
+ ('in-character-literal-escape
+ (match (peek-char port)
+ ((? eof-object?) result)
+ (_ (loop (consume-char) 'in-character-literal)))))))))
+
+(define (skip-comments text)
+ (list->string (reverse (skip-comments* text))))
+
+(define (maybe-only items)
+ (match items
+ ((a) a)
+ (_ #f)))
+
+(define (Module name path excludes)
+ (let* ((clean-name (replace "_" "::" name))
+ (enabled (not (any (lambda (exclude)
+ (string-prefix? exclude clean-name))
+ excludes))))
+ (define (parse contents)
+ (define (cons-match match prev)
+ (cons
+ `(("declaration" . ,(match:substring match 1))
+ ("symbol" . ,(match:substring match 2))
+ ("short-name" . ,(match:substring match 3)))
+ prev))
+ (let* ((contents (skip-comments contents))
+ (entries (fold-matches (make-regexp
+ (string-append "^(void\\s+(test_"
+ name
+ "__(\\w+))\\s*\\(\\s*void\\s*\\))\\s*\\{")
+ regexp/newline)
+ contents
+ '()
+ cons-match))
+ (entries (reverse entries))
+ (callbacks (filter (lambda (entry)
+ (match (assoc-ref entry "short-name")
+ ("initialize" #f)
+ ("cleanup" #f)
+ (_ #t)))
+ entries)))
+ (if (> (length callbacks) 0)
+ `(("name" . ,name)
+ ("enabled" . ,(if enabled "1" "0"))
+ ("clean-name" . ,clean-name)
+ ("initialize" . ,(maybe-only (filter-map (lambda (entry)
+ (match (assoc-ref entry "short-name")
+ ("initialize" entry)
+ (_ #f)))
+ entries)))
+ ("cleanup" . ,(maybe-only (filter-map (lambda (entry)
+ (match (assoc-ref entry "short-name")
+ ("cleanup" entry)
+ (_ #f)))
+ entries)))
+ ("callbacks" . ,callbacks))
+ #f)))
+
+ (define (refresh path)
+ (and (file-exists? path)
+ (parse (call-with-input-file path get-string-all))))
+ (refresh path)))
+
+(define (generate-TestSuite path output excludes)
+ (define (load)
+ (define enter? (const #t))
+ (define (leaf file stat result)
+ (let* ((module-root (string-drop (dirname file)
+ (string-length path)))
+ (module-root (filter-map (match-lambda
+ ("" #f)
+ (a a))
+ (string-split module-root #\/))))
+ (define (make-module path)
+ (let* ((name (string-join (append module-root (list (string-drop-right (basename path) (string-length ".c")))) "_"))
+ (name (replace "-" "_" name)))
+ (Module name path excludes)))
+ (if (string-suffix? ".c" file)
+ (let ((module (make-module file)))
+ (if module
+ (cons module result)
+ result))
+ result)))
+ (define (down dir stat result)
+ result)
+ (define (up file state result)
+ result)
+ (define skip (const #f))
+ (file-system-fold enter? leaf down up skip error '() path))
+
+ (define (CallbacksTemplate module)
+ (string-append "static const struct clar_func _clar_cb_"
+ (assoc-ref module "name") "[] = {\n"
+ (string-join (map render-callback
+ (assoc-ref module "callbacks"))
+ ",\n")
+ "\n};\n"))
+
+ (define (DeclarationTemplate module)
+ (string-append (string-join (map (lambda (cb)
+ (string-append "extern "
+ (assoc-ref cb "declaration")
+ ";"))
+ (assoc-ref module "callbacks"))
+ "\n")
+ "\n"
+ (if (assoc-ref module "initialize")
+ (string-append "extern " (assoc-ref (assoc-ref module "initialize") "declaration") ";\n")
+ "")
+ (if (assoc-ref module "cleanup")
+ (string-append "extern " (assoc-ref (assoc-ref module "cleanup") "declaration") ";\n")
+ "")))
+
+ (define (InfoTemplate module)
+ (string-append "
+ {
+ \"" (assoc-ref module "clean-name") "\",
+ " (render-callback (assoc-ref module "initialize")) ",
+ " (render-callback (assoc-ref module "cleanup")) ",
+ _clar_cb_" (assoc-ref module "name") ", "
+ (number->string (length (assoc-ref module "callbacks")))
+ ", " (assoc-ref module "enabled") "
+ }"))
+
+ (define (Write data)
+ (define (name< module-a module-b)
+ (string<? (assoc-ref module-a "name")
+ (assoc-ref module-b "name")))
+ (define modules (sort (load) name<))
+
+ (define (suite-count)
+ (length modules))
+
+ (define (callback-count)
+ (fold + 0 (map (lambda (entry)
+ (length (assoc-ref entry "callbacks")))
+ modules)))
+
+ (define (display-x value)
+ (display value data))
+
+ (for-each (compose display-x DeclarationTemplate) modules)
+ (for-each (compose display-x CallbacksTemplate) modules)
+
+ (display-x "static struct clar_suite _clar_suites[] = {")
+ (display-x (string-join (map InfoTemplate modules) ","))
+ (display-x "\n};\n")
+
+ (let ((suite-count-str (number->string (suite-count)))
+ (callback-count-str (number->string (callback-count))))
+ (display-x "static const size_t _clar_suite_count = ")
+ (display-x suite-count-str)
+ (display-x ";\n")
+
+ (display-x "static const size_t _clar_callback_count = ")
+ (display-x callback-count-str)
+ (display-x ";\n")
+
+ (display (string-append "Written `clar.suite` ("
+ callback-count-str
+ " tests in "
+ suite-count-str
+ " suites)"))
+ (newline))
+ #t)
+
+ (call-with-output-file (string-append output "/clar.suite") Write))
+
+;;; main
+
+(define (main)
+ (define option-spec
+ '((force (single-char #\f) (value #f))
+ (exclude (single-char #\x) (value #t))
+ (output (single-char #\o) (value #t))
+ (help (single-char #\h) (value #f))))
+
+ (define options (getopt-long (command-line) option-spec #:stop-at-first-non-option #t))
+ (define args (reverse (option-ref options '() '())))
+ (when (> (length args) 1)
+ (display "More than one path given\n")
+ (exit 1))
+
+ (if (< (length args) 1)
+ (set! args '(".")))
+
+ (let* ((path (car args))
+ (output (option-ref options 'output path))
+ (excluded (filter-map (match-lambda
+ (('exclude . value) value)
+ (_ #f))
+ options)))
+ (generate-TestSuite path output excluded)))
+
+(main)

27
gnu/packages/patches/suitesparse-mongoose-cmake.patch 100644
View File

@ -0,0 +1,27 @@
Fix required by suitesparse to build Mongoose
The CMakeLists.txt of Mongoose assumes that SuiteSparse_config has been
installed into the suitesparse source directory, which is not the case
for us, as we are building suitesparse out-of-tree.
SuiteSparse_config can instead be found in the ${CMAKE_INSTALL_PREFIX}
directory.
diff --git a/Mongoose/CMakeLists.txt b/Mongoose/CMakeLists.txt
index 7e134ab..76fa9e2 100644
--- a/Mongoose/CMakeLists.txt
+++ b/Mongoose/CMakeLists.txt
@@ -148,10 +148,10 @@ set(CMAKE_CXX_STANDARD 11)
#set(CMAKE_CXX_STANDARD_REQUIRED ON)
# determine which SuiteSparse_config to use
-if (EXISTS ${PROJECT_SOURCE_DIR}/../SuiteSparse_config)
- message(STATUS "External ../SuiteSparse_config" ${BoldBlue} " found" ${ColourReset} ".")
+if (EXISTS ${CMAKE_INSTALL_PREFIX})
+ message(STATUS "External SuiteSparse_config" ${BoldBlue} " found" ${ColourReset} ".")
set ( SUITESPARSE_CONFIG_DIR ${PROJECT_SOURCE_DIR}/../SuiteSparse_config )
- link_directories ( ${PROJECT_SOURCE_DIR}/../lib )
+ link_directories ( ${CMAKE_INSTALL_PREFIX}/lib )
message ( STATUS "Note: ../SuiteSparse_config must be compiled before compiling Mongoose" )
set ( SUITESPARSE_CONFIG_LIBRARY suitesparseconfig )
else ()

6
gnu/packages/patchutils.scm
View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2018 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014, 2018 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015, 2018 Leo Famulari <leo@famulari.name> ;;; Copyright © 2015, 2018 Leo Famulari <leo@famulari.name>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -247,7 +247,7 @@ GiB).")
(define-public meld (define-public meld
(package (package
(name "meld") (name "meld")
(version "3.20.1") (version "3.20.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -255,7 +255,7 @@ GiB).")
(version-major+minor version) (version-major+minor version)
"/meld-" version ".tar.xz")) "/meld-" version ".tar.xz"))
(sha256 (sha256
(base32 "0jdj7kd6vj1mdc16gvrj1kar88b2j5875ajq18fx7cbc9ny46j55")))) (base32 "0a0x156zr3w2yg0rnhwy39giy3xnfm6sqcfa4xcw4i6ahvwqa2dc"))))
(build-system python-build-system) (build-system python-build-system)
(native-inputs (native-inputs
`(("intltool" ,intltool) `(("intltool" ,intltool)

22
gnu/packages/pdf.scm
View File

@ -226,7 +226,7 @@ When present, Poppler is able to correctly render CJK and Cyrillic text.")
("python-pyqt" ,python-pyqt) ("python-pyqt" ,python-pyqt)
("poppler-qt5" ,poppler-qt5) ("poppler-qt5" ,poppler-qt5)
("qtbase" ,qtbase))) ("qtbase" ,qtbase)))
(home-page "https://pypi.python.org/pypi/python-poppler-qt5") (home-page "https://pypi.org/project/python-poppler-qt5/")
(synopsis "Python bindings for Poppler-Qt5") (synopsis "Python bindings for Poppler-Qt5")
(description (description
"This package provides Python bindings for the Qt5 interface of the "This package provides Python bindings for the Qt5 interface of the
@ -392,7 +392,7 @@ using libspectre.")
(define-public zathura-djvu (define-public zathura-djvu
(package (package
(name "zathura-djvu") (name "zathura-djvu")
(version "0.2.8") (version "0.2.9")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (uri
@ -400,7 +400,7 @@ using libspectre.")
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0axkv1crdxn0z44whaqp2ibkdqcykhjnxk7qzms0dp1b67an9rnh")))) "0062n236414db7q7pnn3ccg5111ghxj3407pn9ri08skxskgirln"))))
(native-inputs `(("pkg-config" ,pkg-config))) (native-inputs `(("pkg-config" ,pkg-config)))
(inputs (inputs
`(("djvulibre" ,djvulibre) `(("djvulibre" ,djvulibre)
@ -472,7 +472,7 @@ by using the @code{mupdf} rendering library.")
(define-public zathura-pdf-poppler (define-public zathura-pdf-poppler
(package (package
(name "zathura-pdf-poppler") (name "zathura-pdf-poppler")
(version "0.2.9") (version "0.3.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (uri
@ -480,7 +480,7 @@ by using the @code{mupdf} rendering library.")
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1p4jcny0jniygns78mcf0nlm298dszh49qpmjmackrm6dq8hc25y")))) "1vfl4vkyy3rf39r1sqaa7y8113bgkh2bkfq3nn2inis9mrykmk6m"))))
(native-inputs `(("pkg-config" ,pkg-config))) (native-inputs `(("pkg-config" ,pkg-config)))
(inputs (inputs
`(("poppler" ,poppler) `(("poppler" ,poppler)
@ -508,7 +508,7 @@ by using the poppler rendering engine.")
(define-public zathura (define-public zathura
(package (package
(name "zathura") (name "zathura")
(version "0.4.3") (version "0.4.5")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (uri
@ -516,7 +516,7 @@ by using the poppler rendering engine.")
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0hgx5x09i6d0z45llzdmh4l348fxh1y102sb1w76f2fp4r21j4ky")))) "0b3nrcvykkpv2vm99kijnic2gpfzva520bsjlihaxandzfm9ff8c"))))
(native-inputs `(("pkg-config" ,pkg-config) (native-inputs `(("pkg-config" ,pkg-config)
("gettext" ,gettext-minimal) ("gettext" ,gettext-minimal)
("glib:bin" ,glib "bin") ("glib:bin" ,glib "bin")
@ -1270,13 +1270,13 @@ manipulating PDF documents from the command line. It supports
(define-public weasyprint (define-public weasyprint
(package (package
(name "weasyprint") (name "weasyprint")
(version "50") (version "51")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "WeasyPrint" version)) (uri (pypi-uri "WeasyPrint" version))
(sha256 (sha256
(base32 "0invs96zvmcr6wh5klj52jrcnr9qg150v9wpmbhcsf3vv1d1hbcw")) (base32 "0skdzwq7cd715dnnds6abx0k0xmmnmsqp0vb1r1w20sg7abp3sdk"))
(patches (search-patches "weasyprint-library-paths.patch")))) (patches (search-patches "weasyprint-library-paths.patch"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
@ -1304,11 +1304,11 @@ manipulating PDF documents from the command line. It supports
(lambda _ (lambda _
(substitute* "setup.cfg" (substitute* "setup.cfg"
;; flake8 and isort syntax checks fail, which is not our ;; flake8 and isort syntax checks fail, which is not our
;; business ;; business.
(("addopts = --flake8 --isort") "")))) (("addopts = --flake8 --isort") ""))))
(replace 'check (replace 'check
(lambda _ (lambda _
;; run pytest, excluding one failing test ;; Run pytest, excluding one failing test.
(invoke "pytest" "-k" "not test_flex_column_wrap_reverse")))))) (invoke "pytest" "-k" "not test_flex_column_wrap_reverse"))))))
(inputs (inputs
`(("fontconfig" ,fontconfig) `(("fontconfig" ,fontconfig)

22
gnu/packages/python-web.scm
View File

@ -972,7 +972,7 @@ object to help create WSGI responses.")
(base32 (base32
"1ksbc726av9xacml6jhcfyn828hlhb9xlddpx6fcvnlvmpmpvhk9")))) "1ksbc726av9xacml6jhcfyn828hlhb9xlddpx6fcvnlvmpmpvhk9"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://pypi.python.org/pypi/zope.event") (home-page "https://pypi.org/project/zope.event/")
(synopsis "Event publishing system for Python") (synopsis "Event publishing system for Python")
(description "Zope.event provides an event publishing API, intended for (description "Zope.event provides an event publishing API, intended for
use by applications which are unaware of any subscribers to their events. It use by applications which are unaware of any subscribers to their events. It
@ -1021,10 +1021,10 @@ conforming to a given API or contract.")
"0zwxaaa66sqxg5k7zcrvs0fbg9ym1njnxnr28dfmchzhwjvwnfzl")))) "0zwxaaa66sqxg5k7zcrvs0fbg9ym1njnxnr28dfmchzhwjvwnfzl"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
'(#:tests? #f)) ; circular dependency with zope.testrunner '(#:tests? #f)) ; circular dependency with zope.testrunner
(propagated-inputs (propagated-inputs
`(("python-zope-interface" ,python-zope-interface))) `(("python-zope-interface" ,python-zope-interface)))
(home-page "http://cheeseshop.python.org/pypi/zope.exceptions") (home-page "https://pypi.org/project/zope.exceptions/")
(synopsis "Zope exceptions") (synopsis "Zope exceptions")
(description "Zope.exceptions provides general-purpose exception types (description "Zope.exceptions provides general-purpose exception types
that have uses outside of the Zope framework.") that have uses outside of the Zope framework.")
@ -1051,7 +1051,7 @@ that have uses outside of the Zope framework.")
(for-each delete-file (find-files "." "(\\.pyc|~)$")) (for-each delete-file (find-files "." "(\\.pyc|~)$"))
#t)))) #t))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://pypi.python.org/pypi/zope.testing") (home-page "https://pypi.org/project/zope.testing/")
(synopsis "Zope testing helpers") (synopsis "Zope testing helpers")
(description "Zope.testing provides a number of testing utilities for HTML (description "Zope.testing provides a number of testing utilities for HTML
forms, HTTP servers, regular expressions, and more.") forms, HTTP servers, regular expressions, and more.")
@ -1082,7 +1082,7 @@ forms, HTTP servers, regular expressions, and more.")
("unzip" ,unzip))) ("unzip" ,unzip)))
(propagated-inputs (propagated-inputs
`(("python-zope-interface" ,python-zope-interface))) `(("python-zope-interface" ,python-zope-interface)))
(home-page "https://pypi.python.org/pypi/zope.testrunner") (home-page "https://pypi.org/project/zope.testrunner/")
(synopsis "Zope testrunner script") (synopsis "Zope testrunner script")
(description "Zope.testrunner provides a script for running Python (description "Zope.testrunner provides a script for running Python
tests.") tests.")
@ -1109,7 +1109,7 @@ tests.")
(base32 (base32
"1rslyph0klk58dmjjy4j0jxy21k03azksixc3x2xhqbkv97cmzml")))) "1rslyph0klk58dmjjy4j0jxy21k03azksixc3x2xhqbkv97cmzml"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://pypi.python.org/pypi/zope.i18nmessageid") (home-page "https://pypi.org/project/zope.i18nmessageid/")
(synopsis "Message identifiers for internationalization") (synopsis "Message identifiers for internationalization")
(description "Zope.i18nmessageid provides facilities for declaring (description "Zope.i18nmessageid provides facilities for declaring
internationalized messages within program source text.") internationalized messages within program source text.")
@ -1140,7 +1140,7 @@ internationalized messages within program source text.")
`(("python-zope-testing" ,python-zope-testing) `(("python-zope-testing" ,python-zope-testing)
("python-coverage" ,python-coverage) ("python-coverage" ,python-coverage)
("python-nose" ,python-nose))) ("python-nose" ,python-nose)))
(home-page "https://pypi.python.org/pypi/zope.schema") (home-page "https://pypi.org/project/zope.schema/")
(synopsis "Zope data schemas") (synopsis "Zope data schemas")
(description "Zope.scheme provides extensions to zope.interface for (description "Zope.scheme provides extensions to zope.interface for
defining data schemas.") defining data schemas.")
@ -1165,7 +1165,7 @@ defining data schemas.")
(propagated-inputs (propagated-inputs
`(("python-zope-i18nmessageid" ,python-zope-i18nmessageid) `(("python-zope-i18nmessageid" ,python-zope-i18nmessageid)
("python-zope-schema" ,python-zope-schema))) ("python-zope-schema" ,python-zope-schema)))
(home-page "https://pypi.python.org/pypi/zope.configuration") (home-page "https://pypi.org/project/zope.configuration/")
(synopsis "Zope Configuration Markup Language") (synopsis "Zope Configuration Markup Language")
(description "Zope.configuration implements ZCML, the Zope Configuration (description "Zope.configuration implements ZCML, the Zope Configuration
Markup Language.") Markup Language.")
@ -1190,7 +1190,7 @@ Markup Language.")
'(#:tests? #f)) ; FIXME: Tests can't find zope.interface. '(#:tests? #f)) ; FIXME: Tests can't find zope.interface.
(propagated-inputs (propagated-inputs
`(("python-zope-interface" ,python-zope-interface))) `(("python-zope-interface" ,python-zope-interface)))
(home-page "https://pypi.python.org/pypi/zope.proxy") (home-page "https://pypi.org/project/zope.proxy/")
(synopsis "Generic, transparent proxies") (synopsis "Generic, transparent proxies")
(description "Zope.proxy provides generic, transparent proxies for Python. (description "Zope.proxy provides generic, transparent proxies for Python.
Proxies are special objects which serve as mostly-transparent wrappers around Proxies are special objects which serve as mostly-transparent wrappers around
@ -1219,7 +1219,7 @@ brokering, etc.) for which the proxy is responsible.")
(propagated-inputs (propagated-inputs
`(("python-zope-proxy" ,python-zope-proxy) `(("python-zope-proxy" ,python-zope-proxy)
("python-zope-schema" ,python-zope-schema))) ("python-zope-schema" ,python-zope-schema)))
(home-page "https://pypi.python.org/pypi/zope.location/") (home-page "https://pypi.org/project/zope.location/")
(synopsis "Zope location library") (synopsis "Zope location library")
(description "Zope.location implements the concept of \"locations\" in (description "Zope.location implements the concept of \"locations\" in
Zope3, which are are special objects that have a structural location.") Zope3, which are are special objects that have a structural location.")
@ -1253,7 +1253,7 @@ Zope3, which are are special objects that have a structural location.")
("python-zope-location" ,python-zope-location) ("python-zope-location" ,python-zope-location)
("python-zope-testrunner" ,python-zope-testrunner) ("python-zope-testrunner" ,python-zope-testrunner)
("python-zope-testing" ,python-zope-testing))) ("python-zope-testing" ,python-zope-testing)))
(home-page "https://pypi.python.org/pypi/zope.security") (home-page "https://pypi.org/project/zope.security/")
(synopsis "Zope security framework") (synopsis "Zope security framework")
(description "Zope.security provides a generic mechanism to implement (description "Zope.security provides a generic mechanism to implement
security policies on Python objects.") security policies on Python objects.")

158
gnu/packages/python-xyz.scm
View File

@ -475,14 +475,14 @@ NetCDF files can also be read and modified. Python-HDF4 is a fork of
(define-public python-h5py (define-public python-h5py
(package (package
(name "python-h5py") (name "python-h5py")
(version "2.8.0") (version "2.10.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "h5py" version)) (uri (pypi-uri "h5py" version))
(sha256 (sha256
(base32 (base32
"0mdr6wrq02ac93m1aqx9kad0ppfzmm4imlxqgyy1x4l7hmdcc9p6")))) "0baipzv8n93m0dq0riyi8rfhzrjrfrfh8zqhszzp1j2xjac2fhc4"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:tests? #f ; no test target `(#:tests? #f ; no test target
@ -504,10 +504,11 @@ NetCDF files can also be read and modified. Python-HDF4 is a fork of
`(("python-six" ,python-six) `(("python-six" ,python-six)
("python-numpy" ,python-numpy))) ("python-numpy" ,python-numpy)))
(inputs (inputs
`(("hdf5" ,hdf5))) `(("hdf5" ,hdf5-1.10)))
(native-inputs (native-inputs
`(("python-cython" ,python-cython) `(("python-cython" ,python-cython)
("python-pkgconfig" ,python-pkgconfig))) ("python-pkgconfig" ,python-pkgconfig)
("pkg-config" ,pkg-config)))
(home-page "https://www.h5py.org/") (home-page "https://www.h5py.org/")
(synopsis "Read and write HDF5 files from Python") (synopsis "Read and write HDF5 files from Python")
(description (description
@ -748,7 +749,7 @@ other machines, such as over the network.")
;; One could bootstrap with an internal untested setuptools. ;; One could bootstrap with an internal untested setuptools.
(arguments (arguments
`(#:tests? #f)) `(#:tests? #f))
(home-page "https://pypi.python.org/pypi/setuptools") (home-page "https://pypi.org/project/setuptools/")
(synopsis (synopsis
"Library designed to facilitate packaging Python projects") "Library designed to facilitate packaging Python projects")
(description (description
@ -1111,7 +1112,7 @@ from the Python interpreter, or as a small part of a larger application.")
(native-inputs (native-inputs
`(("python-py" ,python-py) `(("python-py" ,python-py)
("python-pytest" ,python-pytest-bootstrap))) ("python-pytest" ,python-pytest-bootstrap)))
(home-page "https://pypi.python.org/pypi/six/") (home-page "https://pypi.org/project/six/")
(synopsis "Python 2 and 3 compatibility utilities") (synopsis "Python 2 and 3 compatibility utilities")
(description (description
"Six is a Python 2 and 3 compatibility library. It provides utility "Six is a Python 2 and 3 compatibility library. It provides utility
@ -1282,7 +1283,7 @@ Python 3.3+.")
(arguments `(#:python ,python-2 (arguments `(#:python ,python-2
#:tests? #f)) ; invalid command "test" #:tests? #f)) ; invalid command "test"
;; Currently no offical homepage. ;; Currently no offical homepage.
(home-page "https://pypi.python.org/pypi/dogtail/") (home-page "https://pypi.org/project/dogtail/")
(synopsis "GUI test tool and automation framework written in Python") (synopsis "GUI test tool and automation framework written in Python")
(description (description
"Dogtail is a GUI test tool and automation framework written in Python. "Dogtail is a GUI test tool and automation framework written in Python.
@ -1393,7 +1394,7 @@ bug tracker.")
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:python ,python-2)) `(#:python ,python-2))
(home-page "https://pypi.python.org/pypi/enum/") (home-page "https://pypi.org/project/enum/")
(synopsis "Robust enumerated type support in Python") (synopsis "Robust enumerated type support in Python")
(description (description
"This provides a module for robust enumerations in Python. It has "This provides a module for robust enumerations in Python. It has
@ -1414,7 +1415,7 @@ compatibility.")
(base32 (base32
"1cgm5ng2gcfrkrm3hc22brl6chdmv67b9zvva9sfs7gn7dwc9n4a")))) "1cgm5ng2gcfrkrm3hc22brl6chdmv67b9zvva9sfs7gn7dwc9n4a"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://pypi.python.org/pypi/enum34") (home-page "https://pypi.org/project/enum34/")
(synopsis "Backported Python 3.4 Enum") (synopsis "Backported Python 3.4 Enum")
(description (description
"Enum34 is the new Python stdlib enum module available in Python 3.4 "Enum34 is the new Python stdlib enum module available in Python 3.4
@ -1757,7 +1758,7 @@ code introspection, and logging.")
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:tests? #f)) `(#:tests? #f))
(home-page "http://docs.openstack.org/developer/pbr/") (home-page "https://docs.openstack.org/pbr/latest/")
(synopsis "Minimal build of python-pbr used for bootstrapping") (synopsis "Minimal build of python-pbr used for bootstrapping")
(description (description
"Used only for bootstrapping python2-pbr, you should not need this.") "Used only for bootstrapping python2-pbr, you should not need this.")
@ -2158,7 +2159,7 @@ cutting and pasting that code over and over.")
(base32 (base32
"1s6cp2lv4m0f00hjckjz8p6m7d3n3v16jvg353llf5ia1iqsnsib")))) "1s6cp2lv4m0f00hjckjz8p6m7d3n3v16jvg353llf5ia1iqsnsib"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://pypi.python.org/pypi/Unidecode") (home-page "https://pypi.org/project/Unidecode/")
(synopsis "ASCII transliterations of Unicode text") (synopsis "ASCII transliterations of Unicode text")
(description (description
"Unidecode provides ASCII transliterations of Unicode text. Unidecode is "Unidecode provides ASCII transliterations of Unicode text. Unidecode is
@ -2337,7 +2338,7 @@ environments and back.")
(build-system python-build-system) (build-system python-build-system)
(inputs (inputs
`(("libyaml" ,libyaml))) `(("libyaml" ,libyaml)))
(home-page "http://pyyaml.org/wiki/PyYAML") (home-page "https://pyyaml.org")
(synopsis "YAML parser and emitter for Python") (synopsis "YAML parser and emitter for Python")
(description (description
"PyYAML is a YAML parser and emitter for Python. PyYAML features a "PyYAML is a YAML parser and emitter for Python. PyYAML features a
@ -3829,7 +3830,7 @@ that client code uses to construct the grammar directly in Python code.")
`(("python-sphinx" ,python-sphinx))) `(("python-sphinx" ,python-sphinx)))
(native-inputs (native-inputs
`(("python-nose" ,python-nose))) `(("python-nose" ,python-nose)))
(home-page "https://pypi.python.org/pypi/numpydoc") (home-page "https://pypi.org/project/numpydoc/")
(synopsis (synopsis
"Numpy's Sphinx extensions") "Numpy's Sphinx extensions")
(description (description
@ -4779,7 +4780,7 @@ PNG, PostScript, PDF, and SVG file output.")
(sha256 (sha256
(base32 "0308djallnh00v112y5b7nadl657ysmkp6vc8xn51d6yzc9zm7n3")))) (base32 "0308djallnh00v112y5b7nadl657ysmkp6vc8xn51d6yzc9zm7n3"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://pypi.python.org/pypi/decorator/") (home-page "https://pypi.org/project/decorator/")
(synopsis "Python module to simplify usage of decorators") (synopsis "Python module to simplify usage of decorators")
(description (description
"The aim of the decorator module is to simplify the usage of decorators "The aim of the decorator module is to simplify the usage of decorators
@ -4808,7 +4809,7 @@ etc. The core of this module is a decorator factory.")
(arguments '(#:tests? #f)) (arguments '(#:tests? #f))
(native-inputs (native-inputs
`(("python-nose" ,python-nose))) `(("python-nose" ,python-nose)))
(home-page "https://pypi.python.org/pypi/drmaa") (home-page "https://pypi.org/project/drmaa/")
(synopsis "Python bindings for the DRMAA library") (synopsis "Python bindings for the DRMAA library")
(description (description
"A Python package for Distributed Resource Management (DRM) job "A Python package for Distributed Resource Management (DRM) job
@ -5023,7 +5024,7 @@ them as the version argument or in a SCM managed file.")
(propagated-inputs (propagated-inputs
`(("python-scandir" ,python-scandir) `(("python-scandir" ,python-scandir)
("python-six" ,python-six))) ("python-six" ,python-six)))
(home-page "https://pypi.python.org/pypi/pathlib2/") (home-page "https://pypi.org/project/pathlib2/")
(synopsis "Object-oriented file system paths") (synopsis "Object-oriented file system paths")
(description "The goal of pathlib2 is to provide a backport of the (description "The goal of pathlib2 is to provide a backport of the
standard @code{pathlib} module which tracks the standard library module, so standard @code{pathlib} module which tracks the standard library module, so
@ -6930,7 +6931,7 @@ from an XML-based format.")
(description "This package provides a Python library to parse, manipulate (description "This package provides a Python library to parse, manipulate
or create documents in LilyPond format. A command line program ly is also or create documents in LilyPond format. A command line program ly is also
provided that can be used to do various manipulations with LilyPond files.") provided that can be used to do various manipulations with LilyPond files.")
(home-page "https://pypi.python.org/pypi/python-ly") (home-page "https://pypi.org/project/python-ly/")
(license license:gpl2+))) (license license:gpl2+)))
(define-public python-appdirs (define-public python-appdirs
@ -7035,7 +7036,7 @@ should be stored on various operating systems.")
(description "MessagePack is a fast, compact binary serialization format, (description "MessagePack is a fast, compact binary serialization format,
suitable for similar data to JSON. This package provides CPython bindings for suitable for similar data to JSON. This package provides CPython bindings for
reading and writing MessagePack data.") reading and writing MessagePack data.")
(home-page "https://pypi.python.org/pypi/msgpack/") (home-page "https://pypi.org/project/msgpack/")
(license license:asl2.0))) (license license:asl2.0)))
;; This msgpack library's name changed from "python-msgpack" to "msgpack" with ;; This msgpack library's name changed from "python-msgpack" to "msgpack" with
@ -7528,7 +7529,7 @@ a hash value.")
(arguments (arguments
;; There are no tests. ;; There are no tests.
`(#:tests? #f)) `(#:tests? #f))
(home-page "https://pypi.python.org/pypi/termcolor") (home-page "https://pypi.org/project/termcolor/")
(synopsis "ANSII Color formatting for terminal output") (synopsis "ANSII Color formatting for terminal output")
(description (description
"This package provides ANSII Color formatting for output in terminals.") "This package provides ANSII Color formatting for output in terminals.")
@ -8782,7 +8783,7 @@ for the module to work under Python 3.3.")
(synopsis "Colored terminal text rendering for Python") (synopsis "Colored terminal text rendering for Python")
(description "Colorama is a Python library for rendering colored terminal (description "Colorama is a Python library for rendering colored terminal
text.") text.")
(home-page "https://pypi.python.org/pypi/colorama") (home-page "https://pypi.org/project/colorama/")
(license license:bsd-3))) (license license:bsd-3)))
(define-public python2-colorama (define-public python2-colorama
@ -8830,7 +8831,7 @@ library as well as on the command line.")
(synopsis "Plugin and hook calling mechanism for Python") (synopsis "Plugin and hook calling mechanism for Python")
(description "Pluggy is an extraction of the plugin manager as used by (description "Pluggy is an extraction of the plugin manager as used by
Pytest but stripped of Pytest specific details.") Pytest but stripped of Pytest specific details.")
(home-page "https://pypi.python.org/pypi/pluggy") (home-page "https://pypi.org/project/pluggy/")
(license license:expat))) (license license:expat)))
(define-public python2-pluggy (define-public python2-pluggy
@ -9535,7 +9536,7 @@ anymore.")
(propagated-inputs (propagated-inputs
`(("python2-scandir" ,python2-scandir) `(("python2-scandir" ,python2-scandir)
("python2-six" ,python2-six))) ("python2-six" ,python2-six)))
(home-page "https://pypi.python.org/pypi/pathlib2/") (home-page "https://pypi.org/project/pathlib2/")
(synopsis "Object-oriented file system paths - backport of standard (synopsis "Object-oriented file system paths - backport of standard
pathlib module") pathlib module")
(description "The goal of pathlib2 is to provide a backport of standard (description "The goal of pathlib2 is to provide a backport of standard
@ -12328,7 +12329,7 @@ projects.")
(define-public python-invoke (define-public python-invoke
(package (package
(name "python-invoke") (name "python-invoke")
(home-page "http://www.pyinvoke.org/") (home-page "https://www.pyinvoke.org/")
(version "1.3.0") (version "1.3.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
@ -13486,7 +13487,7 @@ which adds support for zone identifiers to IPv6 addresses.")
(base32 (base32
"192pclzs2y0yaywqkrlvd0x73740q310kvqvm6jldhi619mq59wi")))) "192pclzs2y0yaywqkrlvd0x73740q310kvqvm6jldhi619mq59wi"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://pypi.python.org/pypi/rfc3987") (home-page "https://pypi.org/project/rfc3987/")
(synopsis "Parsing and validation of URIs (RFC 3986) and IRIs (RFC 3987)") (synopsis "Parsing and validation of URIs (RFC 3986) and IRIs (RFC 3987)")
(description "@code{rfc3987} provides routines for parsing and (description "@code{rfc3987} provides routines for parsing and
validation of URIs (see RFC 3986) and IRIs (see RFC 3987).") validation of URIs (see RFC 3986) and IRIs (see RFC 3987).")
@ -15735,23 +15736,126 @@ infrastructure at import time, runtime, or statically (using the included pycc
tool).") tool).")
(license license:bsd-3))) (license license:bsd-3)))
(define-public python-numcodecs
(package
(name "python-numcodecs")
(version "0.6.4")
(source
(origin
(method url-fetch)
(uri (pypi-uri "numcodecs" version))
(sha256
(base32
"0kbfr8pl3x9glsypbq8hzim003f16ml1b1cvgrh4w1sdvgal6j7g"))))
(build-system python-build-system)
(propagated-inputs
`(("python-numpy" ,python-numpy)
("python-msgpack" ,python-msgpack)))
(native-inputs
`(("python-pytest" ,python-pytest)
("python-setuptools-scm" ,python-setuptools-scm)))
(home-page "https://github.com/zarr-developers/numcodecs")
(synopsis "Buffer compression and transformation codecs")
(description
"This Python package provides buffer compression and transformation
codecs for use in data storage and communication applications.")
(license license:expat)))
(define-public python-asciitree
(package
(name "python-asciitree")
(version "0.3.3")
(source
(origin
(method url-fetch)
(uri (pypi-uri "asciitree" version))
(sha256
(base32
"0vhgri2m2xlnibhz4xwn4hpbc7xacisxjqrk6k5kyppq96vbk92a"))))
(build-system python-build-system)
(home-page "https://github.com/mbr/asciitree")
(synopsis "Draws ASCII trees")
(description "This package draws tree structures using characters.")
(license license:expat)))
(define-public python-zarr
(package
(name "python-zarr")
(version "2.4.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "zarr" version))
(sha256
(base32
"026n3sjzjv2gmwx6y72b8ij0hk42bc8zdbvfj5gdqzd4i6wj3ajk"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'disable-service-tests
(lambda _
(setenv "ZARR_TEST_ABS" "0")
(setenv "ZARR_TEST_MONGO" "0")
(setenv "ZARR_TEST_REDIS" "0")
#t))
(replace 'check
(lambda _
(invoke "pytest" "-vv" "-k" "not lmdb")
#t)))))
(propagated-inputs
`(("python-asciitree" ,python-asciitree)
("python-fasteners" ,python-fasteners)
("python-numcodecs" ,python-numcodecs)
("python-numpy" ,python-numpy)))
(native-inputs
`(("python-pytest" ,python-pytest)
("python-setuptools-scm" ,python-setuptools-scm)))
(home-page "https://github.com/zarr-developers/zarr-python")
(synopsis "Chunked, compressed, N-dimensional arrays for Python")
(description
"This package provides an implementation of chunked, compressed,
N-dimensional arrays for Python.")
(license license:expat)))
(define-public python-anndata (define-public python-anndata
(package (package
(name "python-anndata") (name "python-anndata")
(version "0.6.18") (version "0.7.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "anndata" version)) (uri (pypi-uri "anndata" version))
(sha256 (sha256
(base32 (base32
"03x83yjaccbqszj7x4fwwmpil0ai59yx64d1zmf2691za3j03w73")))) "0rnfbpr55j1a1bi2kd4mz444741hrn74kz90h5rnjr59jmpfnh09"))))
(build-system python-build-system) (build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'delete-inconvenient-tests
(lambda _
;; This test depends on python-scikit-learn.
(delete-file "anndata/tests/test_inplace_subset.py")
#t))
(delete 'check)
(add-after 'install 'check
(lambda* (#:key inputs outputs #:allow-other-keys)
(add-installed-pythonpath inputs outputs)
(invoke "pytest" "-vv"))))))
(propagated-inputs (propagated-inputs
`(("python-h5py" ,python-h5py) `(("python-h5py" ,python-h5py)
("python-importlib-metadata" ,python-importlib-metadata)
("python-natsort" ,python-natsort) ("python-natsort" ,python-natsort)
("python-numcodecs" ,python-numcodecs)
("python-packaging" ,python-packaging)
("python-pandas" ,python-pandas) ("python-pandas" ,python-pandas)
("python-scipy" ,python-scipy))) ("python-scipy" ,python-scipy)
("python-zarr" ,python-zarr)))
(native-inputs
`(("python-joblib" ,python-joblib)
("python-pytest" ,python-pytest)
("python-setuptools-scm" ,python-setuptools-scm)))
(home-page "https://github.com/theislab/anndata") (home-page "https://github.com/theislab/anndata")
(synopsis "Annotated data for data analysis pipelines") (synopsis "Annotated data for data analysis pipelines")
(description "Anndata is a package for simple (functional) high-level APIs (description "Anndata is a package for simple (functional) high-level APIs

4
gnu/packages/regex.scm
View File

@ -30,7 +30,7 @@
(define-public re2 (define-public re2
(package (package
(name "re2") (name "re2")
(version "2020-01-01") (version "2020-03-03")
(home-page "https://github.com/google/re2") (home-page "https://github.com/google/re2")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
@ -38,7 +38,7 @@
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0gcli7y2ax3karx7m1q1r9qm49danaxbgxslywjwmya5nmr7x3p4")))) "0f1fncvg41dg9k06jiqbd7k51ljihk7rjb0kvxkbrlvgbzlpb860"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:modules ((guix build gnu-build-system) `(#:modules ((guix build gnu-build-system)

6
gnu/packages/scsi.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -27,14 +27,14 @@
(define-public sg3-utils (define-public sg3-utils
(package (package
(name "sg3-utils") (name "sg3-utils")
(version "1.44") (version "1.45")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://sg.danny.cz/sg/p/sg3_utils-" (uri (string-append "http://sg.danny.cz/sg/p/sg3_utils-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"01avlgrbxlij8spish4i69ji1m49biz4mbayzzc2qx0hcl8ar56a")))) "1vmjb17y33a73sv7jg8fzs6bhr7yh2k9sba81sjiyf1pvi3vbnn7"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(home-page "http://sg.danny.cz/sg/sg3_utils.html") (home-page "http://sg.danny.cz/sg/sg3_utils.html")
(synopsis "SCSI device utilities") (synopsis "SCSI device utilities")

12
gnu/packages/statistics.scm
View File

@ -504,14 +504,14 @@ code for possible problems.")
(define-public r-foreign (define-public r-foreign
(package (package
(name "r-foreign") (name "r-foreign")
(version "0.8-75") (version "0.8-76")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "foreign" version)) (uri (cran-uri "foreign" version))
(sha256 (sha256
(base32 (base32
"0g4mi101srjbl17ydb2hl3854m3xj0llj6861lfr30sp08nkqavl")))) "1z6x2x1z12wnv0z4p74d91r5wfaq30sdz4ynwx0lncz1q45mhbh5"))))
(build-system r-build-system) (build-system r-build-system)
(home-page "https://cran.r-project.org/web/packages/foreign") (home-page "https://cran.r-project.org/web/packages/foreign")
(synopsis "Read data stored by other statistics software") (synopsis "Read data stored by other statistics software")
@ -590,13 +590,13 @@ and operations on them using LAPACK and SuiteSparse.")
(define-public r-nlme (define-public r-nlme
(package (package
(name "r-nlme") (name "r-nlme")
(version "3.1-144") (version "3.1-145")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "nlme" version)) (uri (cran-uri "nlme" version))
(sha256 (sha256
(base32 "1gqyq53fdq23wsi3f4n9vg4mn5i0v18zam5lnzlpg581xifx2779")))) (base32 "1i9a3afdmn2ziks0imz0j09ay9n0zb9mhrymy9mg97vvlz5diwrh"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-lattice" ,r-lattice))) `(("r-lattice" ,r-lattice)))
@ -933,13 +933,13 @@ in which the whole-plots or split-plots or both can be freely exchangeable.")
(define-public r-plyr (define-public r-plyr
(package (package
(name "r-plyr") (name "r-plyr")
(version "1.8.5") (version "1.8.6")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (cran-uri "plyr" version)) (uri (cran-uri "plyr" version))
(sha256 (sha256
(base32 "0x4mbb3rgv1ayxqidw0p9i10khbg51fz5r62vw4il8d7licqq07a")))) (base32 "11sjjdn146w95s1vsfmmgdls082cbnm1slv98xvyjhsl2mpx4mga"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs `(("r-rcpp" ,r-rcpp))) (propagated-inputs `(("r-rcpp" ,r-rcpp)))
(home-page "http://had.co.nz/plyr") (home-page "http://had.co.nz/plyr")

8
gnu/packages/storage.scm
View File

@ -53,18 +53,16 @@
(define-public ceph (define-public ceph
(package (package
(name "ceph") (name "ceph")
(version "14.2.7") (version "14.2.8")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://download.ceph.com/tarballs/ceph-" (uri (string-append "https://download.ceph.com/tarballs/ceph-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0qiqhm6hvz299q54k3i4crnb5dhpq6xnn2yqih9pxn9van0dq1ln")) "0p7pjycqhxqg1mmix8ykx3xqq01d560p54iiidxps0rcvwfkyyki"))
(patches (patches
(search-patches "ceph-boost-compat.patch" (search-patches "ceph-disable-cpu-optimizations.patch"))
"ceph-volume-respect-PATH.patch"
"ceph-disable-cpu-optimizations.patch"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin

44
gnu/packages/version-control.scm
View File

@ -15,7 +15,7 @@
;;; Copyright © 2017 Vasile Dumitrascu <va511e@yahoo.com> ;;; Copyright © 2017 Vasile Dumitrascu <va511e@yahoo.com>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017 André <eu@euandre.org> ;;; Copyright © 2017 André <eu@euandre.org>
;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2017, 2018, 2020 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Stefan Reichör <stefan@xsteve.at> ;;; Copyright © 2017 Stefan Reichör <stefan@xsteve.at>
;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org> ;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org>
@ -534,7 +534,7 @@ everything from small to very large projects with speed and efficiency.")
(define-public libgit2 (define-public libgit2
(package (package
(name "libgit2") (name "libgit2")
(version "0.28.4") (version "0.99.0")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -543,21 +543,37 @@ everything from small to very large projects with speed and efficiency.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"171b25aym4q88bidc4c76y4l6jmdwifm3q9zjqsll0wjhlkycfy1")) "0qxzv49ip378g1n7hrbifb9c6pys2kj1hnxcafmbb94gj3pgd9kg"))
(patches (search-patches "libgit2-avoid-python.patch" (patches (search-patches "libgit2-mtime-0.patch"))
"libgit2-mtime-0.patch"))
;; Remove bundled software. ;; Remove bundled software. Keep "http-parser" because it
;; contains patches that are not available in the system version.
(snippet '(begin (snippet '(begin
(delete-file-recursively "deps") (with-directory-excursion "deps"
(for-each (lambda (dir)
(delete-file-recursively dir))
(lset-difference equal?
(scandir ".")
'("." ".." "http-parser"))))
#t)) #t))
(modules '((guix build utils))))) (modules '((guix build utils)
(srfi srfi-1)
(ice-9 ftw)))))
(build-system cmake-build-system) (build-system cmake-build-system)
(outputs '("out" "debug")) (outputs '("out" "debug"))
(arguments (arguments
`(#:configure-flags '("-DUSE_SHA1DC=ON") ; SHA-1 collision detection `(#:configure-flags '("-DUSE_NTLMCLIENT=OFF" ;TODO: package this
"-DREGEX_BACKEND=pcre2")
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'unpack 'fix-pcre2-reference
(lambda _
;; Use PCRE2 with 8-bit character support, as there is no "libpcre2.pc".
;; See <https://github.com/libgit2/libgit2/issues/5438>.
(substitute* "src/CMakeLists.txt"
(("\"libpcre2\"")
"\"libpcre2-8\""))
#t))
(add-after 'unpack 'fix-hardcoded-paths (add-after 'unpack 'fix-hardcoded-paths
(lambda _ (lambda _
(substitute* "tests/repo/init.c" (substitute* "tests/repo/init.c"
@ -574,14 +590,14 @@ everything from small to very large projects with speed and efficiency.")
(replace 'check (replace 'check
(lambda _ (invoke "./libgit2_clar" "-v" "-Q")))))) (lambda _ (invoke "./libgit2_clar" "-v" "-Q"))))))
(inputs (inputs
`(("libssh2" ,libssh2) `(("libssh2" ,libssh2)))
("http-parser" ,http-parser)))
(native-inputs (native-inputs
`(("guile" ,guile-2.2) `(("pkg-config" ,pkg-config)
("pkg-config" ,pkg-config))) ("python" ,python)))
(propagated-inputs (propagated-inputs
;; These two libraries are in 'Requires.private' in libgit2.pc. ;; These libraries are in 'Requires.private' in libgit2.pc.
`(("openssl" ,openssl) `(("openssl" ,openssl)
("pcre2" ,pcre2)
("zlib" ,zlib))) ("zlib" ,zlib)))
(home-page "https://libgit2.github.com/") (home-page "https://libgit2.github.com/")
(synopsis "Library providing Git core methods") (synopsis "Library providing Git core methods")

4
gnu/packages/webkit.scm
View File

@ -93,14 +93,14 @@ backend which implements them.")
(define-public wpebackend-fdo (define-public wpebackend-fdo
(package (package
(name "wpebackend-fdo") (name "wpebackend-fdo")
(version "1.4.1") (version "1.4.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://wpewebkit.org/releases/" (uri (string-append "https://wpewebkit.org/releases/"
"wpebackend-fdo-" version ".tar.xz")) "wpebackend-fdo-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1799vf6wc78z15l39sfh39l5rrvlqpi29ynjm0324rpsrfvs0jb2")))) "07wd736d4nhd2vpxnjzv9pb8firvbn11jmdbnhpkhjxbxa1k86pw"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
`(#:tests? #f)) ;no tests `(#:tests? #f)) ;no tests

4
gnu/packages/wm.scm
View File

@ -267,14 +267,14 @@ commands would.")
(define-public i3-wm (define-public i3-wm
(package (package
(name "i3-wm") (name "i3-wm")
(version "4.17.1") (version "4.18")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://i3wm.org/downloads/i3-" (uri (string-append "https://i3wm.org/downloads/i3-"
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"0iazv2i2rgmakzh95pgj6iapyzn7bdpcbcd35a79mhlml4ry33qy")))) "0dv5g8ycfmijxfjyw8hzsxaf80v09lb73zh7x2vszy78h3amifqz"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:configure-flags `(#:configure-flags

8
gnu/tests.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
@ -254,6 +254,12 @@ the system under test."
(set-record-type-printer! <system-test> write-system-test) (set-record-type-printer! <system-test> write-system-test)
(define-gexp-compiler (compile-system-test (test <system-test>)
system target)
"Compile TEST to a derivation."
;; XXX: SYSTEM and TARGET are ignored.
(system-test-value test))
(define (test-modules) (define (test-modules)
"Return the list of modules that define system tests." "Return the list of modules that define system tests."
(scheme-modules (dirname (search-path %load-path "guix.scm")) (scheme-modules (dirname (search-path %load-path "guix.scm"))

23
gnu/tests/base.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -55,7 +55,7 @@
(define* (run-basic-test os command #:optional (name "basic") (define* (run-basic-test os command #:optional (name "basic")
#:key initialization) #:key initialization root-password)
"Return a derivation called NAME that tests basic features of the OS started "Return a derivation called NAME that tests basic features of the OS started
using COMMAND, a gexp that evaluates to a list of strings. Compare some using COMMAND, a gexp that evaluates to a list of strings. Compare some
properties of running system to what's declared in OS, an <operating-system>. properties of running system to what's declared in OS, an <operating-system>.
@ -63,7 +63,10 @@ properties of running system to what's declared in OS, an <operating-system>.
When INITIALIZATION is true, it must be a one-argument procedure that is When INITIALIZATION is true, it must be a one-argument procedure that is
passed a gexp denoting the marionette, and it must return gexp that is passed a gexp denoting the marionette, and it must return gexp that is
inserted before the first test. This is used to introduce an extra inserted before the first test. This is used to introduce an extra
initialization step, such as entering a LUKS passphrase." initialization step, such as entering a LUKS passphrase.
When ROOT-PASSWORD is true, enter it as the root password when logging in.
Otherwise assume that there is no password for root."
(define special-files (define special-files
(service-value (service-value
(fold-services (operating-system-services os) (fold-services (operating-system-services os)
@ -300,7 +303,19 @@ info --version")
marionette) marionette)
;; Now we can type. ;; Now we can type.
(marionette-type "root\n\nid -un > logged-in\n" marionette) (let ((password #$root-password))
(if password
(begin
(marionette-type "root\n" marionette)
(wait-for-screen-text marionette
(lambda (text)
(string-contains text "Password"))
#:ocrad
#$(file-append ocrad "/bin/ocrad"))
(marionette-type (string-append password "\n\n")
marionette))
(marionette-type "root\n\n" marionette)))
(marionette-type "id -un > logged-in\n" marionette)
;; It can take a while before the shell commands are executed. ;; It can take a while before the shell commands are executed.
(marionette-eval '(use-modules (rnrs io ports)) marionette) (marionette-eval '(use-modules (rnrs io ports)) marionette)

202
gnu/tests/install.scm
View File

@ -26,10 +26,14 @@
#:use-module (gnu system install) #:use-module (gnu system install)
#:use-module (gnu system vm) #:use-module (gnu system vm)
#:use-module ((gnu build vm) #:select (qemu-command)) #:use-module ((gnu build vm) #:select (qemu-command))
#:use-module (gnu packages admin)
#:use-module (gnu packages bootloaders) #:use-module (gnu packages bootloaders)
#:use-module (gnu packages cryptsetup)
#:use-module (gnu packages linux)
#:use-module (gnu packages ocr) #:use-module (gnu packages ocr)
#:use-module (gnu packages package-management) #:use-module (gnu packages package-management)
#:use-module (gnu packages virtualization) #:use-module (gnu packages virtualization)
#:use-module (gnu services networking)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix packages) #:use-module (guix packages)
@ -44,7 +48,10 @@
%test-raid-root-os %test-raid-root-os
%test-encrypted-root-os %test-encrypted-root-os
%test-btrfs-root-os %test-btrfs-root-os
%test-jfs-root-os)) %test-jfs-root-os
%test-gui-installed-os
%test-gui-installed-os-encrypted))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -179,6 +186,7 @@ reboot\n")
(define* (run-install target-os target-os-source (define* (run-install target-os target-os-source
#:key #:key
(script %simple-installation-script) (script %simple-installation-script)
(gui-test #f)
(packages '()) (packages '())
(os (marionette-operating-system (os (marionette-operating-system
(operating-system (operating-system
@ -191,6 +199,7 @@ reboot\n")
packages)) packages))
(kernel-arguments '("console=ttyS0"))) (kernel-arguments '("console=ttyS0")))
#:imported-modules '((gnu services herd) #:imported-modules '((gnu services herd)
(gnu installer tests)
(guix combinators)))) (guix combinators))))
(installation-disk-image-file-system-type "ext4") (installation-disk-image-file-system-type "ext4")
(target-size (* 2200 MiB))) (target-size (* 2200 MiB)))
@ -256,13 +265,21 @@ packages defined in installation-os."
(start 'term-tty1)) (start 'term-tty1))
marionette) marionette)
(marionette-eval '(call-with-output-file "/etc/target-config.scm" (when #$(->bool script)
(lambda (port) (marionette-eval '(call-with-output-file "/etc/target-config.scm"
(write '#$target-os-source port))) (lambda (port)
marionette) (write '#$target-os-source port)))
marionette)
(exit (marionette-eval '(zero? (system #$script))
marionette)))
(exit (marionette-eval '(zero? (system #$script)) (when #$(->bool gui-test)
marionette))))) (wait-for-unix-socket "/var/guix/installer-socket"
marionette)
(format #t "installer socket ready~%")
(force-output)
(exit #$(and gui-test
(gui-test #~marionette)))))))
(gexp->derivation "installation" install))) (gexp->derivation "installation" install)))
@ -890,4 +907,175 @@ build (current-guix) and then store a couple of full system images.")
(command (qemu-command/writable-image image))) (command (qemu-command/writable-image image)))
(run-basic-test %jfs-root-os command "jfs-root-os"))))) (run-basic-test %jfs-root-os command "jfs-root-os")))))
;;;
;;; Installation through the graphical interface.
;;;
(define %syslog-conf
;; Syslog configuration that dumps to /dev/console, so we can see the
;; installer's messages during the test.
(computed-file "syslog.conf"
#~(begin
(copy-file #$%default-syslog.conf #$output)
(chmod #$output #o644)
(let ((port (open-file #$output "a")))
(display "\n*.info /dev/console\n" port)
#t))))
(define (operating-system-with-console-syslog os)
"Return OS with a syslog service that writes to /dev/console."
(operating-system
(inherit os)
(services (modify-services (operating-system-user-services os)
(syslog-service-type config
=>
(syslog-configuration
(inherit config)
(config-file %syslog-conf)))))))
(define %root-password "foo")
(define* (gui-test-program marionette #:key (encrypted? #f))
#~(let ()
(define (screenshot file)
(marionette-control (string-append "screendump " file)
#$marionette))
(setvbuf (current-output-port) 'none)
(setvbuf (current-error-port) 'none)
(marionette-eval '(use-modules (gnu installer tests))
#$marionette)
;; Arrange so that 'converse' prints debugging output to the console.
(marionette-eval '(let ((console (open-output-file "/dev/console")))
(setvbuf console 'none)
(conversation-log-port console))
#$marionette)
;; Tell the installer to not wait for the Connman "online" status.
(marionette-eval '(call-with-output-file "/tmp/installer-assume-online"
(const #t))
#$marionette)
;; Run 'guix system init' with '--no-grafts', to cope with the lack of
;; network access.
(marionette-eval '(call-with-output-file
"/tmp/installer-system-init-options"
(lambda (port)
(write '("--no-grafts" "--no-substitutes")
port)))
#$marionette)
(marionette-eval '(define installer-socket
(open-installer-socket))
#$marionette)
(screenshot "installer-start.ppm")
(marionette-eval '(choose-locale+keyboard installer-socket)
#$marionette)
(screenshot "installer-locale.ppm")
;; Choose the host name that the "basic" test expects.
(marionette-eval '(enter-host-name+passwords installer-socket
#:host-name "liberigilo"
#:root-password
#$%root-password
#:users
'(("alice" "pass1")
("bob" "pass2")))
#$marionette)
(screenshot "installer-services.ppm")
(marionette-eval '(choose-services installer-socket
#:desktop-environments '()
#:choose-network-service?
(const #f))
#$marionette)
(screenshot "installer-partitioning.ppm")
(marionette-eval '(choose-partitioning installer-socket
#:encrypted? #$encrypted?
#:passphrase #$%luks-passphrase)
#$marionette)
(screenshot "installer-run.ppm")
(marionette-eval '(conclude-installation installer-socket)
#$marionette)
(sync)
#t))
(define %extra-packages
;; Packages needed when installing with an encrypted root.
(list isc-dhcp
lvm2-static cryptsetup-static e2fsck/static
loadkeys-static))
(define installation-os-for-gui-tests
;; Operating system that contains all of %EXTRA-PACKAGES, needed for the
;; target OS, as well as syslog output redirected to the console so we can
;; see what the installer is up to.
(marionette-operating-system
(operating-system
(inherit (operating-system-with-console-syslog
(operating-system-add-packages
(operating-system-with-current-guix
installation-os)
%extra-packages)))
(kernel-arguments '("console=ttyS0")))
#:imported-modules '((gnu services herd)
(gnu installer tests)
(guix combinators))))
(define* (guided-installation-test name #:key encrypted?)
(define os
(operating-system
(inherit %minimal-os)
(users (append (list (user-account
(name "alice")
(comment "Bob's sister")
(group "users")
(supplementary-groups
'("wheel" "audio" "video")))
(user-account
(name "bob")
(comment "Alice's brother")
(group "users")
(supplementary-groups
'("wheel" "audio" "video"))))
%base-user-accounts))
;; The installer does not create a swap device in guided mode with
;; encryption support.
(swap-devices (if encrypted? '() '("/dev/vdb2")))
(services (cons (service dhcp-client-service-type)
(operating-system-user-services %minimal-os)))))
(system-test
(name name)
(description
"Install an OS using the graphical installer and test it.")
(value
(mlet* %store-monad ((image (run-install os '(this is unused)
#:script #f
#:os installation-os-for-gui-tests
#:gui-test
(lambda (marionette)
(gui-test-program
marionette
#:encrypted? encrypted?))))
(command (qemu-command/writable-image image)))
(run-basic-test os command name
#:initialization (and encrypted? enter-luks-passphrase)
#:root-password %root-password)))))
(define %test-gui-installed-os
(guided-installation-test "gui-installed-os"
#:encrypted? #f))
(define %test-gui-installed-os-encrypted
(guided-installation-test "gui-installed-os-encrypted"
#:encrypted? #t))
;;; install.scm ends here ;;; install.scm ends here

7
guix/import/pypi.scm
View File

@ -6,6 +6,7 @@
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -439,10 +440,12 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
(match str (match str
("GNU LGPL" license:lgpl2.0) ("GNU LGPL" license:lgpl2.0)
("GPL" license:gpl3) ("GPL" license:gpl3)
((or "BSD" "BSD License") license:bsd-3) ((or "BSD" "BSD-3" "BSD License") license:bsd-3)
((or "MIT" "MIT license" "Expat license") license:expat) ("BSD-2-Clause" license:bsd-2)
((or "MIT" "MIT license" "MIT License" "Expat license") license:expat)
("Public domain" license:public-domain) ("Public domain" license:public-domain)
((or "Apache License, Version 2.0" "Apache 2.0") license:asl2.0) ((or "Apache License, Version 2.0" "Apache 2.0") license:asl2.0)
("MPL 2.0" license:mpl2.0)
(_ #f))) (_ #f)))
(define (pypi-package? package) (define (pypi-package? package)

24
guix/scripts/build.scm
View File

@ -812,14 +812,6 @@ build---packages, gexps, derivations, and so on."
(for-each validate-type lst) (for-each validate-type lst)
lst)) lst))
;; Note: Taken from (guix scripts refresh).
(define (manifest->packages manifest)
"Return the list of packages in MANIFEST."
(filter-map (lambda (entry)
(let ((item (manifest-entry-item entry)))
(if (package? item) item #f)))
(manifest-entries manifest)))
(append-map (match-lambda (append-map (match-lambda
(('argument . (? string? spec)) (('argument . (? string? spec))
(cond ((derivation-path? spec) (cond ((derivation-path? spec)
@ -844,8 +836,10 @@ build---packages, gexps, derivations, and so on."
(('file . file) (('file . file)
(ensure-list (load* file (make-user-module '())))) (ensure-list (load* file (make-user-module '()))))
(('manifest . manifest) (('manifest . manifest)
(manifest->packages (map manifest-entry-item
(load* manifest (make-user-module '((guix profiles) (gnu)))))) (manifest-entries
(load* manifest
(make-user-module '((guix profiles) (gnu)))))))
(('expression . str) (('expression . str)
(ensure-list (read/eval str))) (ensure-list (read/eval str)))
(('argument . (? derivation? drv)) (('argument . (? derivation? drv))
@ -949,13 +943,21 @@ needed."
(parse-command-line args %options (parse-command-line args %options
(list %default-options))) (list %default-options)))
(define graft?
(assoc-ref opts 'graft?))
(with-error-handling (with-error-handling
(with-status-verbosity (assoc-ref opts 'verbosity) (with-status-verbosity (assoc-ref opts 'verbosity)
(with-store store (with-store store
;; Set the build options before we do anything else. ;; Set the build options before we do anything else.
(set-build-options-from-command-line store opts) (set-build-options-from-command-line store opts)
(parameterize ((current-terminal-columns (terminal-columns))) (parameterize ((current-terminal-columns (terminal-columns))
;; Set grafting upfront in case the user's input
;; depends on it (e.g., a manifest or code snippet that
;; calls 'gexp->derivation').
(%graft? graft?))
(let* ((mode (assoc-ref opts 'build-mode)) (let* ((mode (assoc-ref opts 'build-mode))
(drv (options->derivations store opts)) (drv (options->derivations store opts))
(urls (map (cut string-append <> "/log") (urls (map (cut string-append <> "/log")

41
guix/scripts/weather.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
;;; ;;;
@ -28,6 +28,7 @@
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module (guix gexp)
#:use-module ((guix build syscalls) #:select (terminal-columns)) #:use-module ((guix build syscalls) #:select (terminal-columns))
#:use-module (guix scripts substitute) #:use-module (guix scripts substitute)
#:use-module (guix http-client) #:use-module (guix http-client)
@ -75,7 +76,16 @@ scope."
(define* (package-outputs packages (define* (package-outputs packages
#:optional (system (%current-system))) #:optional (system (%current-system)))
"Return the list of outputs of all of PACKAGES for the given SYSTEM." "Return the list of outputs of all of PACKAGES for the given SYSTEM."
(let ((packages (filter (cut supported-package? <> system) packages))) (define (lower-object/no-grafts obj system)
(mlet* %store-monad ((previous (set-grafting #f))
(drv (lower-object obj system))
(_ (set-grafting previous)))
(return drv)))
(let ((packages (filter (lambda (package)
(or (not (package? package))
(supported-package? package system)))
packages)))
(format (current-error-port) (format (current-error-port)
(G_ "computing ~h package derivations for ~a...~%") (G_ "computing ~h package derivations for ~a...~%")
(length packages) system) (length packages) system)
@ -84,8 +94,11 @@ scope."
(lambda (report) (lambda (report)
(foldm %store-monad (foldm %store-monad
(lambda (package result) (lambda (package result)
(mlet %store-monad ((drv (package->derivation package system ;; PACKAGE could in fact be a non-package object, for example
#:graft? #f))) ;; coming from a user-specified manifest. Thus, use
;; 'lower-object' rather than 'package->derivation' here.
(mlet %store-monad ((drv (lower-object/no-grafts package
system)))
(report) (report)
(match (derivation->output-paths drv) (match (derivation->output-paths drv)
(((names . items) ...) (((names . items) ...)
@ -487,7 +500,12 @@ SERVER. Display information for packages with at least THRESHOLD dependents."
(if file (load-manifest file) '()))))) (if file (load-manifest file) '())))))
(with-error-handling (with-error-handling
(parameterize ((current-terminal-columns (terminal-columns))) (parameterize ((current-terminal-columns (terminal-columns))
;; Set grafting upfront in case the user's input depends on
;; it (e.g., a manifest or code snippet that calls
;; 'gexp->derivation').
(%graft? #f))
(let* ((opts (parse-command-line args %options (let* ((opts (parse-command-line args %options
(list %default-options) (list %default-options)
#:build-options? #f)) #:build-options? #f))
@ -500,13 +518,12 @@ SERVER. Display information for packages with at least THRESHOLD dependents."
(systems systems))) (systems systems)))
(packages (package-list opts)) (packages (package-list opts))
(items (with-store store (items (with-store store
(parameterize ((%graft? #f)) (concatenate
(concatenate (run-with-store store
(run-with-store store (mapm %store-monad
(mapm %store-monad (lambda (system)
(lambda (system) (package-outputs packages system))
(package-outputs packages system)) systems))))))
systems)))))))
(for-each (lambda (server) (for-each (lambda (server)
(report-server-coverage server items) (report-server-coverage server items)
(match (assoc-ref opts 'coverage) (match (assoc-ref opts 'coverage)

13
tests/guix-build.sh
View File

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU # GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> # Copyright © 2012, 2013, 2014, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2020 Marius Bakke <mbakke@fastmail.com> # Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
# #
# This file is part of GNU Guix. # This file is part of GNU Guix.
@ -317,6 +317,17 @@ EOF
test `guix build -d --manifest="$module_dir/manifest.scm" \ test `guix build -d --manifest="$module_dir/manifest.scm" \
| grep -e '-hello-' -e '-guix-' \ | grep -e '-hello-' -e '-guix-' \
| wc -l` -eq 2 | wc -l` -eq 2
# Building from a manifest that contains a non-package object.
cat > "$module_dir/manifest.scm"<<EOF
(manifest
(list (manifest-entry (name "foo") (version "0")
(item (computed-file "computed-thingie"
#~(mkdir (ungexp output)))))))
EOF
guix build -d -m "$module_dir/manifest.scm" \
| grep 'computed-thingie\.drv$'
rm "$module_dir"/*.scm rm "$module_dir"/*.scm
# Using 'GUIX_BUILD_OPTIONS'. # Using 'GUIX_BUILD_OPTIONS'.