rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into core-updates 

Conflicts:
	gnu/packages/icu4c.scm
	gnu/packages/man.scm
	gnu/packages/python-xyz.scm
	guix/scripts/environment.scm
	guix/scripts/pack.scm
	guix/scripts/package.scm
	guix/scripts/pull.scm
	guix/store.scm
This commit is contained in:
Marius Bakke 2020-03-27 00:12:15 +01:00
parent 0ab8ad4632 3089b70d76
commit 18af687037
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
113 changed files with 81111 additions and 40823 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.dir-locals.el
View File

@ -68,6 +68,7 @@
(eval . (put 'with-derivation-substitute 'scheme-indent-function 2))
(eval . (put 'with-status-report 'scheme-indent-function 1))
(eval . (put 'with-status-verbosity 'scheme-indent-function 1))
(eval . (put 'with-build-handler 'scheme-indent-function 1))
(eval . (put 'mlambda 'scheme-indent-function 1))
(eval . (put 'mlambdaq 'scheme-indent-function 1))

1
Makefile.am
View File

@ -323,7 +323,6 @@ AUX_FILES = \
gnu/packages/aux-files/chromium/master-preferences.json \
gnu/packages/aux-files/emacs/guix-emacs.el \
gnu/packages/aux-files/linux-libre/5.4-arm.conf \
gnu/packages/aux-files/linux-libre/5.4-arm-veyron.conf \
gnu/packages/aux-files/linux-libre/5.4-arm64.conf \
gnu/packages/aux-files/linux-libre/5.4-i686.conf \
gnu/packages/aux-files/linux-libre/5.4-x86_64.conf \

85
build-aux/hydra/evaluate.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
@ -24,6 +24,7 @@
(use-modules (guix store)
(guix git-download)
((guix build utils) #:select (with-directory-excursion))
((guix ui) #:select (build-notifier))
(srfi srfi-19)
(ice-9 match)
(ice-9 pretty-print)
@ -41,13 +42,6 @@
(beautify-user-module! m)
m))
(cond-expand
(guile-2.2
;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it.
(define time-monotonic time-tai))
(else #t))
(define (call-with-time thunk kont)
"Call THUNK and pass KONT the elapsed time followed by THUNK's return
values."
@ -89,49 +83,42 @@ Otherwise return THING."
#:use-substitutes? #f
#:substitute-urls '())
;; Grafts can trigger early builds. We do not want that to happen
;; during evaluation, so use a sledgehammer to catch such problems.
;; An exception, though, is the evaluation of Guix itself, which
;; requires building a "trampoline" program.
(set! build-things
(lambda (store . args)
(format (current-error-port)
"warning: building things during evaluation~%")
(format (current-error-port)
"'build-things' arguments: ~s~%" args)
(apply real-build-things store args)))
;; The evaluation of Guix itself requires building a "trampoline"
;; program, and possibly everything it depends on. Thus, allow builds
;; but print a notification.
(with-build-handler (build-notifier #:use-substitutes? #f)
;; Add %TOP-SRCDIR to the store with a proper Git predicate so we work
;; from a clean checkout
(let ((source (add-to-store store "guix-source" #t
"sha256" %top-srcdir
#:select? (git-predicate %top-srcdir))))
(with-directory-excursion source
(save-module-excursion
(lambda ()
(set-current-module %user-module)
(format (current-error-port)
"loading '~a' relative to '~a'...~%"
file source)
(primitive-load file))))
;; Add %TOP-SRCDIR to the store with a proper Git predicate so we work
;; from a clean checkout
(let ((source (add-to-store store "guix-source" #t
"sha256" %top-srcdir
#:select? (git-predicate %top-srcdir))))
(with-directory-excursion source
(save-module-excursion
(lambda ()
(set-current-module %user-module)
(format (current-error-port)
"loading '~a' relative to '~a'...~%"
file source)
(primitive-load file))))
;; Call the entry point of FILE and print the resulting job sexp.
(pretty-print
(match ((module-ref %user-module
(if (equal? cuirass? "cuirass")
'cuirass-jobs
'hydra-jobs))
store `((guix
. ((file-name . ,source)))))
(((names . thunks) ...)
(map (lambda (job thunk)
(format (current-error-port) "evaluating '~a'... " job)
(force-output (current-error-port))
(cons job
(assert-valid-job job
(call-with-time-display thunk))))
names thunks)))
port)))))
;; Call the entry point of FILE and print the resulting job sexp.
(pretty-print
(match ((module-ref %user-module
(if (equal? cuirass? "cuirass")
'cuirass-jobs
'hydra-jobs))
store `((guix
. ((file-name . ,source)))))
(((names . thunks) ...)
(map (lambda (job thunk)
(format (current-error-port) "evaluating '~a'... " job)
(force-output (current-error-port))
(cons job
(assert-valid-job job
(call-with-time-display thunk))))
names thunks)))
port))))))
((command _ ...)
(format (current-error-port) "Usage: ~a FILE [cuirass]
Evaluate the Hydra or Cuirass jobs defined in FILE.~%"

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

@ -65,6 +65,8 @@ Return #f if no such checkout is found."
(run-with-store store
(channel-instances->derivation (list instance))))
;; TODO: Remove 'show-what-to-build' call when Cuirass' 'evaluate' scripts
;; uses 'with-build-handler'.
(show-what-to-build store (list derivation))
(build-derivations store (list derivation))

30
doc/guix.texi
View File

@ -75,6 +75,7 @@ Copyright @copyright{} 2020 Wiktor Żelazny@*
Copyright @copyright{} 2020 Damien Cassou@*
Copyright @copyright{} 2020 Jakub Kądziołka@*
Copyright @copyright{} 2020 Jack Hill@*
Copyright @copyright{} 2020 Naga Malleswari@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -4207,7 +4208,7 @@ guix time-machine @var{options}@dots{} -- @var{command} @var {arg}@dots{}
@end example
where @var{command} and @var{arg}@dots{} are passed unmodified to the
@command{guix} command if the specified revision. The @var{options} that define
@command{guix} command of the specified revision. The @var{options} that define
this revision are the same as for @command{guix pull} (@pxref{Invoking guix pull}):
@table @code
@ -4746,7 +4747,7 @@ the following command creates a Guix development environment that
additionally includes Git and strace:
@example
guix environment guix --ad-hoc git strace
guix environment --pure guix --ad-hoc git strace
@end example
Sometimes it is desirable to isolate the environment as much as
@ -11221,6 +11222,10 @@ The package object of the operating system kernel to use@footnote{Currently
only the Linux-libre kernel is supported. In the future, it will be
possible to use the GNU@tie{}Hurd.}.
@item @code{kernel-loadable-modules} (default: '())
A list of objects (usually packages) to collect loadable kernel modules
from--e.g. @code{(list ddcci-driver-linux)}.
@item @code{kernel-arguments} (default: @code{'("quiet")})
List of strings or gexps representing additional arguments to pass on
the command-line of the kernel---e.g., @code{("console=ttyS0")}.
@ -12282,6 +12287,23 @@ symlink:
Return a service that sets the host name to @var{name}.
@end deffn
@defvr {Scheme Variable} console-font-service-type
Install the given fonts on the specified ttys (fonts are per
virtual console on the kernel Linux). The value of this service is a list of
tty/font pairs. The font can be the name of a font provided by the @code{kbd}
package or any valid argument to @command{setfont}, as in this example:
@lisp
`(("tty1" . "LatGrkCyr-8x16")
("tty2" . ,(file-append
font-tamzen
"/share/kbd/consolefonts/TamzenForPowerline10x20.psf"))
("tty3" . ,(file-append
font-terminus
"/share/consolefonts/ter-132n"))) ; for HDPI
@end lisp
@end defvr
@deffn {Scheme Procedure} login-service @var{config}
Return a service to run login according to @var{config}, a
@code{<login-configuration>} object, which specifies the message of the day,
@ -12847,7 +12869,7 @@ well as in the @var{groups} field of the @var{operating-system} record.
(operating-system
;; @dots{}
(users (cons (user-acount
(users (cons (user-account
;; @dots{}
(supplementary-groups
'("adbusers" ;for adb
@ -27007,7 +27029,7 @@ be accomplished with the following operating system configuration snippet:
(plain-file "sudoers"
(string-append (plain-file-content %sudoers-specification)
(format #f "~a ALL = NOPASSWD: ALL~%"
%username)))))
%user)))))
@end lisp

6
etc/guix-install.sh
View File

@ -414,7 +414,9 @@ if [ -L $_GUIX_PROFILE ]; then
export PATH="$_GUIX_PROFILE/bin${PATH:+:}$PATH"
# Export INFOPATH so that the updated info pages can be found
# and read by both /usr/bin/info and/or $GUIX_PROFILE/bin/info
export INFOPATH="$_GUIX_PROFILE/share/info${INFOPATH:+:}$INFOPATH"
# When INFOPATH is unset, add a trailing colon so that Emacs
# searches 'Info-default-directory-list'.
export INFOPATH="$_GUIX_PROFILE/share/info:$INFOPATH"
fi
# GUIX_PROFILE: User's default profile
@ -423,7 +425,7 @@ GUIX_PROFILE="$HOME/.guix-profile"
GUIX_LOCPATH="$GUIX_PROFILE/lib/locale"
export GUIX_PROFILE GUIX_LOCPATH
eval `guix package --search-paths=prefix 2> /dev/null`
[ -f "$GUIX_PROFILE/etc/profile" ] && . "$GUIX_PROFILE/etc/profile"
# set XDG_DATA_DIRS to include Guix installations
export XDG_DATA_DIRS="$GUIX_PROFILE/share:${XDG_DATA_DIRS:-/usr/local/share/:/usr/share/}"

6
etc/system-tests.scm
View File

@ -79,7 +79,11 @@ the 'TESTS' environment variable."
;; 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"
(let* ((source (local-file source
(if commit
(string-append "guix-"
(string-take commit 7))
"guix-source")
#:recursive? #t
#:select?
(or (git-predicate source)

46
gnu/build/linux-modules.scm
View File

@ -22,12 +22,14 @@
#:use-module (guix elf)
#:use-module (guix glob)
#:use-module (guix build syscalls)
#:use-module ((guix build utils) #:select (find-files))
#:use-module ((guix build utils) #:select (find-files invoke))
#:use-module (guix build union)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (ice-9 ftw)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
@ -56,7 +58,9 @@
write-module-name-database
write-module-alias-database
write-module-device-database))
write-module-device-database
make-linux-module-directory))
;;; Commentary:
;;;
@ -631,4 +635,42 @@ be loaded on-demand, such as file system modules."
module devname type major minor)))
aliases))))
(define (depmod version directory)
"Given an (existing) DIRECTORY, invoke depmod on it for
kernel version VERSION."
(let ((destination-directory (string-append directory "/lib/modules/"
version))
;; Note: "System.map" is an input file.
(maps-file (string-append directory "/System.map"))
;; Note: "Module.symvers" is an input file.
(symvers-file (string-append directory "/Module.symvers")))
;; These files will be regenerated by depmod below.
(for-each (lambda (basename)
(when (and (string-prefix? "modules." basename)
;; Note: "modules.builtin" is an input file.
(not (string=? "modules.builtin" basename))
;; Note: "modules.order" is an input file.
(not (string=? "modules.order" basename)))
(delete-file (string-append destination-directory "/"
basename))))
(scandir destination-directory))
(invoke "depmod"
"-e" ; Report symbols that aren't supplied
;"-w" ; Warn on duplicates
"-b" directory
"-F" maps-file
;"-E" symvers-file ; using both "-E" and "-F" is not possible.
version)))
(define (make-linux-module-directory inputs version output)
"Create a new directory OUTPUT and ensure that the directory
OUTPUT/lib/modules/VERSION can be used as a source of Linux
kernel modules for the first kmod in PATH now to eventually
load. Take modules to put into OUTPUT from INPUTS.
Right now that means it creates @code{modules.*.bin} which
@command{modprobe} will use to find loadable modules."
(union-build output inputs #:create-all-directories? #t)
(depmod version output))
;;; linux-modules.scm ends here

14
gnu/installer.scm
View File

@ -61,6 +61,14 @@
(('guix 'build _ ...) #t)
(_ #f)))
(define not-config?
;; Select (guix …) and (gnu …) modules, except (guix config).
(match-lambda
(('guix 'config) #f)
(('guix _ ...) #t)
(('gnu _ ...) #t)
(_ #f)))
(define* (build-compiled-file name locale-builder)
"Return a file-like object that evalutes the gexp LOCALE-BUILDER and store
its result in the scheme file NAME. The derivation will also build a compiled
@ -75,8 +83,10 @@ version of this file."
(define builder
(with-extensions (list guile-json-3)
(with-imported-modules (source-module-closure
'((gnu installer locale)))
(with-imported-modules `(,@(source-module-closure
'((gnu installer locale))
#:select? not-config?)
((guix config) => ,(make-config.scm)))
#~(begin
(use-modules (gnu installer locale))

13
gnu/installer/final.scm
View File

@ -111,12 +111,13 @@ USERS."
(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)))))
(false-if-exception
(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.

11
gnu/installer/tests.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -211,7 +212,7 @@ ROOT-PASSWORD, and USERS."
(define* (choose-services port
#:key
(desktop-environments '("GNOME"))
(choose-desktop-environment? (const #f))
(choose-network-service?
(lambda (service)
(or (string-contains service "SSH")
@ -220,10 +221,14 @@ ROOT-PASSWORD, and USERS."
(lambda (service)
(string-contains service "DHCP"))))
"Converse over PORT to choose networking services."
(define desktop-environments '())
(converse port
((checkbox-list (title "Desktop environment") (text _)
(items _))
desktop-environments)
(items ,services))
(let ((desktops (filter choose-desktop-environment? services)))
(set! desktop-environments desktops)
desktops))
((checkbox-list (title "Network service") (text _)
(items ,services))
(filter choose-network-service? services))

5
gnu/local.mk
View File

@ -635,6 +635,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/nfs.scm \
%D%/tests/install.scm \
%D%/tests/ldap.scm \
%D%/tests/linux-modules.scm \
%D%/tests/mail.scm \
%D%/tests/messaging.scm \
%D%/tests/networking.scm \
@ -776,6 +777,7 @@ dist_patch_DATA = \
%D%/packages/patches/calibre-remove-test-unrar.patch \
%D%/packages/patches/casync-renameat2-declaration.patch \
%D%/packages/patches/catdoc-CVE-2017-11110.patch \
%D%/packages/patches/circos-remove-findbin.patch \
%D%/packages/patches/cdparanoia-fpic.patch \
%D%/packages/patches/cdrtools-3.01-mkisofs-isoinfo.patch \
%D%/packages/patches/ceph-disable-cpu-optimizations.patch \
@ -983,6 +985,7 @@ dist_patch_DATA = \
%D%/packages/patches/gmp-faulty-test.patch \
%D%/packages/patches/gnome-shell-theme.patch \
%D%/packages/patches/gnome-tweaks-search-paths.patch \
%D%/packages/patches/gnupg-default-pinentry.patch \
%D%/packages/patches/gnutls-skip-trust-store-test.patch \
%D%/packages/patches/gobject-introspection-absolute-shlib-path.patch \
%D%/packages/patches/gobject-introspection-cc.patch \
@ -1044,6 +1047,7 @@ dist_patch_DATA = \
%D%/packages/patches/icecat-use-system-media-libs.patch \
%D%/packages/patches/icedtea-6-hotspot-gcc-segfault-workaround.patch \
%D%/packages/patches/icedtea-7-hotspot-gcc-segfault-workaround.patch \
%D%/packages/patches/icu4c-CVE-2020-10531.patch \
%D%/packages/patches/id3lib-CVE-2007-4460.patch \
%D%/packages/patches/id3lib-UTF16-writing-bug.patch \
%D%/packages/patches/ilmbase-fix-tests.patch \
@ -1167,6 +1171,7 @@ dist_patch_DATA = \
%D%/packages/patches/lierolibre-remove-arch-warning.patch \
%D%/packages/patches/lierolibre-try-building-other-arch.patch \
%D%/packages/patches/linkchecker-tests-require-network.patch \
%D%/packages/patches/linux-libre-support-for-Pinebook-Pro.patch \
%D%/packages/patches/linux-pam-no-setfsuid.patch \
%D%/packages/patches/lirc-localstatedir.patch \
%D%/packages/patches/lirc-reproducible-build.patch \

138
gnu/machine/ssh.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -39,6 +40,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 textual-ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
@ -142,9 +144,24 @@ an environment type of 'managed-host."
;;; Safety checks.
;;;
;; Assertion to be executed remotely. This abstraction exists to allow us to
;; gather a list of expressions to be evaluated and eventually evaluate them
;; all at once instead of one by one. (This is pretty much a monad.)
(define-record-type <remote-assertion>
(remote-assertion exp proc)
remote-assertion?
(exp remote-assertion-expression)
(proc remote-assertion-procedure))
(define-syntax-rule (remote-let ((var exp)) body ...)
"Return a <remote-assertion> that binds VAR to the result of evaluating EXP,
a gexp, remotely, and evaluate BODY in that context."
(remote-assertion exp (lambda (var) body ...)))
(define (machine-check-file-system-availability machine)
"Raise a '&message' error condition if any of the file-systems specified in
MACHINE's 'system' declaration do not exist on the machine."
"Return a list of <remote-assertion> that raise a '&message' error condition
if any of the file-systems specified in MACHINE's 'system' declaration do not
exist on the machine."
(define file-systems
(filter (lambda (fs)
(and (file-system-mount? fs)
@ -154,22 +171,18 @@ MACHINE's 'system' declaration do not exist on the machine."
(operating-system-file-systems (machine-operating-system machine))))
(define (check-literal-file-system fs)
(define remote-exp
#~(catch 'system-error
(lambda ()
(stat #$(file-system-device fs))
#t)
(lambda args
(system-error-errno args))))
(mlet %store-monad ((errno (machine-remote-eval machine remote-exp)))
(remote-let ((errno #~(catch 'system-error
(lambda ()
(stat #$(file-system-device fs))
#t)
(lambda args
(system-error-errno args)))))
(when (number? errno)
(raise (condition
(&message
(message (format #f (G_ "device '~a' not found: ~a")
(file-system-device fs)
(strerror errno)))))))
(return #t)))
(strerror errno)))))))))
(define (check-labeled-file-system fs)
(define remote-exp
@ -180,14 +193,13 @@ MACHINE's 'system' declaration do not exist on the machine."
(find-partition-by-label #$(file-system-label->string
(file-system-device fs))))))
(mlet %store-monad ((result (machine-remote-eval machine remote-exp)))
(remote-let ((result remote-exp))
(unless result
(raise (condition
(&message
(message (format #f (G_ "no file system with label '~a'")
(file-system-label->string
(file-system-device fs))))))))
(return #t)))
(file-system-device fs))))))))))
(define (check-uuid-file-system fs)
(define remote-exp
@ -203,31 +215,30 @@ MACHINE's 'system' declaration do not exist on the machine."
(find-partition-by-uuid uuid))))
(mlet %store-monad ((result (machine-remote-eval machine remote-exp)))
(remote-let ((result remote-exp))
(unless result
(raise (condition
(&message
(message (format #f (G_ "no file system with UUID '~a'")
(uuid->string (file-system-device fs))))))))
(return #t)))
(uuid->string (file-system-device fs))))))))))
(mbegin %store-monad
(mapm %store-monad check-literal-file-system
(filter (lambda (fs)
(string? (file-system-device fs)))
file-systems))
(mapm %store-monad check-labeled-file-system
(filter (lambda (fs)
(file-system-label? (file-system-device fs)))
file-systems))
(mapm %store-monad check-uuid-file-system
(filter (lambda (fs)
(uuid? (file-system-device fs)))
file-systems))))
(append (map check-literal-file-system
(filter (lambda (fs)
(string? (file-system-device fs)))
file-systems))
(map check-labeled-file-system
(filter (lambda (fs)
(file-system-label? (file-system-device fs)))
file-systems))
(map check-uuid-file-system
(filter (lambda (fs)
(uuid? (file-system-device fs)))
file-systems))))
(define (machine-check-initrd-modules machine)
"Raise a '&message' error condition if any of the modules needed by
'needed-for-boot' file systems in MACHINE are not available in the initrd."
"Return a list of <remote-assertion> that raise a '&message' error condition
if any of the modules needed by 'needed-for-boot' file systems in MACHINE are
not available in the initrd."
(define file-systems
(filter file-system-needed-for-boot?
(operating-system-file-systems (machine-operating-system machine))))
@ -255,20 +266,16 @@ MACHINE's 'system' declaration do not exist on the machine."
(missing-modules dev '#$(operating-system-initrd-modules
(machine-operating-system machine)))))))
(mlet %store-monad ((missing (machine-remote-eval machine remote-exp)))
(return (list fs missing))))
(mlet %store-monad ((device (mapm %store-monad missing-modules file-systems)))
(for-each (match-lambda
((fs missing)
(unless (null? missing)
(raise (condition
(&message
(message (format #f (G_ "~a missing modules ~{ ~a~}~%")
(file-system-device fs)
missing))))))))
device)
(return #t)))
(remote-let ((missing remote-exp))
(unless (null? missing)
(raise (condition
(&message
(message (format #f (G_ "missing modules for ~a:~{ ~a~}~%")
(file-system-device fs)
missing))))))))
(map missing-modules file-systems))
(define (machine-check-building-for-appropriate-system machine)
"Raise a '&message' error condition if MACHINE is configured to be built
@ -280,21 +287,38 @@ by MACHINE."
(not (string= system (machine-ssh-configuration-system config))))
(raise (condition
(&message
(message (format #f (G_ "incorrect target system \
('~a' was given, while the system reports that it is '~a')~%")
(message (format #f (G_ "incorrect target system\
('~a' was given, while the system reports that it is '~a')~%")
(machine-ssh-configuration-system config)
system)))))))
(with-monad %store-monad (return #t)))
system))))))))
(define (check-deployment-sanity machine)
"Raise a '&message' error condition if it is clear that deploying MACHINE's
'system' declaration would fail."
;; Order is important here -- an incorrect value for 'system' will cause
;; invocations of 'remote-eval' to fail.
(mbegin %store-monad
(machine-check-building-for-appropriate-system machine)
(machine-check-file-system-availability machine)
(machine-check-initrd-modules machine)))
(define assertions
(append (machine-check-file-system-availability machine)
(machine-check-initrd-modules machine)))
(define aggregate-exp
;; Gather all the expressions so that a single round-trip is enough to
;; evaluate all the ASSERTIONS remotely.
#~(map (lambda (file)
(false-if-exception (primitive-load file)))
'#$(map (lambda (assertion)
(scheme-file "remote-assertion.scm"
(remote-assertion-expression assertion)))
assertions)))
;; First check MACHINE's system type--an incorrect value for 'system' would
;; cause subsequent invocations of 'remote-eval' to fail.
(machine-check-building-for-appropriate-system machine)
(mlet %store-monad ((values (machine-remote-eval machine aggregate-exp)))
(for-each (lambda (proc value)
(proc value))
(map remote-assertion-procedure assertions)
values)
(return #t)))
;;;

78
gnu/packages/audio.scm
View File

@ -78,6 +78,7 @@
#:use-module (gnu packages libusb)
#:use-module (gnu packages linux)
#:use-module (gnu packages llvm)
#:use-module (gnu packages man)
#:use-module (gnu packages maths)
#:use-module (gnu packages mp3) ;taglib
#:use-module (gnu packages multiprecision)
@ -4074,3 +4075,80 @@ given plugin and its UI(s) match up with the provided metadata and adhere
to well-known best practices.")
(home-page "https://open-music-kontrollers.ch/lv2/lv2lint/")
(license license:artistic2.0)))
(define-public lv2toweb
(package
(name "lv2toweb")
(version "0.4")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/x42/lv2toweb")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"007aysqvgkf25za8nkmyd5g9kp1zla460dcpidlj5xg1zc3fcdfi"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no "check" target
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" (assoc-ref %outputs "out")))
#:phases
(modify-phases %standard-phases
(delete 'configure))))
(inputs
`(("jalv", jalv)
("lilv", lilv)))
(native-inputs
`(("help2man", help2man)
("pkg-config", pkg-config)))
(synopsis "Documentation generator for LV2 plugins")
(description
"lv2toweb allows the user to create an xhtml page with information
about the given LV2 plugin, provided that the plugin and its UI(s) match up
with the provided metadata and adhere to well-known best practices.")
(home-page "https://github.com/x42/lv2toweb")
(license (list license:isc license:gpl2))))
(define-public ztoolkit
(package
(name "ztoolkit")
(version "0.1.1")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://git.zrythm.org/git/ztoolkit")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"07xl3cmdaf7k9mm58m93cn8i1jvgimmiifdw1w7v2jl88nx60pm1"))))
(build-system meson-build-system)
(inputs
`(("cairo" ,cairo)
("libx11" ,libx11)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(synopsis "GUI toolkit for LV2 plugins")
(description "ZToolkit (Ztk) is a cross-platform GUI toolkit heavily
inspired by GTK. It handles events and low level drawing on behalf of
the user and provides a high-level API for managing the UI and custom
widgets. ZToolkit is written in C and was created to be used for building
audio plugin UIs, where the dependencies often need to be kept to a
minimum.")
(home-page "https://git.zrythm.org/cgit/ztoolkit/")
(license license:agpl3+)))
(define-public ztoolkit-rsvg
(package
(inherit ztoolkit)
(name "ztoolkit-rsvg")
(arguments
`(#:configure-flags `("-Denable_rsvg=true")))
(inputs
`(("librsvg" ,librsvg)
,@(package-inputs ztoolkit)))
(synopsis "ZToolkit with SVG support")))

28
gnu/packages/autotools.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; 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 © 2015 Mathieu Lirzin <mthl@openmailbox.org>
;;; Copyright © 2014 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;; Copyright © 2015, 2017, 2018 Mark H Weaver <mhw@netris.org>
@ -325,6 +325,32 @@ intuitive format and then Automake works with Autoconf to produce a robust
Makefile, simplifying the entire process for the developer.")
(license gpl2+))) ; some files are under GPLv3+
(define-public automake-1.16.2
(package
(inherit automake)
(version "1.16.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/automake/automake-"
version ".tar.xz"))
(sha256
(base32
"1l7dkqbsmbf94ax29jj1jf6a0r6ikc8jybg1p5m0c3ki7pg5ki6c"))
(patches
(search-patches "automake-skip-amhello-tests.patch"))))
(arguments
(substitute-keyword-arguments (package-arguments automake)
((#:phases phases '%standard-phases)
`(modify-phases ,phases
(add-before 'check 'skip-test
(lambda _
;; This test requires 'etags' and fails if it's missing.
;; Skip it.
(substitute* "t/tags-lisp-space.sh"
(("^required.*" all)
(string-append "exit 77\n" all "\n")))
#t))))))))
(define-public libtool
(package
(name "libtool")

2
gnu/packages/aux-files/emacs/guix-emacs.el
View File

@ -45,8 +45,6 @@ The files in the list do not have extensions (.el, .elc)."
'Autoload' means to load the 'autoloads' files matching
`guix-emacs-autoloads-regexp'."
;; FIXME: The autoloads generated by the emacs-build-system are not byte
;; compiled.
(interactive)
(let* ((emacs-non-core-load-path-directories
;; Filter out core Elisp directories, which are already autoloaded

5040
gnu/packages/aux-files/linux-libre/5.4-arm-veyron.conf
View File

File diff suppressed because it is too large Load Diff

34
gnu/packages/backup.scm
View File

@ -60,6 +60,7 @@
#:use-module (gnu packages linux)
#:use-module (gnu packages mcrypt)
#:use-module (gnu packages nettle)
#:use-module (gnu packages onc-rpc)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
@ -481,10 +482,26 @@ rsnapshot uses hard links to deduplicate identical files.")
(sha256
(base32
"0fpdyxww41ba52d98blvnf543xvirq1v9xz1i3x1gm9lzlzpmc2g"))
(patches (search-patches "diffutils-gets-undeclared.patch"))))
(patches (search-patches "diffutils-gets-undeclared.patch"))
(modules '((guix build utils)))
(snippet
'(begin
;; Include all the libtirpc headers necessary to get the
;; definitions of 'u_int', etc.
(substitute* '("src/block-server.c"
"include/chop/block-server.h"
"utils/chop-block-server.c")
(("#include <rpc/(.*)\\.h>" _ header)
(string-append "#include <rpc/types.h>\n"
"#include <rpc/rpc.h>\n"
"#include <rpc/" header ".h>\n")))
#t))))
(build-system gnu-build-system)
(arguments
'(#:phases (modify-phases %standard-phases
'(;; Link against libtirpc.
#:configure-flags '("LDFLAGS=-ltirpc -Wl,--as-needed")
#:phases (modify-phases %standard-phases
(add-before 'configure 'adjust-configure-script
(lambda _
;; Mimic upstream commit
@ -494,6 +511,15 @@ rsnapshot uses hard links to deduplicate identical files.")
(string-append "GUILE=" middle
"--variable bindir`/guile")))
#t))
(add-before 'build 'set-libtirpc-include-path
(lambda* (#:key inputs #:allow-other-keys)
;; Allow <rpc/rpc.h> & co. to be found.
(let ((libtirpc (assoc-ref inputs "libtirpc")))
(setenv "CPATH"
(string-append (getenv "CPATH")
":" libtirpc
"/include/tirpc"))
#t)))
(add-before 'check 'skip-test
(lambda _
;; XXX: This test fails (1) because current GnuTLS no
@ -504,10 +530,12 @@ rsnapshot uses hard links to deduplicate identical files.")
(native-inputs
`(("guile" ,guile-2.0)
("gperf" ,gperf-3.0) ;see <https://bugs.gnu.org/32382>
("pkg-config" ,pkg-config)))
("pkg-config" ,pkg-config)
("rpcsvc-proto" ,rpcsvc-proto))) ;for 'rpcgen'
(inputs
`(("guile" ,guile-2.0)
("util-linux" ,util-linux)
("libtirpc" ,libtirpc)
("gnutls" ,gnutls)
("tdb" ,tdb)
("bdb" ,bdb)

24
gnu/packages/bioconductor.scm
View File

@ -2649,6 +2649,8 @@ interactive exploration of results.")
("r-singlecellexperiment" ,r-singlecellexperiment)
("r-stringr" ,r-stringr)
("r-summarizedexperiment" ,r-summarizedexperiment)))
(native-inputs
`(("r-knitr" ,r-knitr)))
(home-page "https://github.com/RGLab/MAST/")
(synopsis "Model-based analysis of single cell transcriptomics")
(description
@ -3393,20 +3395,22 @@ information about samples and features can be added to the plot.")
(define-public r-gosemsim
(package
(name "r-gosemsim")
(version "2.12.0")
(version "2.12.1")
(source
(origin
(method url-fetch)
(uri (bioconductor-uri "GOSemSim" version))
(sha256
(base32
"0pqnlgdvh5szjhwc1mw1snjgpj9lrsnk44bn164cl3zwvdayccya"))))
"1r8yx6qw6d6602cp8aspzl3shi1l1zqcrc8fm9d5wg01sw1whs05"))))
(properties `((upstream-name . "GOSemSim")))
(build-system r-build-system)
(propagated-inputs
`(("r-annotationdbi" ,r-annotationdbi)
("r-go-db" ,r-go-db)
("r-rcpp" ,r-rcpp)))
(native-inputs
`(("r-knitr" ,r-knitr)))
(home-page "https://guangchuangyu.github.io/software/GOSemSim")
(synopsis "GO-terms semantic similarity measures")
(description
@ -5316,14 +5320,14 @@ coefficients).")
(define-public r-biosigner
(package
(name "r-biosigner")
(version "1.14.2")
(version "1.14.4")
(source
(origin
(method url-fetch)
(uri (bioconductor-uri "biosigner" version))
(sha256
(base32
"184vbbd010yzqv0qn1prxiazibxwiacvlpg9yzcgyhamcx9bvq73"))))
"0hypk784xcax99mp673md6kvx45chk2nxbqniww7zm9q2hj983hl"))))
(build-system r-build-system)
(propagated-inputs
`(("r-biobase" ,r-biobase)
@ -6995,14 +6999,14 @@ a file-backed matrix with factor properties.")
(define-public r-bigpint
(package
(name "r-bigpint")
(version "1.2.0")
(version "1.2.2")
(source
(origin
(method url-fetch)
(uri (bioconductor-uri "bigPint" version))
(sha256
(base32
"10vs0lzfyxp6sm4r9pxfwipjvzmmaqnvwn1hc5q37s5qz44fg0hk"))))
"1zkakxi1iqavzmjxnkkd02qm5jk28ldcvcdcxaafz748dz6s67fs"))))
(properties `((upstream-name . "bigPint")))
(build-system r-build-system)
(propagated-inputs
@ -7022,6 +7026,8 @@ a file-backed matrix with factor properties.")
("r-shinydashboard" ,r-shinydashboard)
("r-stringr" ,r-stringr)
("r-tidyr" ,r-tidyr)))
(native-inputs
`(("r-knitr" ,r-knitr)))
(home-page "https://github.com/lindsayrutter/bigPint")
(synopsis "Big multivariate data plotted interactively")
(description
@ -7296,14 +7302,14 @@ access.")
(define-public r-multiassayexperiment
(package
(name "r-multiassayexperiment")
(version "1.12.4")
(version "1.12.5")
(source
(origin
(method url-fetch)
(uri (bioconductor-uri "MultiAssayExperiment" version))
(sha256
(base32
"01cnp00y5bk551c8gqgqp5468dvccg72i0rvh5cxgbx1c42zy6xn"))))
"0a7zsq3adg8rph1w2qr75bpmrq53j99rsypmxj9w5mz9q23r2qlr"))))
(properties
`((upstream-name . "MultiAssayExperiment")))
(build-system r-build-system)
@ -7315,6 +7321,8 @@ access.")
("r-s4vectors" ,r-s4vectors)
("r-summarizedexperiment" ,r-summarizedexperiment)
("r-tidyr" ,r-tidyr)))
(native-inputs
`(("r-knitr" ,r-knitr)))
(home-page "https://waldronlab.io/MultiAssayExperiment/")
(synopsis "Integration of multi-omics experiments in Bioconductor")
(description

143
gnu/packages/bioinformatics.scm
View File

@ -42,6 +42,7 @@
#:use-module (guix build-system ant)
#:use-module (guix build-system gnu)
#:use-module (guix build-system cmake)
#:use-module (guix build-system go)
#:use-module (guix build-system haskell)
#:use-module (guix build-system meson)
#:use-module (guix build-system ocaml)
@ -68,15 +69,17 @@
#:use-module (gnu packages documentation)
#:use-module (gnu packages databases)
#:use-module (gnu packages datastructures)
#:use-module (gnu packages dlang)
#:use-module (gnu packages file)
#:use-module (gnu packages flex)
#:use-module (gnu packages gawk)
#:use-module (gnu packages gcc)
#:use-module (gnu packages gd)
#:use-module (gnu packages gtk)
#:use-module (gnu packages golang)
#:use-module (gnu packages glib)
#:use-module (gnu packages graph)
#:use-module (gnu packages groff)
#:use-module (gnu packages gtk)
#:use-module (gnu packages guile)
#:use-module (gnu packages guile-xyz)
#:use-module (gnu packages haskell-check)
@ -87,7 +90,6 @@
#:use-module (gnu packages java)
#:use-module (gnu packages java-compression)
#:use-module (gnu packages jemalloc)
#:use-module (gnu packages dlang)
#:use-module (gnu packages linux)
#:use-module (gnu packages lisp-xyz)
#:use-module (gnu packages logging)
@ -2766,7 +2768,12 @@ quantitative phenotypes.")
"093zp7klv81ph0y8mm8d78a9hnpfxbv2kdym70gzdf3vz176rw33"))
(modules '((guix build utils)))
(snippet
'(begin (delete-file "Mozilla-CA.tar.gz") #t))))
'(begin (delete-file "Mozilla-CA.tar.gz")
(substitute* "rchive.go"
;; This go library does not have any license.
(("github.com/fiam/gounidecode/unidecode")
"golang.org/rainycape/unidecode"))
#t))))
(build-system perl-build-system)
(arguments
`(#:phases
@ -2774,19 +2781,48 @@ quantitative phenotypes.")
(delete 'configure)
(delete 'build)
(delete 'check) ; simple check after install
(add-after 'unpack 'patch-programs
(lambda* (#:key inputs #:allow-other-keys)
;; Ignore errors about missing xtract.Linux and rchive.Linux.
(substitute* "pm-refresh"
(("cat \\\"\\$target")
"grep ^[[:digit:]] \"$target"))
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(install-file "edirect.pl"
(string-append (assoc-ref outputs "out") "/bin"))
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((bin (string-append (assoc-ref outputs "out") "/bin"))
(edirect-go (assoc-ref inputs "edirect-go-programs")))
(for-each
(lambda (file)
(install-file file bin))
'("archive-pubmed" "asp-cp" "asp-ls" "download-ncbi-data"
"download-pubmed" "edirect.pl" "efetch" "epost" "esearch"
"fetch-pubmed" "ftp-cp" "ftp-ls" "has-asp" "index-pubmed"
"pm-prepare" "pm-refresh" "pm-stash" "pm-collect"
"pm-index" "pm-invert" "pm-merge" "pm-promote"))
(symlink (string-append edirect-go "/bin/xtract.Linux")
(string-append bin "/xtract"))
(symlink (string-append edirect-go "/bin/rchive.Linux")
(string-append bin "/rchive")))
#t))
(add-after 'install 'wrap-program
(lambda* (#:key outputs #:allow-other-keys)
;; Make sure 'edirect.pl' finds all perl inputs at runtime.
(let* ((out (assoc-ref outputs "out"))
;; Make sure everything can run in a pure environment.
(let ((out (assoc-ref outputs "out"))
(path (getenv "PERL5LIB")))
(wrap-program (string-append out "/bin/edirect.pl")
`("PERL5LIB" ":" prefix (,path))))
#t))
(for-each
(lambda (file)
(wrap-program file
`("PERL5LIB" ":" prefix (,path)))
(wrap-program file
`("PATH" ":" prefix (,(string-append out "/bin")
,(dirname (which "sed"))
,(dirname (which "gzip"))
,(dirname (which "grep"))
,(dirname (which "perl"))
,(dirname (which "uname"))))))
(find-files out ".")))
#t))
(add-after 'wrap-program 'check
(lambda* (#:key outputs #:allow-other-keys)
(invoke (string-append (assoc-ref outputs "out")
@ -2794,7 +2830,8 @@ quantitative phenotypes.")
"-filter" "-help")
#t)))))
(inputs
`(("perl-html-parser" ,perl-html-parser)
`(("edirect-go-programs" ,edirect-go-programs)
("perl-html-parser" ,perl-html-parser)
("perl-encode-locale" ,perl-encode-locale)
("perl-file-listing" ,perl-file-listing)
("perl-html-tagset" ,perl-html-tagset)
@ -2824,8 +2861,59 @@ EDirect also provides an argument-driven function that simplifies the
extraction of data from document summaries or other results that are returned
in structured XML format. This can eliminate the need for writing custom
software to answer ad hoc questions.")
(native-search-paths
;; Ideally this should be set for LWP somewhere.
(list (search-path-specification
(variable "PERL_LWP_SSL_CA_FILE")
(file-type 'regular)
(separator #f)
(files '("/etc/ssl/certs/ca-certificates.crt")))))
(license license:public-domain)))
(define-public edirect-go-programs
(package
(inherit edirect)
(name "edirect-go-programs")
(build-system go-build-system)
(arguments
`(#:install-source? #f
#:tests? #f ; No tests.
#:import-path "ncbi.nlm.nih.gov/entrez/edirect"
#:phases
(modify-phases %standard-phases
(replace 'build
(lambda* (#:key import-path #:allow-other-keys)
(with-directory-excursion (string-append "src/" import-path)
(invoke "go" "build" "-v" "-x" "j2x.go")
(invoke "go" "build" "-v" "-x" "t2x.go")
(invoke "go" "build" "-v" "-x" "-o"
"xtract.Linux" "xtract.go" "common.go")
(invoke "go" "build" "-v" "-x" "-o"
"rchive.Linux" "rchive.go" "common.go")
(invoke "go" "build" "-v" "-x" "-o" "symbols.Linux" "s2p.go"))))
(replace 'install
(lambda* (#:key outputs import-path #:allow-other-keys)
(let ((dest (string-append (assoc-ref outputs "out") "/bin"))
(source (string-append "src/" import-path "/")))
(for-each (lambda (file)
(format #t "installing ~a~%" file)
(install-file (string-append source file) dest))
'("j2x" "t2x" "symbols.Linux" "xtract.Linux" "rchive.Linux"))
#t))))))
(native-inputs '())
(propagated-inputs '())
(inputs
`(("go-github-com-fatih-color" ,go-github-com-fatih-color)
("go-github-com-fogleman-gg" ,go-github-com-fogleman-gg)
("go-github-com-gedex-inflector" ,go-github-com-gedex-inflector)
("go-github-com-golang-freetype" ,go-github-com-golang-freetype)
("go-github-com-klauspost-cpuid" ,go-github-com-klauspost-cpuid)
("go-github-com-pbnjay-memory" ,go-github-com-pbnjay-memory)
("go-github-com-surgebase-porter2" ,go-github-com-surgebase-porter2)
("go-golang-org-rainycape-unidecode" ,go-golang-org-rainycape-unidecode)
("go-golang-org-x-image" ,go-golang-org-x-image)
("go-golang-org-x-text" ,go-golang-org-x-text)))))
(define-public exonerate
(package
(name "exonerate")
@ -8654,14 +8742,16 @@ factors bound at the specific regions.")
(define-public r-tximport
(package
(name "r-tximport")
(version "1.14.0")
(version "1.14.2")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "tximport" version))
(sha256
(base32
"09r23n2812q89by0r0cz2fx1gfnmn3jb3hwbg61m52bika82pakj"))))
"1avy0zhgnszmg0dr9w74yq9ml10kwdrrgcni2wysrd48zzskc1n0"))))
(build-system r-build-system)
(native-inputs
`(("r-knitr" ,r-knitr)))
(home-page "https://bioconductor.org/packages/tximport")
(synopsis "Import and summarize transcript-level estimates for gene-level analysis")
(description
@ -10887,7 +10977,7 @@ droplet sequencing. It has been particularly tailored for Drop-seq.")
(define-public sambamba
(package
(name "sambamba")
(version "0.6.8")
(version "0.7.1")
(source
(origin
(method git-fetch)
@ -10897,7 +10987,7 @@ droplet sequencing. It has been particularly tailored for Drop-seq.")
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"0k0cz3qcv98p6cq09zlbgnjsggxcqbcmzxg5zikgcgbr2nfq4lry"))))
"111h05b60pj8dxbidiamy4imc92x2962b3lmb7wgysl6lx064qis"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; there is no test target
@ -10916,7 +11006,6 @@ droplet sequencing. It has been particularly tailored for Drop-seq.")
(add-after 'unpack 'place-biod-and-undead
(lambda* (#:key inputs #:allow-other-keys)
(copy-recursively (assoc-ref inputs "biod") "BioD")
(copy-recursively (assoc-ref inputs "undead") "undeaD")
#t))
(add-after 'unpack 'unbundle-prerequisites
(lambda _
@ -10930,14 +11019,15 @@ droplet sequencing. It has been particularly tailored for Drop-seq.")
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin")))
(mkdir-p bin)
(install-file "bin/sambamba" bin)
(copy-file (string-append "bin/sambamba-" ,version)
(string-append bin "/sambamba"))
#t))))))
(native-inputs
`(("ldc" ,ldc)
("rdmd" ,rdmd)
("python" ,python)
("biod"
,(let ((commit "4f1a7d2fb7ef3dfe962aa357d672f354ebfbe42e"))
,(let ((commit "7969eb0a847b05874e83ffddead26e193ece8101"))
(origin
(method git-fetch)
(uri (git-reference
@ -10948,20 +11038,7 @@ droplet sequencing. It has been particularly tailored for Drop-seq.")
"-checkout"))
(sha256
(base32
"1k5pdjv1qvi0a3rwd1sfq6zbj37l86i7bf710m4c0y6737lxj426")))))
("undead"
,(let ((commit "9be93876982b5f14fcca60832563b3cd767dd84d"))
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/biod/undeaD.git")
(commit commit)))
(file-name (string-append "undead-"
(string-take commit 9)
"-checkout"))
(sha256
(base32
"1xfarj0nqlmi5jd1vmcmm7pabzaf9hxyvk6hp0d6jslb5k9r8r3d")))))))
"0mjxsmbmv0jxl3pq21p8j5r829d648if8q58ka50b2956lc6qkpm")))))))
(inputs
`(("lz4" ,lz4)
("htslib" ,htslib-for-sambamba)))

13
gnu/packages/bittorrent.scm
View File

@ -434,7 +434,18 @@ desktops.")
(assoc-ref %build-inputs "boost")
"/lib")
"--enable-debug"
"QMAKE_LRELEASE=lrelease")))
"QMAKE_LRELEASE=lrelease")
#:modules ((guix build gnu-build-system)
(guix build qt-utils)
(guix build utils))
#:imported-modules (,@%gnu-build-system-modules
(guix build qt-utils))
#:phases
(modify-phases %standard-phases
(add-after 'install 'wrap-qt
(lambda* (#:key outputs #:allow-other-keys)
(wrap-qt-program (assoc-ref outputs "out") "qbittorrent")
#t)))))
(native-inputs
`(("pkg-config" ,pkg-config)
("qttools" ,qttools)))

5
gnu/packages/cpp.scm
View File

@ -8,6 +8,7 @@
;;; Copyright © 2019 Jan Wielkiewicz <tona_kosmicznego_smiecia@interia.pl>
;;; Copyright © 2020 Nicolò Balzarotti <nicolo@nixo.xyz>
;;; Copyright © 2020 Roel Janssen <roel@gnu.org>
;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -444,7 +445,7 @@ point and then, after each tween step, plugging back the result.")
(define-public abseil-cpp
(package
(name "abseil-cpp")
(version "20200225")
(version "20200225.1")
(source (origin
(method git-fetch)
(uri (git-reference
@ -453,7 +454,7 @@ point and then, after each tween step, plugging back the result.")
(file-name (git-file-name name version))
(sha256
(base32
"0wb04pszzrl39ny1pz9jvvq8lbbm355dd60jspcyqfwxnk6njgd1"))))
"035bffayslawc19q2gmlkr6n6r7k7mvriaq7352rv6gyzaplr98w"))))
(build-system cmake-build-system)
(arguments
`(#:configure-flags (list "-DBUILD_SHARED_LIBS=ON"

269
gnu/packages/cran.scm
View File

@ -18,6 +18,7 @@
;;; Copyright © 2018, 2019 Brett Gilio <brettg@gnu.org>
;;; Copyright © 2019 Nicolò Balzarotti <anothersms@gmail.com>
;;; Copyright © 2019 Wiktor Żelazny <wzelazny@vurv.cz>
;;; Copyright © 2020 Todor Kondić <tk.code@protonmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -42,6 +43,7 @@
#:use-module (guix utils)
#:use-module (guix build-system r)
#:use-module (gnu packages algebra)
#:use-module (gnu packages autotools)
#:use-module (gnu packages base)
#:use-module (gnu packages bioinformatics)
#:use-module (gnu packages c)
@ -759,7 +761,7 @@ data structures in C++.")
(define-public r-shiny
(package
(name "r-shiny")
(version "1.4.0")
(version "1.4.0.2")
(source
(origin
(method git-fetch)
@ -769,7 +771,7 @@ data structures in C++.")
(file-name (git-file-name name version))
(sha256
(base32
"17ac48g414h9dhi0k4wrah4gyik0q5r0xw3kc01c02qfjwimqsx7"))))
"005wgcxq7f2q9g6wvfk29n2nms262w0abpz93sfvx79yv6qxppzs"))))
(build-system r-build-system)
(arguments
`(#:modules ((guix build r-build-system)
@ -837,15 +839,19 @@ data structures in C++.")
#t)))))
(propagated-inputs
`(("r-crayon" ,r-crayon)
("r-fastmap" ,r-fastmap)
("r-httpuv" ,r-httpuv)
("r-mime" ,r-mime)
("r-jsonlite" ,r-jsonlite)
("r-xtable" ,r-xtable)
("r-digest" ,r-digest)
("r-fastmap" ,r-fastmap)
("r-htmltools" ,r-htmltools)
("r-httpuv" ,r-httpuv)
("r-jsonlite" ,r-jsonlite)
("r-later" ,r-later)
("r-mime" ,r-mime)
("r-promises" ,r-promises)
("r-r6" ,r-r6)
("r-sourcetools" ,r-sourcetools)))
("r-rlang" ,r-rlang)
("r-sourcetools" ,r-sourcetools)
("r-withr" ,r-withr)
("r-xtable" ,r-xtable)))
(inputs
`(("js-datatables" ,js-datatables)
("js-html5shiv" ,js-html5shiv)
@ -856,7 +862,8 @@ data structures in C++.")
("js-highlight" ,js-highlight)
("js-es5-shim" ,js-es5-shim)))
(native-inputs
`(("uglify-js" ,uglify-js)))
`(("uglify-js" ,uglify-js)
("gfortran" ,gfortran)))
(home-page "http://shiny.rstudio.com")
(synopsis "Easy interactive web applications with R")
(description
@ -4931,6 +4938,28 @@ files.")
environment within Shiny.")
(license license:expat)))
(define-public r-randomizr
(package
(name "r-randomizr")
(version "0.20.0")
(source
(origin
(method url-fetch)
(uri (cran-uri "randomizr" version))
(sha256
(base32
"0dljyfldnardaps3fq6vi5wcs9x6qfaq5apapa78c51lnaa6fn9h"))))
(properties `((upstream-name . "randomizr")))
(build-system r-build-system)
(native-inputs
`(("r-knitr" ,r-knitr)))
(home-page "https://declaredesign.org/r/randomizr/")
(synopsis "Tools for common forms of random assignment and sampling")
(description
"This package provides tools for generating random assignments for common
experimental designs and random samples for common sampling designs.")
(license license:expat)))
(define-public r-base64url
(package
(name "r-base64url")
@ -4961,14 +4990,14 @@ systems.")
(define-public r-radiant-data
(package
(name "r-radiant-data")
(version "1.0.6")
(version "1.3.4")
(source
(origin
(method url-fetch)
(uri (cran-uri "radiant.data" version))
(sha256
(base32
"08x7zasxf429m021482p86lx3zc6dqz2mih0id8s34isg4gafapg"))
"19sjjb49inrfl7jzq4zpwhdslni0zrp30bl58pisin29ka3ylpzs"))
(modules '((guix build utils)))
(snippet
'(begin
@ -4986,15 +5015,17 @@ systems.")
("r-dt" ,r-dt)
("r-glue" ,r-glue)
("r-ggplot2" ,r-ggplot2)
("r-gridextra" ,r-gridextra)
("r-import" ,r-import)
("r-jsonlite" ,r-jsonlite)
("r-knitr" ,r-knitr)
("r-lubridate" ,r-lubridate)
("r-magrittr" ,r-magrittr)
("r-markdown" ,r-markdown)
("r-mass" ,r-mass)
("r-patchwork" ,r-patchwork)
("r-plotly" ,r-plotly)
("r-psych" ,r-psych)
("r-randomizr" ,r-randomizr)
("r-readr" ,r-readr)
("r-readxl" ,r-readxl)
("r-rlang" ,r-rlang)
@ -6864,14 +6895,14 @@ containing one or more SNPs that evolved under directional selection.")
(define-public r-proc
(package
(name "r-proc")
(version "1.16.1")
(version "1.16.2")
(source
(origin
(method url-fetch)
(uri (cran-uri "pROC" version))
(sha256
(base32
"0qkp1byl2xspxaaf0by6mvvrhg7wlz6fxmynz2hkh0ds24w7ig9m"))))
"0apwa5zzqh74pjnvf5a1s5qf6i9r5h44jdllfrwymkd2v479d2xn"))))
(properties `((upstream-name . "pROC")))
(build-system r-build-system)
(propagated-inputs
@ -11583,14 +11614,14 @@ lasso, adaptive lasso and Ridge regression based on cross-validation.")
(define-public r-mcmc
(package
(name "r-mcmc")
(version "0.9-6.1")
(version "0.9-7")
(source
(origin
(method url-fetch)
(uri (cran-uri "mcmc" version))
(sha256
(base32
"1i1nhdapyijvm58zx38q28zk01ndmi6smjivxk5xs2cx9b6v2av9"))))
"0q42m8ab7b6bxhns494ksjdss5f3c5m2jjfdlfj6fk1nz7ax7i5p"))))
(build-system r-build-system)
(home-page "https://www.stat.umn.edu/geyer/mcmc/")
(synopsis "Markov chain Monte Carlo")
@ -15040,14 +15071,14 @@ extends the lme4 package.")
(define-public r-batchtools
(package
(name "r-batchtools")
(version "0.9.12")
(version "0.9.13")
(source
(origin
(method url-fetch)
(uri (cran-uri "batchtools" version))
(sha256
(base32
"16x524hvy9d8p7r4fi1c8mixcvzgsjbf3y0vxaa56ssbbab4p7f9"))))
"02bwfinwgn5nl638997javig61jmr0ci0qybmprz13jnvmam1yns"))))
(build-system r-build-system)
(propagated-inputs
`(("r-backports" ,r-backports)
@ -15062,6 +15093,8 @@ extends the lme4 package.")
("r-rappdirs" ,r-rappdirs)
("r-stringi" ,r-stringi)
("r-withr" ,r-withr)))
(native-inputs
`(("r-knitr" ,r-knitr)))
(home-page "https://github.com/mllg/batchtools")
(synopsis "Tools for computation on batch systems")
(description
@ -15322,20 +15355,22 @@ the current document.")
(define-public r-xgboost
(package
(name "r-xgboost")
(version "0.90.0.2")
(version "1.0.0.1")
(source
(origin
(method url-fetch)
(uri (cran-uri "xgboost" version))
(sha256
(base32
"1gy9rzg43mjpfis893vf15drmbigfn0481zrzss9ajnmnk0q8194"))))
"0fx5qjpjjirzhplddqmxlysyqszp79w74x00b5shp6p2lzy6yd9a"))))
(build-system r-build-system)
(propagated-inputs
`(("r-data-table" ,r-data-table)
("r-magrittr" ,r-magrittr)
("r-matrix" ,r-matrix)
("r-stringi" ,r-stringi)))
(native-inputs
`(("r-knitr" ,r-knitr)))
(home-page "https://github.com/dmlc/xgboost")
(synopsis "Extreme gradient boosting")
(description
@ -15561,35 +15596,31 @@ guaranteeing well-connected communities.\" <arXiv:1810.08473>.")
(license license:gpl3)))
(define-public r-patchwork
;; There has been no public release yet.
(let ((commit "fd7958bae3e7a1e30237c751952e412a0a1d1242")
(revision "1"))
(package
(name "r-patchwork")
(version (git-version "0.0.1" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/thomasp85/patchwork.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"00fq520xwy1ysg4k8x48x9b0yy9wyi8y8zj6dvxjg4bwx0yyp6s4"))))
(build-system r-build-system)
(propagated-inputs
`(("r-ggplot2" ,r-ggplot2)
("r-gtable" ,r-gtable)))
(home-page "https://github.com/thomasp85/patchwork")
(synopsis "Compose ggplot2 plots")
(description
"The @code{ggplot2} package provides a strong API for sequentially
(package
(name "r-patchwork")
(version "1.0.0")
(source
(origin
(method url-fetch)
(uri (cran-uri "patchwork" version))
(sha256
(base32
"0qrwbcswh7ylrmghi17k6wk7w51cz6mcmvcyyd41hy3m2ywmkywb"))))
(build-system r-build-system)
(propagated-inputs
`(("r-ggplot2" ,r-ggplot2)
("r-gtable" ,r-gtable)))
(native-inputs
`(("r-knitr" ,r-knitr)))
(home-page "https://github.com/thomasp85/patchwork")
(synopsis "Compose ggplot2 plots")
(description
"The @code{ggplot2} package provides a strong API for sequentially
building up a plot, but does not concern itself with composition of multiple
plots. Patchwork is a package that expands the API to allow for arbitrarily
complex composition of plots by providing mathmatical operators for combining
multiple plots.")
(license license:expat))))
(license license:expat)))
(define-public r-liger
(package
@ -15666,43 +15697,47 @@ dataset-specific factors.")
(license license:gpl3)))
(define-public r-harmony
;; There are no tagged commits
(let ((commit "4d1653870d4dd70fff1807c182882db1fbf9af5a")
(revision "1"))
(package
(name "r-harmony")
(version (git-version "1.0" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/immunogenomics/harmony")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"1gasdldr4aalr9h2q9kmm3y4i7azkgnhdn4bmvsszs7lg9xacw85"))))
(build-system r-build-system)
(propagated-inputs
`(("r-cowplot" ,r-cowplot)
("r-dplyr" ,r-dplyr)
("r-ggplot2" ,r-ggplot2)
("r-irlba" ,r-irlba)
("r-matrix" ,r-matrix)
("r-rcpp" ,r-rcpp)
("r-rcpparmadillo" ,r-rcpparmadillo)
("r-rcppprogress" ,r-rcppprogress)
("r-rlang" ,r-rlang)
("r-tibble" ,r-tibble)
("r-tidyr" ,r-tidyr)))
(home-page "https://github.com/immunogenomics/harmony")
(synopsis "Integration of single cell sequencing data")
(description
"This package provides an implementation of the Harmony algorithm for
(package
(name "r-harmony")
(version "0.1")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/immunogenomics/harmony")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"05r401q09rbr6fqhb9mbd95082cjdi3nag1cv6zn96xkr0f6imq9"))
(modules '((guix build utils)))
(snippet
'(begin
(for-each delete-file '("config.status" "configure"))
#t))))
(build-system r-build-system)
(propagated-inputs
`(("r-cowplot" ,r-cowplot)
("r-dplyr" ,r-dplyr)
("r-ggplot2" ,r-ggplot2)
("r-irlba" ,r-irlba)
("r-matrix" ,r-matrix)
("r-rcpp" ,r-rcpp)
("r-rcpparmadillo" ,r-rcpparmadillo)
("r-rcppprogress" ,r-rcppprogress)
("r-rlang" ,r-rlang)
("r-tibble" ,r-tibble)
("r-tidyr" ,r-tidyr)))
(native-inputs
`(("autoconf" ,autoconf)))
(home-page "https://github.com/immunogenomics/harmony")
(synopsis "Integration of single cell sequencing data")
(description
"This package provides an implementation of the Harmony algorithm for
single cell integration, described in Korsunsky et al
@url{doi.org/10.1101/461954}. The package includes a standalone Harmony
function and interfaces to external frameworks.")
(license license:gpl3))))
(license license:gpl3)))
(define-public r-covr
(package
@ -18389,14 +18424,14 @@ it may be seen by an animal with less acute vision.")
(define-public r-caret
(package
(name "r-caret")
(version "6.0-85")
(version "6.0-86")
(source
(origin
(method url-fetch)
(uri (cran-uri "caret" version))
(sha256
(base32
"0jxbf2zcvbb5s2pnjzg182awjvylc57q7z5plx6gs6gm62zxjafs"))))
"0dyflixdw98lvk2x3w136sw24ij0fwx5c7l709dmqr5z7xy1qjns"))))
(build-system r-build-system)
(propagated-inputs
`(("r-foreach" ,r-foreach)
@ -18409,6 +18444,8 @@ it may be seen by an animal with less acute vision.")
("r-recipes" ,r-recipes)
("r-reshape2" ,r-reshape2)
("r-withr" ,r-withr)))
(native-inputs
`(("r-knitr" ,r-knitr)))
(home-page "https://github.com/topepo/caret")
(synopsis "Classification and regression training")
(description
@ -20910,3 +20947,73 @@ service. Functions are provided to work with the OAI-PMH verbs:
@code{GetRecord}, @code{Identify}, @code{ListIdentifiers},
@code{ListMetadataFormats}, @code{ListRecords}, and @code{ListSets}.")
(license license:expat)))
(define-public r-argon2
(package
(name "r-argon2")
(version "0.2-0")
(source
(origin
(method url-fetch)
(uri (cran-uri "argon2" version))
(sha256
(base32
"0kqn06rpb39jlzizjlnc5c44mfic8llrshxn7ljgmyj35lbqwxqh"))))
(properties `((upstream-name . "argon2")))
(build-system r-build-system)
(home-page "https://github.com/wrathematics/argon2")
(synopsis "Secure password hashing based on the argon2 algorithm")
(description
"This package provides utilities for secure password hashing via the
argon2 algorithm.")
(license license:bsd-2)))
(define-public r-getpass
(package
(name "r-getpass")
(version "0.2-2")
(source
(origin
(method url-fetch)
(uri (cran-uri "getPass" version))
(sha256
(base32
"03ydafhh0sk3rcnpr3paajyji64x2ddp6p814p9mvbmyrblcgzcc"))))
(properties `((upstream-name . "getPass")))
(build-system r-build-system)
(propagated-inputs
`(("r-rstudioapi" ,r-rstudioapi)))
(home-page "https://github.com/wrathematics/getPass")
(synopsis "Masked user input")
(description
"This package provides a micro-package for reading \"passwords\", i.e.
reading user input with masking, so that the input is not displayed as it is
typed. Currently, RStudio, the command line (every OS), and any platform
where tcltk is present are supported.")
(license license:bsd-2)))
(define-public r-remoter
(package
(name "r-remoter")
(version "0.4-0")
(source
(origin
(method url-fetch)
(uri (cran-uri "remoter" version))
(sha256
(base32
"1a7m63l8phv5jnazvdqdrqkaqjwqzaac5y4jm2jn0ypy4n8jvkfl"))))
(properties `((upstream-name . "remoter")))
(build-system r-build-system)
(propagated-inputs
`(("r-argon2" ,r-argon2)
("r-getpass" ,r-getpass)
("r-pbdzmq" ,r-pbdzmq)
("r-png" ,r-png)))
(home-page "https://github.com/RBigData/remoter")
(synopsis "Control a remote R session from a local one")
(description
"This package provides a set of utilities for client/server computing
with R, controlling a remote R session (the server) from a local one (the
client).")
(license license:bsd-2)))

7
gnu/packages/databases.scm
View File

@ -40,6 +40,7 @@
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2020 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2020 Nicolò Balzarotti <nicolo@nixo.xyz>
;;; Copyright © 2020 Tanguy Le Carrour <tanguy@bioneland.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -2873,18 +2874,20 @@ parsing code in hiredis. It primarily speeds up parsing of multi bulk replies."
(define-public python-fakeredis
(package
(name "python-fakeredis")
(version "0.8.2")
(version "1.2.1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "fakeredis" version))
(sha256
(base32
"0zncahj3byyasyfx9i7k991ph0n0lq8v3a21pqri5qxn9564bk9r"))))
"1s12mn4q4hz7402139khn9fx56kibj7nn0d6w81hn0zs07b90wpc"))))
(build-system python-build-system)
(arguments
;; no tests
`(#:tests? #f))
(propagated-inputs
`(("python-sortedcontainers" ,python-sortedcontainers)))
(home-page "https://github.com/jamesls/fakeredis")
(synopsis "Fake implementation of redis API for testing purposes")
(description

236
gnu/packages/debug.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2019 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018, 2019 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2019 Pkill -9 <pkill9@runbox.com>
@ -22,22 +22,29 @@
(define-module (gnu packages debug)
#:use-module (guix packages)
#:use-module (guix licenses)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix utils)
#:use-module (guix build-system gnu)
#:use-module (guix build-system cmake)
#:use-module (gnu packages)
#:use-module (gnu packages attr)
#:use-module (gnu packages autotools)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages bison)
#:use-module (gnu packages code)
#:use-module (gnu packages compression)
#:use-module (gnu packages flex)
#:use-module (gnu packages gdb)
#:use-module (gnu packages glib)
#:use-module (gnu packages gtk)
#:use-module (gnu packages golang)
#:use-module (gnu packages image)
#:use-module (gnu packages linux)
#:use-module (gnu packages llvm)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages ninja)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
@ -47,6 +54,7 @@
#:use-module (gnu packages readline)
#:use-module (gnu packages serialization)
#:use-module (gnu packages virtualization)
#:use-module (gnu packages xdisorg)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1))
@ -96,7 +104,7 @@ isolate a small failure-inducing substring of a large input that causes your
program to exhibit a bug.")
;; See License.txt, which is a bsd-3 license, despite the project's
;; home-page pointing to a bsd-2 license.
(license bsd-3)))
(license license:bsd-3)))
(define-public c-reduce
(package
@ -156,7 +164,7 @@ property of interest (such as triggering a compiler bug) and automatically
produces a much smaller C/C++ program that has the same property. It is
intended for use by people who discover and report bugs in compilers and other
tools that process C/C++ code.")
(license ncsa)))
(license license:ncsa)))
(define-public american-fuzzy-lop
(let ((machine (match (or (%current-target-system)
@ -183,61 +191,7 @@ tools that process C/C++ code.")
(file-name (git-file-name name version))))
(build-system gnu-build-system)
(inputs
`(("custom-qemu"
;; The afl-qemu tool builds qemu 2.10.0 with a few patches applied.
,(package (inherit qemu-minimal-2.10)
(name "afl-qemu")
(inputs
`(("afl-src" ,source)
,@(package-inputs qemu-minimal)))
;; afl only supports using a single afl-qemu-trace executable, so
;; we only build qemu for the native target.
(arguments
`(#:modules ((srfi srfi-1)
,@%gnu-build-system-modules)
,@(substitute-keyword-arguments (package-arguments qemu-minimal)
((#:configure-flags config-flags)
``(,(string-append "--target-list=" ,machine "-linux-user")
,@(remove (λ (f) (string-prefix? "--target-list=" f))
,config-flags)))
((#:phases qemu-phases)
`(modify-phases ,qemu-phases
(add-after
'unpack 'apply-afl-patches
(lambda* (#:key inputs #:allow-other-keys)
(let* ((afl-src (assoc-ref inputs "afl-src"))
(patch-dir "qemu_mode/patches"))
(copy-recursively (string-append afl-src "/"
patch-dir)
patch-dir)
(install-file
(string-append patch-dir
"/afl-qemu-cpu-inl.h")
".")
(copy-file (string-append afl-src "/config.h")
"./afl-config.h")
(install-file (string-append afl-src "/types.h")
".")
(substitute* "afl-qemu-cpu-inl.h"
(("\\.\\./\\.\\./config.h") "afl-config.h"))
(substitute* (string-append patch-dir
"/cpu-exec.diff")
(("\\.\\./patches/") ""))
;; These were already applied to qemu-minimal-2.10.
(for-each (lambda (obsolete-patch)
(delete-file (string-append
patch-dir "/"
obsolete-patch)))
(list "configure.diff"
"memfd.diff"))
(for-each (lambda (patch-file)
(invoke "patch" "--force" "-p1"
"--input" patch-file))
(find-files patch-dir
"\\.diff$"))
#t))))))))))))
`(("qemu" ,qemu-for-american-fuzzy-lop)))
(arguments
`(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
(string-append "DOC_PATH=$(PREFIX)/share/doc/"
@ -267,7 +221,7 @@ tools that process C/C++ code.")
;; TODO: Build and install the afl-llvm tool.
'install 'install-qemu
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((qemu (assoc-ref inputs "custom-qemu"))
(let ((qemu (assoc-ref inputs "qemu"))
(out (assoc-ref outputs "out")))
(symlink (string-append qemu "/bin/qemu-" ,machine)
(string-append out "/bin/afl-qemu-trace"))
@ -283,7 +237,157 @@ targeted binary. This substantially improves the functional coverage for the
fuzzed code. The compact synthesized corpora produced by the tool are also
useful for seeding other, more labor- or resource-intensive testing regimes
down the road.")
(license asl2.0))))
(license license:asl2.0))))
(define-public qemu-for-american-fuzzy-lop
;; afl only supports using a single afl-qemu-trace executable, so
;; we only build qemu for the native target.
(let ((machine (match (or (%current-target-system)
(%current-system))
("x86_64-linux" "x86_64")
("i686-linux" "i386")
("aarch64-linux" "aarch64")
("armhf-linux" "arm")
("mips64el-linux" "mips64el")
;; Prevent errors when querying this package on unsupported
;; platforms, e.g. when running "guix package --search="
(_ "UNSUPPORTED"))))
(hidden-package
(package
(name "qemu")
(version "2.10.2")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qemu.org/qemu-"
version ".tar.xz"))
(sha256
(base32
"17w21spvaxaidi2am5lpsln8yjpyp2zi3s3gc6nsxj5arlgamzgw"))
(patches
(search-patches "qemu-glibc-2.27.patch"))))
(build-system gnu-build-system)
(arguments
`(;; Running tests in parallel can occasionally lead to failures, like:
;; boot_sector_test: assertion failed (signature == SIGNATURE): (0x00000000 == 0x0000dead)
#:parallel-tests? #f
#:configure-flags
(list (string-append "--target-list=" ,machine "-linux-user"))
#:make-flags '("V=1")
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key inputs outputs (configure-flags '())
#:allow-other-keys)
;; The `configure' script doesn't understand some of the
;; GNU options. Thus, add a new phase that's compatible.
(let ((out (assoc-ref outputs "out")))
(setenv "SHELL" (which "bash"))
;; While we're at it, patch for tests.
(substitute* "tests/libqtest.c"
(("/bin/sh") (which "sh")))
;; The binaries need to be linked against -lrt.
(setenv "LDFLAGS" "-lrt")
(apply invoke
`("./configure"
,(string-append "--cc=" (which "gcc"))
;; Some architectures insist on using HOST_CC
,(string-append "--host-cc=" (which "gcc"))
"--disable-debug-info" ; save build space
"--enable-virtfs" ; just to be sure
,(string-append "--prefix=" out)
,(string-append "--sysconfdir=/etc")
,@configure-flags)))))
(add-after
'unpack 'apply-afl-patches
(lambda* (#:key inputs #:allow-other-keys)
(let* ((afl-src (assoc-ref inputs "afl-source"))
(patch-dir "qemu_mode/patches"))
(copy-recursively (string-append afl-src "/"
patch-dir)
patch-dir)
(install-file
(string-append patch-dir
"/afl-qemu-cpu-inl.h")
".")
(copy-file (string-append afl-src "/config.h")
"./afl-config.h")
(install-file (string-append afl-src "/types.h")
".")
(substitute* "afl-qemu-cpu-inl.h"
(("\\.\\./\\.\\./config.h") "afl-config.h"))
(substitute* (string-append patch-dir
"/cpu-exec.diff")
(("\\.\\./patches/") ""))
;; These were already applied to qemu-minimal-2.10.
(for-each (lambda (obsolete-patch)
(delete-file (string-append
patch-dir "/"
obsolete-patch)))
(list "configure.diff"
"memfd.diff"))
(for-each (lambda (patch-file)
(invoke "patch" "--force" "-p1"
"--input" patch-file))
(find-files patch-dir
"\\.diff$"))
#t)))
(add-before 'check 'disable-unusable-tests
(lambda* (#:key inputs outputs #:allow-other-keys)
(substitute* "tests/Makefile.include"
;; Comment out the test-qga test, which needs /sys and
;; fails within the build environment.
(("check-unit-.* tests/test-qga" all)
(string-append "# " all)))
(substitute* "tests/Makefile.include"
;; Comment out the test-char test, which needs networking and
;; fails within the build environment.
(("check-unit-.* tests/test-char" all)
(string-append "# " all)))
#t)))))
(native-inputs
`(("python-2" ,python-2) ; QEMU 2 needs Python 2
("glib:bin" ,glib "bin")
("perl" ,perl)
("flex" ,flex)
("bison" ,bison)
("pkg-config" ,pkg-config)))
(inputs
`(("afl-source" ,(package-source american-fuzzy-lop))
("alsa-lib" ,alsa-lib)
("attr" ,attr)
("glib" ,glib)
("libaio" ,libaio)
("libattr" ,attr)
("libcap" ,libcap)
("libjpeg" ,libjpeg-turbo)
("libpng" ,libpng)
("ncurses" ,ncurses)
("pixman" ,pixman)
("util-linux" ,util-linux)
("zlib" ,zlib)))
(home-page "https://www.qemu.org")
(synopsis "Machine emulator and virtualizer (without GUI) for american fuzzy lop")
(description
"QEMU is a generic machine emulator and virtualizer. This package
of QEMU is used only by the american fuzzy lop package.
When used as a machine emulator, QEMU can run OSes and programs made for one
machine (e.g. an ARM board) on a different machine---e.g., your own PC. By
using dynamic translation, it achieves very good performance.
When used as a virtualizer, QEMU achieves near native performances by
executing the guest code directly on the host CPU. QEMU supports
virtualization when executing under the Xen hypervisor or using
the KVM kernel module in Linux. When using KVM, QEMU can virtualize x86,
server and embedded PowerPC, and S390 guests.")
;; Many files are GPLv2+, but some are GPLv2-only---e.g., `memory.c'.
(license license:gpl2)
;; Several tests fail on MIPS.
(supported-systems (delete "mips64el-linux" %supported-systems))))))
(define-public stress-make
(let ((commit "9e92dff8f0157f012aaf31de5b8b8112ad720100")
@ -346,8 +450,8 @@ Stress Make, then it is likely that the @code{Makefile} contains no race
conditions.")
;; stress-make wrapper is under BSD-3-modifications-must-be-indicated,
;; and patched GNU Make is under its own license.
(license (list (non-copyleft "LICENSE.md")
gpl3+)))))
(license (list (license:non-copyleft "LICENSE.md")
license:gpl3+)))))
(define-public zzuf
(package
@ -369,7 +473,7 @@ conditions.")
(description "Zzuf is a transparent application input fuzzer. It works by
intercepting file operations and changing random bits in the program's
input. Zzuf's behaviour is deterministic, making it easy to reproduce bugs.")
(license (non-copyleft "http://www.wtfpl.net/txt/copying/"))))
(license license:wtfpl2)))
(define-public scanmem
(package
@ -427,7 +531,7 @@ several different times. After several scans of the process, scanmem isolates
the position of the variable and allows you to modify its value.")
;; The library is covered by LGPLv3 or later; the application is covered
;; by GPLv3 or later.
(license (list lgpl3+ gpl3+))))
(license (list license:lgpl3+ license:gpl3+))))
(define-public rr
(package
@ -490,4 +594,4 @@ execution of applications (trees of processes and threads). Debugging extends
GDB with very efficient reverse-execution, which in combination with standard
GDB/x86 features like hardware data watchpoints, makes debugging much more
fun.")
(license expat)))
(license license:expat)))

9
gnu/packages/distributed.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Brant Gardner <brantcgardner@brantware.com>
;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -43,7 +44,7 @@
(define-public boinc-client
(package
(name "boinc-client")
(version "7.16.4")
(version "7.16.5")
(source (origin
(method git-fetch)
(uri (git-reference
@ -54,7 +55,7 @@
(file-name (git-file-name "boinc" version))
(sha256
(base32
"08xx2kzb7c46k1zb91w74kyig3b5kilxdw5ilfs67r8p55mxk0g1"))))
"107rpw9qd5x4pyxm9jd1lqxva5nxwb01dm5h61d6msv2vgiy0r8n"))))
(build-system gnu-build-system)
(arguments '(#:configure-flags '("--disable-server")))
(inputs `(("openssl" ,openssl)
@ -88,9 +89,9 @@ resources). It supports virtualized, parallel, and GPU-based applications.")
#:tests? #f)) ; FIXME: Looks like bad test syntax in the
; source package, 2 tests fail. Disable for
; now.
(inputs `(("openssl" ,openssl)
(inputs `(("openssl" ,openssl-1.0)
("curl" ,curl)
("mariadb" ,mariadb)
("mariadb:dev" ,mariadb "dev")
("zlib" ,zlib)))
(propagated-inputs `(("python" ,python-wrapper)
("perl" ,perl)))))

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

@ -124,6 +124,7 @@
#:use-module (gnu packages image)
#:use-module (gnu packages linux)
#:use-module (gnu packages libevent)
#:use-module (gnu packages lua)
#:use-module (gnu packages music)
#:use-module (gnu packages version-control)
#:use-module (gnu packages imagemagick)
@ -1727,6 +1728,39 @@ searches. Unlike code@{emacs-wiki.el}, it can be combined with any format.")
Emacs buffer.")
(license license:gpl3+)))
(define-public emacs-chronometrist
(package
(name "emacs-chronometrist")
(version "0.4.2")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://framagit.org/contrapunctus/chronometrist.git")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32 "1ccy7qz1wcmggqlf3hwigbqq4wrx1amds4x9bxz9py6bypglyjc5"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-dash" ,emacs-dash)
("emacs-s" ,emacs-s)))
(home-page "https://framagit.org/contrapunctus/chronometrist")
(synopsis "Time tracker for Emacs")
(description "Chronometrist is a time tracker in Emacs, largely modelled
after the Android application, @emph{A Time Tracker}.
Its features are:
@itemize
@item Simple and efficient to use,
@item Displays useful information about your time usage,
@item Support for both mouse and keyboard,
@item Human errors in tracking are easily fixed by editing a plain text file,
@item Hooks to let you perform arbitrary actions when starting/stopping tasks.
@end itemize")
;; Software is dual-licensed.
(license (list license:unlicense license:wtfpl2))))
(define-public emacs-direnv
(package
(name "emacs-direnv")
@ -2059,7 +2093,7 @@ and stored in memory.")
(define-public emacs-dash
(package
(name "emacs-dash")
(version "2.16.0")
(version "2.17.0")
(source (origin
(method git-fetch)
(uri (git-reference
@ -2068,7 +2102,7 @@ and stored in memory.")
(file-name (git-file-name name version))
(sha256
(base32
"150k48llqz2mb66vbznpyj47r6g16amfl7hbg8q46djq8mp7zc2v"))))
"153f55dqkhs8w2xlf6b88wp5vlkap7h8vjd9wxh4jp2ram5g4l1n"))))
(build-system emacs-build-system)
(arguments
`(#:tests? #t
@ -6690,7 +6724,7 @@ indentation guides in Emacs:
(define-public emacs-elpy
(package
(name "emacs-elpy")
(version "1.31.0")
(version "1.32.0")
(source (origin
(method git-fetch)
(uri (git-reference
@ -6699,20 +6733,20 @@ indentation guides in Emacs:
(file-name (git-file-name name version))
(sha256
(base32
"0bvmgqs3c80bhs9v5ymgadv7vk4iamha10y7rl09pixmjm4mzagk"))))
"0f00mdnzx6xqwni86rgvaa6sfkwyh62xfbwz8qsar15j0j6vc2dj"))))
(build-system emacs-build-system)
(arguments
`(#:include (cons* "^elpy/[^/]+\\.py$" "^snippets\\/" %default-include)
#:phases
;; TODO: Make `elpy-config' display Guix commands :)
(modify-phases %standard-phases
;; One elpy test depends on being run inside a Python virtual
;; environment to pass. We have nothing to gain from doing so here,
;; so we just trick Elpy into thinking we are (see:
;; https://github.com/jorgenschaefer/elpy/pull/1293).
(add-before 'check 'fake-virtualenv
;; The default environment of the RPC uses Virtualenv to install
;; Python dependencies from PyPI. We don't want/need this in Guix.
(add-before 'check 'do-not-use-virtualenv
(lambda _
(setenv "VIRTUAL_ENV" "/tmp")
(setenv "ELPY_TEST_DONT_USE_VIRTUALENV" "1")
(substitute* "elpy-rpc.el"
(("defcustom elpy-rpc-virtualenv-path 'default")
"defcustom elpy-rpc-virtualenv-path 'system"))
#t))
(add-before 'check 'build-doc
(lambda _
@ -6738,16 +6772,20 @@ indentation guides in Emacs:
("emacs-highlight-indentation" ,emacs-highlight-indentation)
("emacs-yasnippet" ,emacs-yasnippet)
("pyvenv" ,emacs-pyvenv)
("s" ,emacs-s)))
(native-inputs
`(("ert-runner" ,emacs-ert-runner)
("emacs-f" ,emacs-f)
("python" ,python-wrapper)
("s" ,emacs-s)
;; The following are recommended Python dependencies that make Elpy
;; much more useful. Installing these avoids Elpy prompting to install them
;; from PyPI using pip.
("python-autopep8" ,python-autopep8)
("python-black" ,python-black)
("python-flake8" ,python-flake8)
("python-jedi" ,python-jedi)
("python-yapf" ,python-yapf)
("python-rope" ,python-rope)
("python-yapf" ,python-yapf)))
(native-inputs
`(("ert-runner" ,emacs-ert-runner)
("emacs-f" ,emacs-f)
("python" ,python-wrapper)
;; For documentation.
("python-sphinx" ,python-sphinx)
("texinfo" ,texinfo)))
@ -7539,11 +7577,11 @@ using package inferred style.")
(license license:gpl3+))))
(define-public emacs-lua-mode
(let ((commit "95c64bb5634035630e8c59d10d4a1d1003265743")
(revision "2"))
(let ((commit "1f596a93b3f1caadd7bba01030f8c179b029600b")
(revision "1"))
(package
(name "emacs-lua-mode")
(version (git-version "20151025" revision commit))
(version (git-version "20191204" revision commit))
(home-page "https://github.com/immerrr/lua-mode/")
(source (origin
(method git-fetch)
@ -7553,8 +7591,14 @@ using package inferred style.")
(file-name (git-file-name name version))
(sha256
(base32
"1mra4db25ds64526dsj8m5yv0kfq3lgggjh1x6xmqypdaryddbcp"))))
"0i4adlaik3qjx1wkb7rwk2clvj7ci2g8pm0siyb3yk90r6z5mspi"))))
(build-system emacs-build-system)
(arguments
`(#:tests? #t
#:test-command '("buttercup" "-l" "lua-mode.el")))
(native-inputs
`(("emacs-buttercup" ,emacs-buttercup)
("lua" ,lua)))
(synopsis "Major mode for lua")
(description
"This Emacs package provides a mode for @uref{https://www.lua.org/,
@ -9962,57 +10006,54 @@ Emacs.")
;; Tests for ert-runner have a circular dependency with ecukes, and therefore
;; cannot be run
(define-public emacs-ert-runner
(let ((version "0.7.0")
(revision "1")
(commit "90b8fdd5970ef76a4649be60003b37f82cdc1a65"))
(package
(name "emacs-ert-runner")
(version (git-version "0.7.0" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/rejeep/ert-runner.el.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"04nxmyzncacj2wmzd84vv9wkkr2dk9lcb10dvygqmg3p1gadnwzz"))))
(build-system emacs-build-system)
(inputs
`(("emacs-ansi" ,emacs-ansi)
("emacs-commander" ,emacs-commander)
("emacs-dash" ,emacs-dash)
("emacs-f" ,emacs-f)
("emacs-s" ,emacs-s)
("emacs-shut-up" ,emacs-shut-up)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'install 'install-executable
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(source-directory (string-append
(getenv "TMPDIR") "/source")))
(substitute* "bin/ert-runner"
(("ERT_RUNNER=\"\\$\\(dirname \\$\\(dirname \\$0\\)\\)")
(string-append "ERT_RUNNER=\"" out
"/share/emacs/site-lisp")))
(install-file "bin/ert-runner" (string-append out "/bin"))
(wrap-program (string-append out "/bin/ert-runner")
(list "EMACSLOADPATH" ":" 'prefix
;; Do not capture the transient source directory in
;; the wrapper.
(delete source-directory
(string-split (getenv "EMACSLOADPATH") #\:))))
#t))))
#:include (cons* "^reporters/.*\\.el$" %default-include)))
(home-page "https://github.com/rejeep/ert-runner.el")
(synopsis "Opinionated Ert testing workflow")
(description "@code{ert-runner} is a tool for Emacs projects tested
(package
(name "emacs-ert-runner")
(version "0.8.0")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/rejeep/ert-runner.el.git")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"08gygn9fjank5gpi4v6ynrkn0jbknxbwsn7md4p9ndygdbmnkf98"))))
(build-system emacs-build-system)
(inputs
`(("emacs-ansi" ,emacs-ansi)
("emacs-commander" ,emacs-commander)
("emacs-dash" ,emacs-dash)
("emacs-f" ,emacs-f)
("emacs-s" ,emacs-s)
("emacs-shut-up" ,emacs-shut-up)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'install 'install-executable
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(source-directory (string-append
(getenv "TMPDIR") "/source")))
(substitute* "bin/ert-runner"
(("ERT_RUNNER=\"\\$\\(dirname \\$\\(dirname \\$0\\)\\)")
(string-append "ERT_RUNNER=\"" out
"/share/emacs/site-lisp")))
(install-file "bin/ert-runner" (string-append out "/bin"))
(wrap-program (string-append out "/bin/ert-runner")
(list "EMACSLOADPATH" ":" 'prefix
;; Do not capture the transient source directory in
;; the wrapper.
(delete source-directory
(string-split (getenv "EMACSLOADPATH") #\:))))
#t))))
#:include (cons* "^reporters/.*\\.el$" %default-include)))
(home-page "https://github.com/rejeep/ert-runner.el")
(synopsis "Opinionated Ert testing workflow")
(description "@code{ert-runner} is a tool for Emacs projects tested
using ERT. It assumes a certain test structure setup and can therefore make
running tests easier.")
(license license:gpl3+))))
(license license:gpl3+)))
(define-public ert-runner
(deprecated-package "ert-runner" emacs-ert-runner))
@ -15582,32 +15623,31 @@ from @code{emms-source-file-default-directory}.")
(license license:gpl3+))))
(define-public emacs-helm-exwm
(let ((commit "56266f261ba3b3d2753b374b50da20eb768c06f5"))
(package
(name "emacs-helm-exwm")
(version (git-version "20180703" "2" commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/emacs-helm/helm-exwm.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32 "064ziinqa5sdv7rfjn0y278l12kld176fr88k4h78pgf2f2n7cd8"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-helm" ,emacs-helm)
("emacs-exwm" ,emacs-exwm)))
(home-page
"https://github.com/emacs-helm/helm-exwm")
(synopsis "Helm for EXWM buffers")
(description
"@code{helm-exwm} runs a Helm session over the list of EXWM buffers.
(package
(name "emacs-helm-exwm")
(version "0.0.2")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/emacs-helm/helm-exwm.git")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32 "0g4k01ps14bp2az8v6dcag9llg045k2b4kdis81xx4lvw76znr9v"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-helm" ,emacs-helm)
("emacs-exwm" ,emacs-exwm)))
(home-page
"https://github.com/emacs-helm/helm-exwm")
(synopsis "Helm for EXWM buffers")
(description
"@code{helm-exwm} runs a Helm session over the list of EXWM buffers.
@code{helm-exwm-switch} is a convenience X application launcher using Helm to
switch between the various windows of one or several specific applications.
See @code{helm-exwm-switch-browser} for an example.")
(license license:gpl3+))))
(license license:gpl3+)))
(define-public emacs-helm-flycheck
(let ((commit "3cf7d3bb194acacc6395f88360588013d92675d6"))

161
gnu/packages/emacs.scm
View File

@ -9,7 +9,7 @@
;;; Copyright © 2016 David Thompson <dthompson2@worcester.edu>
;;; Copyright © 2016 ng0 <ng0@n0.is>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017, 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2017, 2019, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2017 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
@ -76,66 +76,71 @@
(name "emacs")
(version "26.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/emacs/emacs-"
version ".tar.xz"))
(sha256
(base32
"119ldpk7sgn9jlpyngv5y4z3i7bb8q3xp4p0qqi7i5nq39syd42d"))
(patches (search-patches "emacs-exec-path.patch"
"emacs-fix-scheme-indent-function.patch"
"emacs-source-date-epoch.patch"))
(modules '((guix build utils)))
(snippet
'(with-directory-excursion "lisp"
;; Delete the bundled byte-compiled elisp files and generated
;; autoloads.
(for-each delete-file
(append (find-files "." "\\.elc$")
(find-files "." "loaddefs\\.el$")
;; This is the only "autoloads" file that
;; does not have "*loaddefs.el" name.
;; TODO: Next time changing this package,
;; replace the following with a call to
;; `find-files', so that `delete-file'
;; wouldn't error out when the file is
;; missing, making the entire snippet field
;; reusable as-is for `emacs-next' below.
'("eshell/esh-groups.el")))
(method url-fetch)
(uri (string-append "mirror://gnu/emacs/emacs-"
version ".tar.xz"))
(sha256
(base32
"119ldpk7sgn9jlpyngv5y4z3i7bb8q3xp4p0qqi7i5nq39syd42d"))
(patches (search-patches "emacs-exec-path.patch"
"emacs-fix-scheme-indent-function.patch"
"emacs-source-date-epoch.patch"))
(modules '((guix build utils)))
(snippet
'(with-directory-excursion "lisp"
;; Delete the bundled byte-compiled elisp files and generated
;; autoloads.
(for-each delete-file
(append (find-files "." "\\.elc$")
(find-files "." "loaddefs\\.el$")
;; This is the only "autoloads" file that
;; does not have "*loaddefs.el" name.
;; TODO: Next time changing this package,
;; replace the following with a call to
;; `find-files', so that `delete-file'
;; wouldn't error out when the file is
;; missing, making the entire snippet field
;; reusable as-is for `emacs-next' below.
'("eshell/esh-groups.el")))
;; Make sure Tramp looks for binaries in the right places on
;; remote Guix System machines, where 'getconf PATH' returns
;; something bogus.
(substitute* "net/tramp-sh.el"
;; Patch the line after "(defcustom tramp-remote-path".
(("\\(tramp-default-remote-path")
(format #f "(tramp-default-remote-path ~s ~s ~s ~s "
"~/.guix-profile/bin" "~/.guix-profile/sbin"
"/run/current-system/profile/bin"
"/run/current-system/profile/sbin")))
;; Make sure Tramp looks for binaries in the right places on
;; remote Guix System machines, where 'getconf PATH' returns
;; something bogus.
(substitute* "net/tramp-sh.el"
;; Patch the line after "(defcustom tramp-remote-path".
(("\\(tramp-default-remote-path")
(format #f "(tramp-default-remote-path ~s ~s ~s ~s "
"~/.guix-profile/bin" "~/.guix-profile/sbin"
"/run/current-system/profile/bin"
"/run/current-system/profile/sbin")))
;; Make sure Man looks for C header files in the right
;; places.
(substitute* "man.el"
(("\"/usr/local/include\"" line)
(string-join
(list line
"\"~/.guix-profile/include\""
"\"/var/guix/profiles/system/profile/include\"")
" ")))
#t))))
;; Make sure Man looks for C header files in the right
;; places.
(substitute* "man.el"
(("\"/usr/local/include\"" line)
(string-join
(list line
"\"~/.guix-profile/include\""
"\"/var/guix/profiles/system/profile/include\"")
" ")))
#t))))
(build-system glib-or-gtk-build-system)
(arguments
`(#:tests? #f ; no check target
#:configure-flags (list "--with-modules"
"--disable-build-details")
#:modules ((guix build emacs-utils)
(guix build glib-or-gtk-build-system)
(guix build utils))
#:imported-modules ((guix build emacs-utils)
,@%glib-or-gtk-build-system-modules)
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-program-file-names
(lambda _
(substitute* '("src/callproc.c"
"lisp/term.el"
"lisp/htmlfontify.el"
"lisp/textmodes/artist.el"
"lisp/progmodes/sh-script.el")
(("\"/bin/sh\"")
(format "~s" (which "sh"))))
#t))
(add-before 'configure 'fix-/bin/pwd
(lambda _
;; Use `pwd', not `/bin/pwd'.
@ -150,6 +155,16 @@
(let* ((out (assoc-ref outputs "out"))
(lisp-dir (string-append out "/share/emacs/site-lisp"))
(emacs (string-append out "/bin/emacs")))
;; This is duplicated from emacs-utils to prevent coupling.
(define* (emacs-byte-compile-directory dir)
(let ((expr `(progn
(setq byte-compile-debug t)
(byte-recompile-directory
(file-name-as-directory ,dir) 0 1))))
(invoke emacs "--quick" "--batch"
(format "--eval=~s" expr))))
(copy-file (assoc-ref inputs "guix-emacs.el")
(string-append lisp-dir "/guix-emacs.el"))
(with-output-to-file (string-append lisp-dir "/site-start.el")
@ -163,9 +178,7 @@
;; which leads to conflicts.
(delete-file (string-append lisp-dir "/subdirs.el"))
;; Byte compile the site-start files.
(parameterize ((%emacs emacs))
(emacs-byte-compile-directory lisp-dir))
#t))))))
(emacs-byte-compile-directory lisp-dir)))))))
(inputs
`(("gnutls" ,gnutls)
("ncurses" ,ncurses)
@ -333,19 +346,11 @@ languages.")
(build-system gnu-build-system)
(arguments
(substitute-keyword-arguments (package-arguments emacs)
((#:modules _)
`((guix build emacs-utils)
,@%gnu-build-system-modules))
((#:imported-modules _)
`((guix build emacs-utils)
,@%gnu-build-system-modules))
((#:phases phases)
`(modify-phases ,phases
(delete 'install-site-start)))
((#:configure-flags flags ''())
`(list "--with-gnutls=no" "--disable-build-details"))))
(inputs
`(("ncurses" ,ncurses)))
`(("guix-emacs.el" ,(search-auxiliary-file "emacs/guix-emacs.el"))
("ncurses" ,ncurses)))
(native-inputs
`(("pkg-config" ,pkg-config)))))
@ -358,12 +363,6 @@ editor (with xwidgets support)")
(build-system gnu-build-system)
(arguments
(substitute-keyword-arguments (package-arguments emacs)
((#:modules _)
`((guix build emacs-utils)
,@%gnu-build-system-modules))
((#:imported-modules _)
`((guix build emacs-utils)
,@%gnu-build-system-modules))
((#:configure-flags flags ''())
`(cons "--with-xwidgets" ,flags))))
(inputs
@ -377,14 +376,6 @@ editor (with xwidgets support)")
(synopsis "The extensible, customizable, self-documenting text
editor (console only)")
(build-system gnu-build-system)
(arguments
(substitute-keyword-arguments (package-arguments emacs)
((#:modules _)
`((guix build emacs-utils)
,@%gnu-build-system-modules))
((#:imported-modules _)
`((guix build emacs-utils)
,@%gnu-build-system-modules))))
(inputs (fold alist-delete
(package-inputs emacs)
'("libx11" "gtk+" "libxft" "libtiff" "giflib" "libjpeg"
@ -403,15 +394,9 @@ editor (without an X toolkit)" )
(inputs (append `(("inotify-tools" ,inotify-tools))
(alist-delete "gtk+" (package-inputs emacs))))
(arguments
(substitute-keyword-arguments (package-arguments emacs)
((#:modules _)
`((guix build emacs-utils)
,@%gnu-build-system-modules))
((#:imported-modules _)
`((guix build emacs-utils)
,@%gnu-build-system-modules))
((#:configure-flags cf)
`(cons "--with-x-toolkit=no" ,cf))))))
`(,@(substitute-keyword-arguments (package-arguments emacs)
((#:configure-flags cf)
`(cons "--with-x-toolkit=no" ,cf)))))))
(define-public guile-emacs
(let ((commit "41120e0f595b16387eebfbf731fff70481de1b4b")

16
gnu/packages/engineering.scm
View File

@ -1309,14 +1309,16 @@ bindings for Python, Java, OCaml and more.")
(define-public radare2
(package
(name "radare2")
(version "3.5.1")
(version "4.2.1")
(source (origin
(method url-fetch)
(uri (string-append "https://radare.mikelloc.com/get/" version "/"
"radare2-" version ".tar.gz"))
(method git-fetch)
(uri (git-reference
(url "https://github.com/radareorg/radare2")
(commit version)))
(sha256
(base32
"174x5545fw2nyf000gd46hi7rx2bn3bw5bsnvizn9yi99pn7m4mw"))
"14b9433cgc2nabhz836zfgvgh2dwailcmvy05krsa0inmzbvx9fg"))
(file-name (git-file-name name version))
(modules '((guix build utils)))
(snippet
'(begin
@ -2136,7 +2138,7 @@ simulation.")
(define-public cutter
(package
(name "cutter")
(version "1.8.3")
(version "1.10.1")
(source
(origin
(method git-fetch)
@ -2146,7 +2148,7 @@ simulation.")
(file-name (git-file-name name version))
(sha256
(base32
"03f3cdckh51anx9gd1b0ndb2fg7061hqngvygf32ky29mm2m2lyv"))))
"1gvsrcskcdd1hxrjpkpc657anmfs25f174vxk4wzvn385rnmrxd3"))))
(build-system gnu-build-system)
(arguments
`(#:phases

57
gnu/packages/finance.scm
View File

@ -451,9 +451,8 @@ other machines/servers. Electrum does not download the Bitcoin blockchain.")
(define-public electron-cash
(package
(inherit electrum)
(name "electron-cash")
(version "4.0.12")
(version "4.0.14")
(source
(origin
(method git-fetch)
@ -462,22 +461,52 @@ other machines/servers. Electrum does not download the Bitcoin blockchain.")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"0gidrx8499v7rig7ljhd70wssshs1qm0gp1553g70i323hcbf62x"))))
(base32 "1dp7cj1185h6xfz6jzh0iq58zvg3wq9hl96bkgxkf5h4ygni2vm6"))))
(build-system python-build-system)
(inputs
`(,@(package-inputs electrum)
`(("libevent" ,libevent)
("libsecp256k1", libsecp256k1)
("openssl" ,openssl)
("python-cython" ,python-cython)
("python-dateutil", python-dateutil)
("python-dnspython", python-dnspython)))
("python-dnspython" ,python-dnspython)
("python-ecdsa" ,python-ecdsa)
("python-hidapi" ,python-hidapi)
("python-jsonrpclib-pelix" ,python-jsonrpclib-pelix)
("python-keepkey" ,python-keepkey)
("python-protobuf" ,python-protobuf)
("python-pyaes" ,python-pyaes)
("python-pyqt" ,python-pyqt)
("python-pysocks" ,python-pysocks)
("python-qrcode" ,python-qrcode)
("python-requests" ,python-requests)
("python-stem" ,python-stem)
("python-trezor" ,python-trezor)
("qtsvg" ,qtsvg)
("zlib" ,zlib)))
(arguments
(substitute-keyword-arguments (package-arguments electrum)
((#:phases phases)
`(modify-phases ,phases
(add-after 'unpack 'use-libsecp256k1-input
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "lib/secp256k1.py"
(("library_paths = .* 'libsecp256k1.so.0'.")
(string-append "library_paths = ('" (assoc-ref inputs "libsecp256k1") "/lib/libsecp256k1.so.0'")))))))))
`(#:tests? #f ; No tests
#:modules ((guix build python-build-system)
(guix build qt-utils)
(guix build utils))
#:imported-modules (,@%python-build-system-modules
(guix build qt-utils))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-home
(lambda* (#:key outputs #:allow-other-keys)
(substitute* "setup.py"
(("~/.local/share")
(string-append (assoc-ref outputs "out") "/local/share")))))
(add-after 'unpack 'use-libsecp256k1-input
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "lib/secp256k1.py"
(("library_paths = .* 'libsecp256k1.so.0'.")
(string-append "library_paths = ('" (assoc-ref inputs "libsecp256k1") "/lib/libsecp256k1.so.0'")))))
(add-after 'install 'wrap-qt
(lambda* (#:key outputs #:allow-other-keys)
(wrap-qt-program (assoc-ref outputs "out") "electron-cash")
#t)))))
(home-page "https://electroncash.org/")
(synopsis "Bitcoin Cash wallet")
(description

44
gnu/packages/fpga.scm
View File

@ -44,6 +44,9 @@
#:use-module (gnu packages gperf)
#:use-module (gnu packages gawk)
#:use-module (gnu packages version-control)
#:use-module (gnu packages qt)
#:use-module (gnu packages boost)
#:use-module (gnu packages algebra)
#:use-module (gnu packages libftdi))
(define-public abc
@ -212,8 +215,8 @@ For synthesis, the compiler generates netlists in the desired format.")
(license license:isc)))
(define-public icestorm
(let ((commit "c0cbae88ab47a3879aacf80d53b6a85710682a6b")
(revision "2"))
(let ((commit "0ec00d892a91cc68e45479b46161f649caea2933")
(revision "3"))
(package
(name "icestorm")
(version (git-version "0.0" revision commit))
@ -225,7 +228,7 @@ For synthesis, the compiler generates netlists in the desired format.")
(file-name (git-file-name name version))
(sha256
(base32
"0bqm0rpywm64yvbq75klpyzb1g9sdsp1kvdlyqg4hvm8jw9w8lya"))))
"1qlh99fafb7xga702k64fmc9m700nsddrfgcq4x8qn8fplsb64f1"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no unit tests that don't need an FPGA exist.
@ -256,6 +259,41 @@ For synthesis, the compiler generates netlists in the desired format.")
Includes the actual FTDI connector.")
(license license:isc))))
(define-public nextpnr-ice40
(let [(commit "c192ba261d77ad7f0a744fb90b01e4a5b63938c4")
(revision "0")]
(package
(name "nextpnr-ice40")
(version (git-version "0.0.0" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "git://github.com/YosysHQ/nextpnr")
(commit commit)))
(sha256
(base32
"0g2ar1z89b31qw5vgqj2rrcv9rzncs94184dgcsrz19p866654mf"))))
(inputs
`(("qtbase" ,qtbase)
("boost" ,boost-with-python3)
("yosys" ,yosys)
("eigen" ,eigen)
("python" ,python)
("icestorm" ,icestorm)))
(build-system cmake-build-system)
(arguments
`(#:configure-flags `("-DARCH=ice40"
,(string-append "-DICEBOX_ROOT="
(assoc-ref %build-inputs "icestorm")
"/share/icebox"))
#:tests? #f))
(synopsis "Place-and-Route tool for FPGAs")
(description "nextpnr aims to be a vendor neutral, timing driven,
FOSS FPGA place and route tool. ")
(home-page "https://github.com/YosysHQ/nextpnr")
(license license:expat))))
(define-public arachne-pnr
(let ((commit "840bdfdeb38809f9f6af4d89dd7b22959b176fdd")
(revision "2"))

37
gnu/packages/games.scm
View File

@ -47,6 +47,7 @@
;;; Copyright © 2019 Josh Holland <josh@inv.alid.pw>
;;; Copyright © 2017, 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2020 Alberto Eleuterio Flores Guerrero <barbanegra+guix@posteo.mx>
;;; Copyright © 2020 Naga Malleswari <nagamalli@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -2561,7 +2562,7 @@ Protocol).")
(define-public extremetuxracer
(package
(name "extremetuxracer")
(version "0.7.5")
(version "0.8.0")
(source (origin
(method url-fetch)
(uri (string-append
@ -2569,7 +2570,7 @@ Protocol).")
version "/etr-" version ".tar.xz"))
(sha256
(base32
"1ly63316c07i0gyqqmyzsyvygsvygn0fpk3bnbg25fi6li99rlsg"))))
"05ysaxvsgps9fxc421kdifsxmc1sn6n79cjaa0k0i3fs9qqrja2b"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
@ -10300,3 +10301,35 @@ range with the objective to hit as many dummy targets as possible within
soldiers, jeeps and tanks. The gameplay is simple but it is not that easy to
get high scores.")
(license license:gpl2+)))
(define-public 7kaa
(package
(name "7kaa")
(version "2.15.3")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/the3dfxdude/7kaa/"
"releases/download/v" version "/"
"7kaa-" version ".tar.xz"))
(sha256
(base32 "0blj47mcsfw1sn3465j6iham8m6ki07iggnq4q8nnaqnryx710jc"))))
(build-system gnu-build-system)
(native-inputs
`(("gettext" ,gettext-minimal)
("pkg-config" ,pkg-config)))
(inputs
`(("curl" ,curl)
("enet" ,enet)
("openal" ,openal)
("sdl2" ,sdl2)))
(home-page "https://7kfans.com/")
(synopsis "Seven Kingdoms Ancient Adversaries: real-time strategy game")
(description
"Seven Kingdoms, designed by Trevor Chan, brings a blend of Real-Time
Strategy with the addition of trade, diplomacy, and espionage. The game
enables players to compete against up to six other kingdoms allowing players
to conquer opponents by defeating them in war (with troops or machines),
capturing their buildings with spies, or offering opponents money for their
kingdom.")
(license license:gpl2+)))

406
gnu/packages/geo.scm
View File

@ -46,10 +46,13 @@
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (gnu packages)
#:use-module (gnu packages algebra)
#:use-module (gnu packages astronomy)
#:use-module (gnu packages audio)
#:use-module (gnu packages autotools)
#:use-module (gnu packages backup)
#:use-module (gnu packages bash)
#:use-module (gnu packages bison)
#:use-module (gnu packages boost)
#:use-module (gnu packages check)
#:use-module (gnu packages compression)
@ -58,19 +61,25 @@
#:use-module (gnu packages datastructures)
#:use-module (gnu packages documentation)
#:use-module (gnu packages elf)
#:use-module (gnu packages flex)
#:use-module (gnu packages fonts)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages gettext)
#:use-module (gnu packages gl)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnome)
#:use-module (gnu packages gps)
#:use-module (gnu packages gtk)
#:use-module (gnu packages haskell-apps)
#:use-module (gnu packages image)
#:use-module (gnu packages image-processing)
#:use-module (gnu packages icu4c)
#:use-module (gnu packages java)
#:use-module (gnu packages kde)
#:use-module (gnu packages lua)
#:use-module (gnu packages maths)
#:use-module (gnu packages pcre)
#:use-module (gnu packages pdf)
#:use-module (gnu packages perl)
#:use-module (gnu packages photo)
#:use-module (gnu packages pkg-config)
@ -80,12 +89,16 @@
#:use-module (gnu packages python-web)
#:use-module (gnu packages python-xyz)
#:use-module (gnu packages qt)
#:use-module (gnu packages readline)
#:use-module (gnu packages swig)
#:use-module (gnu packages sqlite)
#:use-module (gnu packages textutils)
#:use-module (gnu packages time)
#:use-module (gnu packages web)
#:use-module (gnu packages webkit)
#:use-module (gnu packages wxwidgets)
#:use-module (gnu packages xml))
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg))
(define-public geos
(package
@ -1621,3 +1634,394 @@ track your position right from your laptop.")
license:lgpl3+
license:sgifreeb2.0
license:zlib))))
(define-public grass
(let* ((version "7.8.2")
(majorminor (string-join (list-head (string-split version #\.) 2) ""))
(grassxx (string-append "grass" majorminor)))
(package
(name "grass")
(version version)
(source
(origin
(method url-fetch)
(uri (string-append "https://grass.osgeo.org/" grassxx
"/source/grass-" version ".tar.gz"))
(sha256
(base32 "1fwsm99kz0bxvjk7442qq1h45ikrmhba8bqclafb61gqg1q6ymrk"))))
(build-system gnu-build-system)
(inputs
`(("bzip2", bzip2)
("cairo" ,cairo)
("fftw" ,fftw)
("freetype" ,freetype)
("gdal" ,gdal)
("geos" ,geos)
("glu" ,glu)
("lapack" ,lapack)
("libpng" ,libpng)
("libtiff" ,libtiff)
("mesa" ,mesa)
("mariadb-dev" ,mariadb "dev")
("mariadb-lib" ,mariadb "lib")
("netcdf" ,netcdf)
("openblas" ,openblas)
("perl" ,perl)
("postgresql" ,postgresql)
("proj.4" ,proj.4)
("python" ,python)
("python-dateutil" ,python-dateutil)
("python-numpy" ,python-numpy)
("python-wxpython" ,python-wxpython)
("readline" ,readline)
("sqlite" ,sqlite)
("wxwidgets" ,wxwidgets)
("zlib" ,zlib)
("zstd" ,zstd "lib")))
(native-inputs
`(("bash" ,bash-minimal)
("bison" ,bison)
("flex" ,flex)
("pkg-config" ,pkg-config)))
(arguments
`(#:tests? #f ; No tests
#:modules ((guix build gnu-build-system)
((guix build python-build-system) #:prefix python:)
(guix build utils))
#:imported-modules (,@%gnu-build-system-modules
(guix build python-build-system))
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((shell (string-append (assoc-ref inputs "bash")
"/bin/bash")))
(setenv "SHELL" shell)
(setenv "CONFIG_SHELL" shell)
(setenv "LDFLAGS" (string-append "-Wl,-rpath -Wl,"
(assoc-ref outputs "out")
"/" ,grassxx "/lib")))
(invoke "./configure"
(string-append "--prefix="
(assoc-ref outputs "out"))
"--with-blas"
"--with-bzlib"
(string-append "--with-freetype-includes="
(assoc-ref inputs "freetype")
"/include/freetype2")
(string-append "--with-freetype-libs="
(assoc-ref inputs "freetype")
"/lib")
"--with-geos"
"--with-lapack"
"--with-mysql"
(string-append "--with-mysql-includes="
(assoc-ref inputs "mariadb-dev")
"/include/mysql")
(string-append "--with-mysql-libs="
(assoc-ref inputs "mariadb-lib")
"/lib")
"--with-netcdf"
"--with-postgres"
(string-append "--with-proj-share="
(assoc-ref inputs "proj.4")
"/share/proj")
"--with-pthread"
"--with-readline"
"--with-sqlite"
"--with-wxwidgets")))
(add-after 'install 'install-links
(lambda* (#:key outputs #:allow-other-keys)
;; Put links for includes and libraries in the standard places.
(let* ((out (assoc-ref outputs "out"))
(dir (string-append out "/" ,grassxx)))
(symlink (string-append dir "/include")
(string-append out "/include"))
(symlink (string-append dir "/lib")
(string-append out "/lib")))
#t))
(add-after 'install-links 'wrap-python
(assoc-ref python:%standard-phases 'wrap)))))
(synopsis "GRASS Geographic Information System")
(description
"GRASS (Geographic Resources Analysis Support System), is a Geographic
Information System (GIS) software suite used for geospatial data management and
analysis, image processing, graphics and maps production, spatial modeling, and
visualization.")
(home-page "https://grass.osgeo.org/")
(license license:gpl2+))))
(define-public saga
(package
(name "saga")
(version "7.6.2")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/saga-gis/SAGA%20-%20"
(version-major version) "/SAGA%20-%20" version
"/saga-" version ".tar.gz"))
(sha256
(base32 "09j5magmayq2y620kqa490mfd1kpdp3lng2ifcgbrmssc079ybm0"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("swig" ,swig)))
(inputs
`(("curl" ,curl)
("fftw" ,fftw)
("gdal" ,gdal)
("hdf5" ,hdf5)
("jasper" ,jasper)
("libharu" ,libharu)
("libtiff" ,libtiff)
("opencv" ,opencv)
("postgresql" ,postgresql)
("proj.4" ,proj.4)
("python" ,python)
("qhull" ,qhull)
("unixodbc" ,unixodbc)
("vigra" ,vigra)
("wxwidgets" ,wxwidgets)))
(arguments
'(#:configure-flags '("--enable-python")))
(synopsis "System for Automated Geoscientific Analyses")
(description
"SAGA (System for Automated Geoscientific Analyses) is a Geographic
Information System (GIS) software. It has been designed for an easy and
effective implementation of spatial algorithms and it offers a comprehensive,
growing set of geoscientific methods.")
(home-page "http://www.saga-gis.org")
(license (list license:gpl2+ license:lgpl2.1+))))
(define-public qgis
(package
(name "qgis")
(version "3.12.1")
(source
(origin
(method url-fetch)
(uri (string-append "https://qgis.org/downloads/qgis-"
version ".tar.bz2"))
(sha256
(base32 "1a41525y8ac44gzcfaffjx0lyrm49hgnr83jrq40r5mqd3vpmp57"))))
(build-system cmake-build-system)
(arguments
`(#:modules ((guix build cmake-build-system)
((guix build python-build-system) #:prefix python:)
(guix build qt-utils)
(guix build utils))
#:imported-modules (,@%cmake-build-system-modules
(guix build python-build-system)
(guix build qt-utils))
#:phases
(modify-phases %standard-phases
;; Configure correct path to PyQt5 SIP directory
(add-after 'unpack 'configure-pyqt5-sip-path
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "cmake/FindPyQt5.cmake"
(("\"\\\\\\\\1\" PYQT5_SIP_DIR")
(string-append "\"" (assoc-ref inputs "python-pyqt+qscintilla")
"/share/sip\" PYQT5_SIP_DIR")))
(substitute* (list "scripts/prepare-commit.sh"
"scripts/runtests-local-travis-config.sh"
"scripts/sip_include.sh"
"scripts/sipdiff"
"scripts/sipify_all.sh"
"scripts/spell_check/check_spelling.sh"
"scripts/spell_check/spell_test.sh"
"scripts/verify-indentation.sh"
"tests/code_layout/test_banned_keywords.sh"
"tests/code_layout/test_licenses.sh"
"tests/code_layout/test_shellcheck.sh"
"tests/code_layout/test_sip_include.sh"
"tests/code_layout/test_sipfiles_uptodate.sh"
"tests/code_layout/test_sipify.sh")
(("\\$\\(git rev-parse --show-toplevel\\)")
(getcwd)))
(substitute* "tests/code_layout/test_sip_include.sh"
(("^REV=.*") "REV=currentrev\n"))
#t))
(replace 'check
(lambda* (#:key inputs #:allow-other-keys)
(setenv "HOME" "/tmp")
(system (string-append (assoc-ref inputs "xorg-server")
"/bin/Xvfb :1 &"))
(setenv "DISPLAY" ":1")
(setenv "TRAVIS" "true")
(setenv "CTEST_OUTPUT_ON_FAILURE" "1")
(invoke "ctest"
"-E" (string-join
'(;; Disable tests that require network access
"qgis_filedownloader"
;; TODO: Find why the following tests fail
"ProcessingQgisAlgorithmsTestPt1"
"ProcessingQgisAlgorithmsTestPt3"
"ProcessingQgisAlgorithmsTestPt4"
"ProcessingGdalAlgorithmsRasterTest"
"ProcessingGdalAlgorithmsVectorTest"
"ProcessingGrass7AlgorithmsImageryTest"
"ProcessingGrass7AlgorithmsRasterTest"
"ProcessingGrass7AlgorithmsVectorTest"
"ProcessingOtbAlgorithmsTest"
"qgis_authmanagertest"
"qgis_compositionconvertertest"
"qgis_coordinatereferencesystemtest"
"qgis_geometrytest"
"qgis_layouthtmltest"
"qgis_layoutmaptest"
"qgis_painteffecttest"
"qgis_pallabelingtest"
"qgis_svgmarkertest"
"qgis_taskmanagertest"
"qgis_ziplayertest"
"qgis_processingtest"
"qgis_wcsprovidertest"
"qgis_arcgisrestutilstest"
"qgis_grassprovidertest7"
"qgis_gpsinformationwidget"
"PyCoreAdittions"
"PyQgsPythonProvider"
"PyQgsAnnotation"
"PyQgsAuthenticationSystem"
"PyQgsProject"
"PyQgsFileUtils"
"PyQgsGeometryTest"
"PyQgsImageCache"
"PyQgsLayoutExporter"
"PyQgsLayoutLegend"
"PyQgsMapLayer"
"PyQgsOGRProviderGpkg"
"PyQgsPalLabelingLayout"
"PyQgsImportIntoPostGIS"
"PyQgsProviderConnectionPostgres"
"PyQgsProviderConnectionGpkg"
"PyQgsShapefileProvider"
"PyQgsSvgCache"
"PyQgsTextRenderer"
"PyQgsOGRProvider"
"PyQgsSpatialiteProvider"
"PyQgsVectorFileWriter"
"PyQgsVectorLayer"
"PyQgsVectorLayerUtils"
"PyQgsVirtualLayerProvider"
"PyQgsWFSProvider"
"PyQgsOapifProvider"
"PyQgsLayerDependencies"
"PyQgsDBManagerGpkg"
"PyQgsDBManagerSpatialite"
"PyQgsSettings"
"PyQgsAuxiliaryStorage"
"PyQgsSelectiveMasking"
"PyQgsAppStartup"
"qgis_geometrycheckstest"
"qgis_shellcheck"
"qgis_sipify"
"qgis_sip_include"
"qgis_sip_uptodate")
"|"))))
(add-after 'install 'wrap-python
(assoc-ref python:%standard-phases 'wrap))
(add-after 'wrap-python 'wrap-qt
(lambda* (#:key outputs #:allow-other-keys)
(wrap-qt-program (assoc-ref outputs "out") "qgis")
#t)))))
(inputs
`(("exiv2" ,exiv2)
("expat" ,expat)
("gdal" ,gdal)
("geos" ,geos)
("gpsbabel" ,gpsbabel)
("grass" ,grass)
("gsl" ,gsl)
("hdf5" ,hdf5)
("libspatialindex" ,libspatialindex)
("libspatialite" ,libspatialite)
("libxml2" ,libxml2)
("libzip" ,libzip)
("netcdf" ,netcdf)
("postgresql" ,postgresql)
("proj" ,proj)
("python" ,python)
("python-chardet" ,python-chardet)
("python-dateutil" ,python-dateutil)
("python-gdal" ,python-gdal)
("python-jinja2" ,python-jinja2)
("python-numpy" ,python-numpy)
("python-owslib" ,python-owslib)
("python-psycopg2" ,python-psycopg2)
("python-pygments" ,python-pygments)
("python-pyqt+qscintilla" ,python-pyqt+qscintilla)
("python-pytz" ,python-pytz)
("python-pyyaml" ,python-pyyaml)
("python-requests" ,python-requests)
("python-sip" ,python-sip)
("python-six" ,python-six)
("python-urllib3" ,python-urllib3)
("qca" ,qca)
("qscintilla" ,qscintilla)
("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)
("qtkeychain" ,qtkeychain)
("qtlocation" ,qtlocation)
("qtserialport" ,qtserialport)
("qtsvg" ,qtsvg)
("qtwebkit" ,qtwebkit)
("qwt" ,qwt)
("saga" ,saga)
("sqlite" ,sqlite-with-column-metadata)))
(native-inputs
`(("bison" ,bison)
("flex" ,flex)
("perl" ,perl)
("perl-yaml-tiny" ,perl-yaml-tiny)
("pkg-config" ,pkg-config)
("python-mock" ,python-mock)
("python-nose2" ,python-nose2)
("qttools" ,qttools)
("shellcheck" ,shellcheck)
("xorg-server" ,xorg-server-for-tests)))
(home-page "https://qgis.org")
(synopsis "Geographical information system")
(description "QGIS is an easy to use Geographical Information
System (GIS). It is a GIS data viewer and editor. QGIS supports a number of
raster and vector data formats, with new support easily added using the plugin
architecture.")
(license
(list
license:asl1.1
license:asl2.0
license:bsd-2
license:bsd-3
license:boost1.0
license:cc-by3.0
license:cc-by4.0
license:cc-by-sa3.0
license:cc-by-sa4.0
(license:fsdg-compatible "https://www.deviantart.com/elvensword")
(license:fsf-free "file://debian/copyright" "Go Squared")
license:expat
license:fdl1.2+
(license:fsf-free
"https://www.deviantart.com/webgoddess/art/Reddish-Inspired-Gradients-42208824")
(license:fsf-free
"file://debian/copyright"
"QT-Commercial or LGPL-2.1 with Digia Qt LGPL Exception 1.1 or GPL-3")
license:gpl2
license:gpl2+
license:gpl3
license:gpl3+
license:isc
license:lgpl2.0+
license:lgpl2.1
license:lgpl2.1+
license:lgpl3
(license:non-copyleft "file://debian/copyright" "BSD-like-gist")
(license:non-copyleft "file://debian/copyright" "Jim Mossman Attribution")
(license:non-copyleft
"https://www.ncl.ucar.edu/Download/NCL_source_license.shtml"
"NCL Source Code License")
license:ogl-psi1.0
license:opl1.0+
license:public-domain
license:qwt1.0))))

4
gnu/packages/gnome-xyz.scm
View File

@ -433,7 +433,7 @@ It uses ES6 syntax and claims to be more actively maintained than others.")
(define-public gnome-shell-extension-paperwm
(package
(name "gnome-shell-extension-paperwm")
(version "34.3")
(version "36.0")
(source (origin
(method git-fetch)
(uri (git-reference
@ -442,7 +442,7 @@ It uses ES6 syntax and claims to be more actively maintained than others.")
(file-name (git-file-name name version))
(sha256
(base32
"1qry75f696pgmd9yzqvwhq5h6cipin2fvk7h881g29cjcpxim37a"))
"1ssnabwxrns36c61ppspjkr9i3qifv08pf2jpwl7cjv3pvyn4kly"))
(snippet
'(begin (delete-file "schemas/gschemas.compiled")))))
(build-system copy-build-system)

3
gnu/packages/gnu-pw-mgr.scm
View File

@ -49,8 +49,7 @@
(("/usr/bin/printf") (which "printf")))
#t)))))
(native-inputs
`(("which" ,which)
("autogen" ,autogen)))
`(("which" ,which)))
(home-page "https://www.gnu.org/software/gnu-pw-mgr/")
(synopsis "Retrieve login credentials without recording passwords")
(description

3
gnu/packages/gnupg.scm
View File

@ -258,7 +258,8 @@ compatible to GNU Pth.")
".tar.bz2"))
(sha256
(base32
"0c6a4v9p6qzhsw1pfcwc459bxpc8hma0w9z8iqb9khvligack9q4"))))
"0c6a4v9p6qzhsw1pfcwc459bxpc8hma0w9z8iqb9khvligack9q4"))
(patches (search-patches "gnupg-default-pinentry.patch"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))

237
gnu/packages/golang.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Matthew Jordan <matthewjordandevops@yandex.com>
;;; Copyright © 2016 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2016, 2019 Ludovic Courtès <ludo@gnu.org>
@ -692,6 +692,36 @@ for the Go language.")
(home-page "https://go.googlesource.com/net")
(license license:bsd-3))))
(define-public go-golang-org-x-image
(let ((commit "58c23975cae11f062d4b3b0c143fe248faac195d")
(revision "1"))
(package
(name "go-golang-org-x-image")
(version (git-version "0.0.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://go.googlesource.com/image")
(commit commit)))
(file-name (string-append "go.googlesource.com-image-"
version "-checkout"))
(sha256
(base32
"0i2p2girc1sfcic6xs6vrq0fp3szfx057xppksb67kliywjjrm5x"))))
(build-system go-build-system)
(arguments
`(#:import-path "golang.org/x/image"
; Source-only package
#:tests? #f
#:phases
(modify-phases %standard-phases
(delete 'build))))
(home-page "https://go.googlesource.com/image")
(synopsis "Supplemental Go image libraries")
(description "This package provides supplemental Go libraries for image
processing.")
(license license:bsd-3))))
(define-public go-golang-org-x-sys
(let ((commit "749cb33beabd9aa6d3178e3de05bcc914f70b2bf")
(revision "5"))
@ -3442,3 +3472,208 @@ efficient space usage.")
based on murmurhash.")
(home-page "https://github.com/willf/bloom")
(license license:bsd-2)))
(define-public go-golang-org-rainycape-unidecode
(let ((commit "cb7f23ec59bec0d61b19c56cd88cee3d0cc1870c")
(revision "1"))
(package
(name "go-golang-org-rainycape-unidecode")
(version (git-version "0.0.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/rainycape/unidecode")
(commit commit)))
(file-name (string-append "go-golang-org-rainycape-unidecode-"
version "-checkout"))
(sha256
(base32
"1wvzdijd640blwkgmw6h09frkfa04kcpdq87n2zh2ymj1dzla5v5"))))
(build-system go-build-system)
(arguments
`(#:import-path "golang.org/rainycape/unidecode"))
(home-page "https://github.com/rainycape/unidecode")
(synopsis "Unicode transliterator in Golang")
(description "Unicode transliterator in Golang - Replaces non-ASCII
characters with their ASCII approximations.")
(license license:asl2.0))))
(define-public go-github-com-golang-freetype
(let ((commit "e2365dfdc4a05e4b8299a783240d4a7d5a65d4e4")
(revision "1"))
(package
(name "go-github-com-golang-freetype")
(version (git-version "0.0.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/golang/freetype")
(commit commit)))
(file-name (string-append "go-github-com-golang-freetype-"
version "-checkout"))
(sha256
(base32
"194w3djc6fv1rgcjqds085b9fq074panc5vw582bcb8dbfzsrqxc"))))
(build-system go-build-system)
(arguments
`(#:import-path "github.com/golang/freetype"))
(propagated-inputs
`(("go-golang-org-x-image" ,go-golang-org-x-image)))
(home-page "https://github.com/golang/freetype")
(synopsis "Freetype font rasterizer in the Go programming language")
(description "The Freetype font rasterizer in the Go programming language.")
(license (list license:freetype
license:gpl2+)))))
(define-public go-github-com-fogleman-gg
(package
(name "go-github-com-fogleman-gg")
(version "1.3.0")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/fogleman/gg")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1nkldjghbqnzj2djfaxhiv35kk341xhcrj9m2dwq65v684iqkk8n"))))
(build-system go-build-system)
(arguments
`(#:tests? #f ; Issue with test flags.
#:import-path "github.com/fogleman/gg"))
(propagated-inputs
`(("go-github-com-golang-freetype" ,go-github-com-golang-freetype)))
(home-page "https://github.com/fogleman/gg")
(synopsis "2D rendering in Go")
(description "@code{gg} is a library for rendering 2D graphics in pure Go.")
(license license:expat)))
(define-public go-github-com-gedex-inflector
(let ((commit "16278e9db8130ac7ec405dc174cfb94344f16325")
(revision "1"))
(package
(name "go-github-com-gedex-inflector")
(version (git-version "0.0.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/gedex/inflector")
(commit commit)))
(file-name (string-append "go-github-com-gedex-inflector-"
version "-checkout"))
(sha256
(base32
"05hjqw1m71vww4914d9h6nqa9jw3lgjzwsy7qaffl02s2lh1amks"))))
(build-system go-build-system)
(arguments
`(#:import-path "github.com/gedex/inflector"))
(home-page "https://github.com/gedex/inflector")
(synopsis "Go library that pluralizes and singularizes English nouns")
(description "Go library that pluralizes and singularizes English nouns.")
(license license:bsd-2))))
(define-public go-github-com-klauspost-cpuid
(package
(name "go-github-com-klauspost-cpuid")
(version "1.2.3")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/klauspost/cpuid")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1s510210wdj5dkamii1qrk7v87k4qpdcrrjzflp5ha9iscw6b06l"))))
(build-system go-build-system)
(arguments
`(#:import-path "github.com/klauspost/cpuid"))
(home-page "https://github.com/klauspost/cpuid")
(synopsis "CPU feature identification for Go")
(description "@code{cpuid} provides information about the CPU running the
current program. CPU features are detected on startup, and kept for fast access
through the life of the application. Currently x86 / x64 (AMD64) is supported,
and no external C (cgo) code is used, which should make the library very eas
to use.")
(license license:expat)))
(define-public go-github-com-pbnjay-memory
(let ((commit "974d429e7ae40c89e7dcd41cfcc22a0bfbe42510")
(revision "1"))
(package
(name "go-github-com-pbnjay-memory")
(version (git-version "0.0.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/pbnjay/memory")
(commit commit)))
(file-name (string-append "go-github-com-pbnjay-memory-"
version "-checkout"))
(sha256
(base32
"0kazg5psdn90pqadrzma5chdwh0l2by9z31sspr47gx93fhjmkkq"))))
(build-system go-build-system)
(arguments
`(#:import-path "github.com/pbnjay/memory"))
(home-page "https://github.com/gedex/inflector")
(synopsis "Go library to report total system memory")
(description "@code{memory} provides a single method reporting total
physical system memory accessible to the kernel. It does not account for memory
used by other processes.")
(license license:bsd-3))))
(define-public go-github-com-surge-glog
(let ((commit "2578deb2b95c665e6b1ebabf304ce2085c9e1985")
(revision "1"))
(package
(name "go-github-com-surge-glog")
(version (git-version "0.0.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/surge/glog")
(commit commit)))
(file-name (string-append "go-github-com-surge-glog-"
version "-checkout"))
(sha256
(base32
"1bxcwxvsvr2hfpjz9hrrn0wrgykwmrbyk567102k3vafw9xdcwk4"))))
(build-system go-build-system)
(arguments
`(#:import-path "github.com/surge/glog"))
(home-page "https://github.com/surge/glog")
(synopsis "Leveled execution logs for Go")
(description "Leveled execution logs for Go.")
(license license:asl2.0))))
(define-public go-github-com-surgebase-porter2
(let ((commit "56e4718818e8dc4ea5ba6348402fc7661863732a")
(revision "1"))
(package
(name "go-github-com-surgebase-porter2")
(version (git-version "0.0.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/surgebase/porter2")
(commit commit)))
(file-name (string-append "go-github-com-surgebase-porter2-"
version "-checkout"))
(sha256
(base32
"1ivcf83jlj9s7q5y9dfbpyl0br35cz8fcp0dm8sxxvqh54py06v2"))))
(build-system go-build-system)
(arguments
`(#:import-path "github.com/surgebase/porter2"))
(native-inputs
`(("go-github-com-stretchr-testify" ,go-github-com-stretchr-testify)
("go-github-com-surge-glog" ,go-github-com-surge-glog)))
(home-page "https://github.com/surgebase/porter2")
(synopsis "Go library implementing english Porter2 stemmer")
(description "Porter2 implements the
@url{http://snowball.tartarus.org/algorithms/english/stemmer.html, english
Porter2 stemmer}. It is written completely using finite state machines to do
suffix comparison, rather than the string-based or tree-based approaches.")
(license license:asl2.0))))

4
gnu/packages/graph.scm
View File

@ -125,14 +125,14 @@ more.")
(define-public r-igraph
(package
(name "r-igraph")
(version "1.2.4.2")
(version "1.2.5")
(source
(origin
(method url-fetch)
(uri (cran-uri "igraph" version))
(sha256
(base32
"0scrbqb26pam8akblb4g9rkz888s0xffw3gcly78s4ijj67barxd"))))
"126z1ygbmi3g7hk97snf22rnx680dyi30idssm5zacba5rdngp8c"))))
(build-system r-build-system)
(native-inputs
`(("gfortran" ,gfortran)))

4
gnu/packages/graphics.scm
View File

@ -834,14 +834,14 @@ rendering SVG graphics.")
(define-public python-pastel
(package
(name "python-pastel")
(version "0.1.1")
(version "0.2.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "pastel" version))
(sha256
(base32
"1qxcrcl8pzh66l8s6hym153mijdhwna0afcsmgca0bj4n80ijfxz"))))
"0dnaw44ss10i10z4ksy0xljknvjap7rb7g0b8p6yzm5x4g2my5a6"))))
(build-system python-build-system)
(arguments
`(#:phases (modify-phases %standard-phases

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

@ -23,6 +23,7 @@
;;; Copyright © 2019 swedebugia <swedebugia@riseup.net>
;;; Copyright © 2019, 2020 Amar Singh <nly@disroot.org>
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -3050,6 +3051,13 @@ comparing, and writing Semantic Versions. It also includes ranges in
the style of the Node Package Manager (NPM).")
(license license:gpl3+)))
(define-public guile3.0-semver
(package
(inherit guile-semver)
(name "guile3.0-semver")
(inputs
`(("guile" ,guile-3.0)))))
(define-public guile-hashing
(package
(name "guile-hashing")

12
gnu/packages/icu4c.scm
View File

@ -36,6 +36,7 @@
(define-public icu4c
(package
(name "icu4c")
(replacement icu4c/fixed)
(version "66.1")
(source (origin
(method url-fetch)
@ -112,6 +113,17 @@ C/C++ part.")
#t)))))))
(native-inputs '())))
(define icu4c/fixed
(package
(inherit icu4c)
(source (origin
(inherit (package-source icu4c))
(patch-flags '("-p2"))
(patches (append
(origin-patches (package-source icu4c))
(search-patches
"icu4c-CVE-2020-10531.patch")))))))
(define-public java-icu4j
(package
(name "java-icu4j")

70
gnu/packages/linux.scm
View File

@ -194,9 +194,9 @@ defconfig. Return the appropriate make target if applicable, otherwise return
(define deblob-scripts-5.4
(linux-libre-deblob-scripts
"5.4.19"
"5.4.28"
(base32 "0ckxn7k5zgcqk30dq943bnamr6a6zjbw2aqjl3x30f4kvh5f6k25")
(base32 "1ajzwyy6vgmihxpz3sbshzfzd0w8yzj0fihv0d5rjpr4z3gm48bk")))
(base32 "08ls4gx5vanyiq9rn0869nfq4piw4lx1dl8hh9w9xgkr4ypc1j4k")))
(define deblob-scripts-4.19
(linux-libre-deblob-scripts
@ -362,18 +362,18 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
"linux-" version ".tar.xz"))
(sha256 hash)))
(define-public linux-libre-5.4-version "5.4.27")
(define-public linux-libre-5.4-version "5.4.28")
(define-public linux-libre-5.4-pristine-source
(let ((version linux-libre-5.4-version)
(hash (base32 "0szc1p9y6z8gs2f1nj45nrz52sxcabg2xh7zqlljazv45lvcvf8r")))
(hash (base32 "197p7rjmbs229ncj1y8s80f7n4bm8g9w0jrv1109m3rl8q9wqqy8")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-5.4)))
(define-public linux-libre-4.19-version "4.19.112")
(define-public linux-libre-4.19-version "4.19.113")
(define-public linux-libre-4.19-pristine-source
(let ((version linux-libre-4.19-version)
(hash (base32 "0yiyqwgh6wcyshpdj98s7dc4ahyx47y6whvnww6sjmzdq0fb3hi4")))
(hash (base32 "1rf0jz7r1f4rb4k0g3glssfa1hm2ka6vlbwjlkmsx1bybxnmg85m")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-4.19)))
@ -433,7 +433,11 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
(define-public linux-libre-5.4-source
(source-with-patches linux-libre-5.4-pristine-source
(list %boot-logo-patch
%linux-libre-arm-export-__sync_icache_dcache-patch)))
%linux-libre-arm-export-__sync_icache_dcache-patch
;; Pinebook Pro patch from linux-next,
;; can be dropped for linux-libre 5.7
(search-patch
"linux-libre-support-for-Pinebook-Pro.patch"))))
(define-public linux-libre-4.19-source
(source-with-patches linux-libre-4.19-pristine-source
@ -566,15 +570,6 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
(file (string-append "linux-libre/" name)))
(search-auxiliary-file file)))
;; FIXME: merge into kernel-config
(define* (kernel-config-veyron arch #:key variant)
"Return the absolute file name of the Linux-Libre build configuration file
for ARCH and optionally VARIANT, or #f if there is no such configuration."
(let* ((name (string-append (if variant (string-append variant "-") "")
(if (string=? "i386" arch) "i686" arch) "-veyron.conf"))
(file (string-append "linux-libre/" name)))
(search-auxiliary-file file)))
(define %default-extra-linux-options
`(;; Some very mild hardening.
("CONFIG_SECURITY_DMESG_RESTRICT" . #t)
@ -654,7 +649,6 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
`(("perl" ,perl)
("bc" ,bc)
("openssl" ,openssl)
("kmod" ,kmod)
("elfutils" ,elfutils) ; Needed to enable CONFIG_STACK_VALIDATION
("flex" ,flex)
("bison" ,bison)
@ -678,6 +672,7 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
(guix build utils)
(srfi srfi-1)
(srfi srfi-26)
(ice-9 ftw)
(ice-9 match))
#:phases
(modify-phases %standard-phases
@ -729,8 +724,7 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
(lambda* (#:key inputs native-inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(moddir (string-append out "/lib/modules"))
(dtbdir (string-append out "/lib/dtbs"))
(kmod (assoc-ref (or native-inputs inputs) "kmod")))
(dtbdir (string-append out "/lib/dtbs")))
;; Install kernel image, kernel configuration and link map.
(for-each (lambda (file) (install-file file out))
(find-files "." "^(\\.config|bzImage|zImage|Image|vmlinuz|System\\.map|Module\\.symvers)$"))
@ -742,12 +736,29 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
;; Install kernel modules
(mkdir-p moddir)
(invoke "make"
(string-append "DEPMOD=" kmod "/bin/depmod")
;; Disable depmod because the Guix system's module directory
;; is an union of potentially multiple packages. It is not
;; possible to use depmod to usefully calculate a dependency
;; graph while building only one of those packages.
"DEPMOD=true"
(string-append "MODULE_DIR=" moddir)
(string-append "INSTALL_PATH=" out)
(string-append "INSTALL_MOD_PATH=" out)
"INSTALL_MOD_STRIP=1"
"modules_install")))))
"modules_install")
(let* ((versions (filter (lambda (name)
(not (string-prefix? "." name)))
(scandir moddir)))
(version (match versions
((x) x))))
;; There are symlinks to the build and source directory,
;; both of which will point to target /tmp/guix-build*
;; and thus not be useful in a profile. Delete the symlinks.
(false-if-file-not-found
(delete-file (string-append moddir "/" version "/build")))
(false-if-file-not-found
(delete-file (string-append moddir "/" version "/source"))))
#t))))
#:tests? #f))
(home-page "https://www.gnu.org/software/linux-libre/")
(synopsis "100% free redistribution of a cleaned Linux kernel")
@ -807,13 +818,6 @@ It has been modified to remove all non-free binary blobs.")
;;; Specialized kernel variants.
;;;
(define-public linux-libre-arm-veyron
(make-linux-libre* linux-libre-version
linux-libre-source
'("armhf-linux")
#:configuration-file kernel-config-veyron
#:extra-version "arm-veyron"))
(define-public linux-libre-arm-generic
(make-linux-libre* linux-libre-version
linux-libre-source
@ -821,6 +825,9 @@ It has been modified to remove all non-free binary blobs.")
#:defconfig "multi_v7_defconfig"
#:extra-version "arm-generic"))
(define-public linux-libre-arm-veyron
(deprecated-package "linux-libre-arm-veyron" linux-libre-arm-generic))
(define-public linux-libre-arm-generic-4.19
(make-linux-libre* linux-libre-4.19-version
linux-libre-4.19-source
@ -856,6 +863,13 @@ It has been modified to remove all non-free binary blobs.")
#:defconfig "omap2plus_defconfig"
#:extra-version "arm-omap2plus"))
(define-public linux-libre-arm64-generic
(make-linux-libre* linux-libre-version
linux-libre-source
'("aarch64-linux")
#:defconfig "defconfig"
#:extra-version "arm64-generic"))
(define-public linux-libre-riscv64-generic
(make-linux-libre* linux-libre-version
linux-libre-source

1
gnu/packages/lisp.scm
View File

@ -494,6 +494,7 @@ an interpreter, a compiler, a debugger, and much more.")
`("clisp")))
(string-append "--prefix="
(assoc-ref outputs "out"))
"--dynamic-space-size=2Gb"
"--with-sb-core-compression"
"--with-sb-xref-for-internals")))
(replace 'install

10
gnu/packages/mail.scm
View File

@ -383,17 +383,17 @@ aliasing facilities to work just as they would on normal mail.")
(define-public mutt
(package
(name "mutt")
(version "1.13.2")
(version "1.13.4")
(source (origin
(method url-fetch)
(uri (list
(string-append "ftp://ftp.mutt.org/pub/mutt/mutt-"
version ".tar.gz")
(string-append "https://bitbucket.org/mutt/mutt/downloads/"
"mutt-" version ".tar.gz")))
"mutt-" version ".tar.gz")
(string-append "http://ftp.mutt.org/pub/mutt/mutt-"
version ".tar.gz")))
(sha256
(base32
"0x4yfvk8415p80h9an242n6q3b43mw6mnnczh95zd3j0zwdr6wrg"))
"016dzx2c0kr9xgnw4nfzpkn4nvpk56rdlcqhrwa820fq8083yzdm"))
(patches (search-patches "mutt-store-references.patch"))))
(build-system gnu-build-system)
(inputs

12
gnu/packages/man.scm
View File

@ -226,6 +226,18 @@ Linux kernel and C library interfaces employed by user-space programs.")
automatically.")
(license gpl3+)))
(define-public help2man/latest
(package
(inherit help2man)
(version "1.47.13")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/help2man/help2man-"
version ".tar.xz"))
(sha256
(base32
"08q5arxz4j4pyx5q4712c2rn7p7dw7as9xg38yvmsh1c3ynvpy5p"))))))
(define-public scdoc
(package
(name "scdoc")

4
gnu/packages/maths.scm
View File

@ -3029,7 +3029,7 @@ point numbers.")
(define-public wxmaxima
(package
(name "wxmaxima")
(version "20.02.4")
(version "20.03.1")
(source
(origin
(method git-fetch)
@ -3038,7 +3038,7 @@ point numbers.")
(commit (string-append "Version-" version))))
(file-name (git-file-name name version))
(sha256
(base32 "106a7jrjwfmymzj70nsv44fm3jbxngr8pmkaghhpwy0ln38lhf54"))))
(base32 "09ciip0wkahps5jdsqqr72bwjrd15bacw38zp23v3hm71xfk8hky"))))
(build-system cmake-build-system)
(native-inputs
`(("gettext" ,gettext-minimal)

80
gnu/packages/music.scm
View File

@ -5213,3 +5213,83 @@ featureful and easy to use. It offers unlimited automation options, LV2
plugin support, JACK support and chord assistance.")
(home-page "https://www.zrythm.org")
(license license:agpl3+)))
(define-public dragonfly-reverb
(package
(name "dragonfly-reverb")
(version "2.0.0")
(source
(origin
(method git-fetch)
(uri
(git-reference
(url "https://github.com/michaelwillis/dragonfly-reverb.git")
(commit version)
;; Bundles a specific commit of the DISTRHO plugin framework.
(recursive? #t)))
(file-name (git-file-name name version))
(sha256
(base32 "1qrbv4kk5v6ynx424h1i54qj0w8v6vpw81b759jawxvzzprpgq72"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no check target
#:make-flags (list "CC=gcc")
#:phases
(modify-phases %standard-phases
(delete 'configure) ;no configure target
(replace 'install ;no install target
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(lv2 (string-append out "/lib/lv2")))
;; Install LV2.
(for-each
(lambda (file)
(copy-recursively file
(string-append lv2 "/" (basename file))))
(find-files "bin" "\\.lv2$" #:directories? #t))
;; Install executables.
(install-file "bin/DragonflyRoomReverb" bin)
(install-file "bin/DragonflyHallReverb" bin)
#t))))))
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("jack" ,jack-1)
("libx11" ,libx11)
("mesa" ,mesa)))
(home-page "https://michaelwillis.github.io/dragonfly-reverb/")
(synopsis "Concert hall reverb and room reverb effects")
(description
"Dragonfly Reverb is a bundle of two free audio effects: a concert
hall reverb and a room reverb. Both are available as LV2 plugins as well
as JACK standalone applications.")
(license license:gpl3+)))
(define-public zlfo
(package
(name "zlfo")
(version "0.1.3")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://git.zrythm.org/git/ZLFO")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"0bm466ci5xyvxvq7l9p6xyh789lvk6i31b4zja1igqh13akbjnjz"))))
(build-system meson-build-system)
(inputs
`(("librsvg" ,librsvg)
("lv2" ,lv2)
("ztoolkit-rsvg" ,ztoolkit-rsvg)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(synopsis "Low frequency oscillator plugin")
(description "ZLFO is a fully featured
@dfn{low frequency oscillator} (LFO) for @dfn{control voltage} (CV)-based
automation that comes as an LV2 plugin bundle with a custom UI.")
(home-page "https://git.zrythm.org/cgit/ZLFO/")
(license license:agpl3+)))

4
gnu/packages/nano.scm
View File

@ -30,13 +30,13 @@
(define-public nano
(package
(name "nano")
(version "4.8")
(version "4.9")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/nano/nano-" version ".tar.xz"))
(sha256
(base32 "0qwf4ld0fl2bpnjh23z2pq7wcs6d14m2364360xmf7dbd0fgcj63"))))
(base32 "19ik88b3g0d9xwav4hkai2h1acmjy5fdnh21gdc1mjq5s4lrff8f"))))
(build-system gnu-build-system)
(inputs
`(("gettext" ,gettext-minimal)

5
gnu/packages/ncurses.scm
View File

@ -7,6 +7,7 @@
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017, 2019, 2020 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Michael Rohleder <mike@rohleder.de>
;;;
;;; This file is part of GNU Guix.
;;;
@ -236,7 +237,7 @@ ncursesw library provides wide character support.")
(define-public dialog
(package
(name "dialog")
(version "1.3-20191110")
(version "1.3-20200228")
(source (origin
(method url-fetch)
(uri (string-append
@ -244,7 +245,7 @@ ncursesw library provides wide character support.")
version ".tgz"))
(sha256
(base32
"0qqf3l7a3brgsz3kcrawyhicivajqr57gkp3134h4k20204psanr"))))
"1n8zbkigbzxw8gkw7qhzwzdyc7rbc7a0jcfy9z8ib7pf3qfw9y4z"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f)) ; no test suite

6
gnu/packages/parallel.scm
View File

@ -7,7 +7,7 @@
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2017, 2018 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
@ -54,14 +54,14 @@
(define-public parallel
(package
(name "parallel")
(version "20200122")
(version "20200322")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://gnu/parallel/parallel-"
version ".tar.bz2"))
(sha256
(base32 "070cv3b1ja8lmn2a5h1ry6b5y35jpm4z5r9yv9nb5kd5im11wvqi"))))
(base32 "0kg95glnfg25i1w7qg2vr5v4671vigsazmz4qdf223l64khq8x10"))))
(build-system gnu-build-system)
(arguments
`(#:phases

544
gnu/packages/patches/circos-remove-findbin.patch Normal file
View File

@ -0,0 +1,544 @@
This patch was created by Roel Janssen <roel@gnu.org>.
Circos uses paths relative to the "circos" script to find its Perl modules.
This patch removes that mechanism, and instead expects the 'Circos' modules
to be available in the global Perl path.
diff -crB circos-0.69-6/bin/circos circos-0.69-6-new/bin/circos
*** circos-0.69-6/bin/circos 2016-02-19 01:42:59.000000000 +0100
--- circos-0.69-6-new/bin/circos 2018-01-12 09:59:25.662731269 +0100
***************
*** 474,486 ****
use strict;
use warnings;
- use FindBin;
use Getopt::Long qw(:config pass_through posix_default auto_abbrev);
use Pod::Usage;
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
use Circos;
use Cwd;
--- 474,482 ----
diff -crB circos-0.69-6/lib/Circos/Colors.pm circos-0.69-6-new/lib/Circos/Colors.pm
*** circos-0.69-6/lib/Circos/Colors.pm 2015-03-17 01:25:43.000000000 +0100
--- circos-0.69-6-new/lib/Circos/Colors.pm 2018-01-12 10:10:39.174797379 +0100
***************
*** 49,55 ****
use Carp qw( carp confess croak );
use Digest::MD5 qw(md5_hex);
- use FindBin;
use File::Basename;
use File::Spec::Functions;
use File::Temp qw(tempdir);
--- 49,54 ----
***************
*** 65,74 ****
#use Time::HiRes qw(gettimeofday tv_interval);
#use List::Util qw( max min );
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use POSIX qw(pow);
use Circos::Configuration;
--- 64,69 ----
diff -crB circos-0.69-6/lib/Circos/Configuration.pm circos-0.69-6-new/lib/Circos/Configuration.pm
*** circos-0.69-6/lib/Circos/Configuration.pm 2015-03-17 22:11:01.000000000 +0100
--- circos-0.69-6-new/lib/Circos/Configuration.pm 2018-01-12 10:11:41.064008273 +0100
***************
*** 59,68 ****
use Params::Validate qw(:all);
use List::MoreUtils qw(uniq);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Constants;
use Circos::Debug;
use Circos::Utils;
--- 59,64 ----
diff -crB circos-0.69-6/lib/Circos/DataPoint.pm circos-0.69-6-new/lib/Circos/DataPoint.pm
*** circos-0.69-6/lib/Circos/DataPoint.pm 2014-05-12 18:20:19.000000000 +0200
--- circos-0.69-6-new/lib/Circos/DataPoint.pm 2018-01-12 10:11:54.888270731 +0100
***************
*** 38,51 ****
use Carp qw( carp confess croak );
use Data::Dumper;
- use FindBin;
use GD::Image;
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration; # qw(%CONF $DIMS);
use Circos::Constants;
use Circos::Debug;
--- 38,46 ----
diff -crB circos-0.69-6/lib/Circos/Debug.pm circos-0.69-6-new/lib/Circos/Debug.pm
*** circos-0.69-6/lib/Circos/Debug.pm 2015-03-24 01:26:13.000000000 +0100
--- circos-0.69-6-new/lib/Circos/Debug.pm 2018-01-12 10:12:07.192502006 +0100
***************
*** 63,75 ****
use Carp qw( carp confess croak );
use Data::Dumper;
- use FindBin;
use Memoize;
use List::MoreUtils qw(uniq);
use Time::HiRes qw(gettimeofday tv_interval);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
use Circos::Constants;
--- 63,71 ----
diff -crB circos-0.69-6/lib/Circos/Division.pm circos-0.69-6-new/lib/Circos/Division.pm
*** circos-0.69-6/lib/Circos/Division.pm 2015-11-17 00:55:58.000000000 +0100
--- circos-0.69-6-new/lib/Circos/Division.pm 2018-01-12 10:12:21.544769084 +0100
***************
*** 37,52 ****
our @EXPORT = qw();
use Carp qw( carp confess croak );
- use FindBin;
use GD;
use Math::Round;
use List::MoreUtils qw(uniq);
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration;
use Circos::Constants;
use Circos::Debug;
--- 37,47 ----
diff -crB circos-0.69-6/lib/Circos/Error.pm circos-0.69-6-new/lib/Circos/Error.pm
*** circos-0.69-6/lib/Circos/Error.pm 2015-03-17 22:46:36.000000000 +0100
--- circos-0.69-6-new/lib/Circos/Error.pm 2018-01-12 10:12:32.472970548 +0100
***************
*** 44,53 ****
use Params::Validate;
use Text::Format;
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Constants;
use Circos::Debug;
use Circos::Utils;
--- 44,49 ----
diff -crB circos-0.69-6/lib/Circos/Expression.pm circos-0.69-6-new/lib/Circos/Expression.pm
*** circos-0.69-6/lib/Circos/Expression.pm 2015-11-30 23:49:36.000000000 +0100
--- circos-0.69-6-new/lib/Circos/Expression.pm 2018-01-12 10:12:41.953144015 +0100
***************
*** 39,55 ****
use Carp qw( carp confess croak );
use Data::Dumper;
- use FindBin;
use Params::Validate qw(:all);
use Math::Round;
use Math::VecStat qw(average);
use List::Util qw(min max);
use Text::Balanced qw(extract_bracketed);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration;
use Circos::Constants;
use Circos::Debug;
--- 39,50 ----
diff -crB circos-0.69-6/lib/Circos/Font.pm circos-0.69-6-new/lib/Circos/Font.pm
*** circos-0.69-6/lib/Circos/Font.pm 2014-05-12 18:20:19.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Font.pm 2018-01-12 10:12:51.657320357 +0100
***************
*** 45,59 ****
);
use Carp qw( carp confess croak );
- use FindBin;
use GD::Image;
use Font::TTF::Font;
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration; # qw(%CONF $DIMS fetch_conf);
use Circos::Constants;
use Circos::Colors;
--- 45,54 ----
diff -crB circos-0.69-6/lib/Circos/Geometry.pm circos-0.69-6-new/lib/Circos/Geometry.pm
*** circos-0.69-6/lib/Circos/Geometry.pm 2014-05-12 18:20:19.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Geometry.pm 2018-01-12 10:12:58.961452282 +0100
***************
*** 41,54 ****
);
use Carp qw( carp confess croak );
- use FindBin;
use GD::Image;
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration; # qw(%CONF $DIMS fetch_conf);
use Circos::Constants;
use Circos::Debug;
--- 41,49 ----
diff -crB circos-0.69-6/lib/Circos/Heatmap.pm circos-0.69-6-new/lib/Circos/Heatmap.pm
*** circos-0.69-6/lib/Circos/Heatmap.pm 2016-03-30 22:08:12.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Heatmap.pm 2018-01-12 10:13:09.953649538 +0100
***************
*** 24,40 ****
use Carp qw( carp confess croak );
use Clone;
use Data::Dumper;
- use FindBin;
use GD::Image;
use Math::VecStat qw(min max);
use Params::Validate qw(:all);
use List::MoreUtils qw(uniq);
use Regexp::Common qw(number);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration;
use Circos::Constants;
use Circos::Colors;
--- 24,35 ----
diff -crB circos-0.69-6/lib/Circos/Ideogram.pm circos-0.69-6-new/lib/Circos/Ideogram.pm
*** circos-0.69-6/lib/Circos/Ideogram.pm 2015-11-17 01:18:53.000000000 +0100
--- circos-0.69-6-new/lib/Circos/Ideogram.pm 2018-01-12 10:13:22.045864798 +0100
***************
*** 40,46 ****
use Carp qw( carp confess croak );
use Cwd;
- use FindBin;
use File::Spec::Functions;
use Math::Round;
use Math::VecStat qw(max);
--- 40,45 ----
***************
*** 50,59 ****
use POSIX qw(floor ceil);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration;
use Circos::Constants;
use Circos::Debug;
--- 49,54 ----
diff -crB circos-0.69-6/lib/Circos/Image.pm circos-0.69-6-new/lib/Circos/Image.pm
*** circos-0.69-6/lib/Circos/Image.pm 2014-05-12 18:20:19.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Image.pm 2018-01-12 10:13:31.094024696 +0100
***************
*** 45,58 ****
);
use Carp qw( carp confess croak );
- use FindBin;
use GD::Image;
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration;
use Circos::Colors;
use Circos::Constants;
--- 45,53 ----
diff -crB circos-0.69-6/lib/Circos/IO.pm circos-0.69-6-new/lib/Circos/IO.pm
*** circos-0.69-6/lib/Circos/IO.pm 2015-12-03 05:51:11.000000000 +0100
--- circos-0.69-6-new/lib/Circos/IO.pm 2018-01-12 10:13:41.686210640 +0100
***************
*** 39,45 ****
use Carp qw( carp confess croak );
use Storable qw(dclone);
use Cwd;
- use FindBin;
use Data::Dumper;
use File::Spec::Functions;
use Math::Round;
--- 39,44 ----
***************
*** 49,58 ****
use POSIX qw(floor ceil);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Constants;
use Circos::Colors;
use Circos::Configuration;
--- 48,53 ----
diff -crB circos-0.69-6/lib/Circos/Karyotype.pm circos-0.69-6-new/lib/Circos/Karyotype.pm
*** circos-0.69-6/lib/Circos/Karyotype.pm 2014-09-09 00:15:58.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Karyotype.pm 2018-01-12 10:13:53.318413330 +0100
***************
*** 38,44 ****
use Carp qw( carp confess croak );
use Cwd;
- use FindBin;
use Math::Round;
use Math::VecStat qw(max);
use Params::Validate qw(:all);
--- 38,43 ----
***************
*** 48,57 ****
#use Regexp::Common qw(number);
#use POSIX qw(floor ceil);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration;
use Circos::Constants;
use Circos::Debug;
--- 47,52 ----
diff -crB circos-0.69-6/lib/Circos/PNG.pm circos-0.69-6-new/lib/Circos/PNG.pm
*** circos-0.69-6/lib/Circos/PNG.pm 2014-09-17 05:33:06.000000000 +0200
--- circos-0.69-6-new/lib/Circos/PNG.pm 2018-01-12 10:14:31.011059637 +0100
***************
*** 37,51 ****
our @EXPORT = qw();
use Carp qw( carp confess croak );
- use FindBin;
use GD;
use Math::VecStat qw(min max);
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration;
use Circos::Colors;
use Circos::Constants;
--- 37,46 ----
diff -crB circos-0.69-6/lib/Circos/Rule.pm circos-0.69-6-new/lib/Circos/Rule.pm
*** circos-0.69-6/lib/Circos/Rule.pm 2014-10-02 01:14:25.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Rule.pm 2018-01-12 10:14:38.195181067 +0100
***************
*** 38,51 ****
use Carp qw( carp confess croak );
use Data::Dumper;
- use FindBin;
use GD::Image;
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration; # qw(%CONF $DIMS);
use Circos::Constants;
use Circos::DataPoint;
--- 38,46 ----
diff -crB circos-0.69-6/lib/Circos/SVG.pm circos-0.69-6-new/lib/Circos/SVG.pm
*** circos-0.69-6/lib/Circos/SVG.pm 2015-11-30 23:23:52.000000000 +0100
--- circos-0.69-6-new/lib/Circos/SVG.pm 2018-01-12 10:14:47.803342631 +0100
***************
*** 26,39 ****
);
use Carp qw( carp confess croak );
- use FindBin;
use GD::Image;
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration;
use Circos::Colors;
use Circos::Constants;
--- 26,34 ----
diff -crB circos-0.69-6/lib/Circos/Text.pm circos-0.69-6-new/lib/Circos/Text.pm
*** circos-0.69-6/lib/Circos/Text.pm 2014-05-12 18:20:19.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Text.pm 2018-01-12 10:14:57.083497772 +0100
***************
*** 42,55 ****
);
use Carp qw( carp confess croak );
- use FindBin;
use GD::Image;
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration; # qw(%CONF $DIMS);
use Circos::Constants;
use Circos::Colors;
--- 42,50 ----
diff -crB circos-0.69-6/lib/Circos/Track/Highlight.pm circos-0.69-6-new/lib/Circos/Track/Highlight.pm
*** circos-0.69-6/lib/Circos/Track/Highlight.pm 2014-10-01 00:43:27.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Track/Highlight.pm 2018-01-12 10:15:06.795659206 +0100
***************
*** 37,50 ****
our @EXPORT = qw();
use Carp qw( carp confess croak );
- use FindBin;
use GD::Image;
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration; # qw(%CONF $DIMS);
use Circos::Constants;
#use Circos::Colors;
--- 37,45 ----
diff -crB circos-0.69-6/lib/Circos/Track/Link.pm circos-0.69-6-new/lib/Circos/Track/Link.pm
*** circos-0.69-6/lib/Circos/Track/Link.pm 2014-05-12 18:20:19.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Track/Link.pm 2018-01-12 10:15:17.387834198 +0100
***************
*** 37,50 ****
our @EXPORT = qw();
use Carp qw( carp confess croak );
- use FindBin;
use GD::Image;
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration; # qw(%CONF $DIMS);
use Circos::Constants;
#use Circos::Colors;
--- 37,45 ----
diff -crB circos-0.69-6/lib/Circos/Track.pm circos-0.69-6-new/lib/Circos/Track.pm
*** circos-0.69-6/lib/Circos/Track.pm 2014-09-16 05:31:46.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Track.pm 2018-01-12 10:15:29.628035063 +0100
***************
*** 41,56 ****
use Carp qw( carp confess croak );
use Data::Dumper;
- use FindBin;
use GD::Image;
use List::MoreUtils qw(uniq);
use Math::VecStat qw(min max);
use Params::Validate qw(:all);
use Regexp::Common;
use Statistics::Basic qw(average stddev);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
use Circos::Configuration; # qw(%CONF $DIMS);
use Circos::Constants;
--- 41,52 ----
diff -crB circos-0.69-6/lib/Circos/Unit.pm circos-0.69-6-new/lib/Circos/Unit.pm
*** circos-0.69-6/lib/Circos/Unit.pm 2014-05-12 18:20:19.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Unit.pm 2018-01-12 10:15:37.892169871 +0100
***************
*** 46,60 ****
);
use Carp qw( carp confess croak );
- use FindBin;
use Data::Dumper;
use Params::Validate qw(:all);
use Regexp::Common qw(number);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration qw(%CONF $DIMS);
use Circos::Constants;
use Circos::Debug;
--- 46,55 ----
diff -crB circos-0.69-6/lib/Circos/URL.pm circos-0.69-6-new/lib/Circos/URL.pm
*** circos-0.69-6/lib/Circos/URL.pm 2014-05-12 18:20:19.000000000 +0200
--- circos-0.69-6-new/lib/Circos/URL.pm 2018-01-12 10:15:46.092303006 +0100
***************
*** 39,52 ****
);
use Carp qw( carp confess croak );
- use FindBin;
use GD;
use Params::Validate qw(:all);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Configuration;
#use Circos::Colors;
use Circos::Constants;
--- 39,47 ----
diff -crB circos-0.69-6/lib/Circos/Utils.pm circos-0.69-6-new/lib/Circos/Utils.pm
*** circos-0.69-6/lib/Circos/Utils.pm 2014-10-01 21:36:19.000000000 +0200
--- circos-0.69-6-new/lib/Circos/Utils.pm 2018-01-12 10:16:11.576712858 +0100
***************
*** 105,114 ****
use POSIX qw(floor ceil);
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
-
use Circos::Constants;
use Circos::Debug;
use Circos::Error;
--- 105,110 ----
diff -crB circos-0.69-6/lib/Circos.pm circos-0.69-6-new/lib/Circos.pm
*** circos-0.69-6/lib/Circos.pm 2016-06-25 00:19:27.000000000 +0200
--- circos-0.69-6-new/lib/Circos.pm 2018-01-12 10:16:35.801097176 +0100
***************
*** 49,57 ****
use strict;
use warnings;
- use lib "$FindBin::RealBin";
- use lib "$FindBin::RealBin/../lib";
- use lib "$FindBin::RealBin/lib";
BEGIN {
require Circos::Modules;
--- 49,54 ----

15
gnu/packages/patches/gnupg-default-pinentry.patch Normal file
View File

@ -0,0 +1,15 @@
Default to the pinentry program installed in ~/.guix-profile.
diff --git a/common/homedir.c b/common/homedir.c
index e9e75d0..74e0aaf 100644
--- a/common/homedir.c
+++ b/common/homedir.c
@@ -968,7 +968,7 @@ get_default_pinentry_name (int reset)
} names[] = {
/* The first entry is what we return in case we found no
other pinentry. */
- { gnupg_bindir, DIRSEP_S "pinentry" EXEEXT_S },
+ { gnupg_homedir, "/.guix-profile/bin/pinentry" },
#ifdef HAVE_W32_SYSTEM
/* Try Gpg4win directory (with bin and without.) */
{ w32_rootdir, "\\..\\Gpg4win\\bin\\pinentry.exe" },

127
gnu/packages/patches/icu4c-CVE-2020-10531.patch Normal file
View File

@ -0,0 +1,127 @@
Fix CVE-2020-10531:
https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2020-10531
Patch copied from upstream source repository (changes to the test suite
are commented out):
https://github.com/unicode-org/icu/commit/b7d08bc04a4296982fcef8b6b8a354a9e4e7afca
From b7d08bc04a4296982fcef8b6b8a354a9e4e7afca Mon Sep 17 00:00:00 2001
From: Frank Tang <ftang@chromium.org>
Date: Sat, 1 Feb 2020 02:39:04 +0000
Subject: [PATCH] ICU-20958 Prevent SEGV_MAPERR in append
See #971
---
icu4c/source/common/unistr.cpp | 6 ++-
icu4c/source/test/intltest/ustrtest.cpp | 62 +++++++++++++++++++++++++
icu4c/source/test/intltest/ustrtest.h | 1 +
3 files changed, 68 insertions(+), 1 deletion(-)
diff --git a/icu4c/source/common/unistr.cpp b/icu4c/source/common/unistr.cpp
index 901bb3358ba..077b4d6ef20 100644
--- a/icu4c/source/common/unistr.cpp
+++ b/icu4c/source/common/unistr.cpp
@@ -1563,7 +1563,11 @@ UnicodeString::doAppend(const UChar *srcChars, int32_t srcStart, int32_t srcLeng
}
int32_t oldLength = length();
- int32_t newLength = oldLength + srcLength;
+ int32_t newLength;
+ if (uprv_add32_overflow(oldLength, srcLength, &newLength)) {
+ setToBogus();
+ return *this;
+ }
// Check for append onto ourself
const UChar* oldArray = getArrayStart();
#diff --git a/icu4c/source/test/intltest/ustrtest.cpp b/icu4c/source/test/intltest/ustrtest.cpp
#index b6515ea813c..ad38bdf53a3 100644
#--- a/icu4c/source/test/intltest/ustrtest.cpp
#+++ b/icu4c/source/test/intltest/ustrtest.cpp
#@@ -67,6 +67,7 @@ void UnicodeStringTest::runIndexedTest( int32_t index, UBool exec, const char* &
# TESTCASE_AUTO(TestWCharPointers);
# TESTCASE_AUTO(TestNullPointers);
# TESTCASE_AUTO(TestUnicodeStringInsertAppendToSelf);
#+ TESTCASE_AUTO(TestLargeAppend);
# TESTCASE_AUTO_END;
# }
#
#@@ -2310,3 +2311,64 @@ void UnicodeStringTest::TestUnicodeStringInsertAppendToSelf() {
# str.insert(2, sub);
# assertEquals("", u"abbcdcde", str);
# }
#+
#+void UnicodeStringTest::TestLargeAppend() {
#+ if(quick) return;
#+
#+ IcuTestErrorCode status(*this, "TestLargeAppend");
#+ // Make a large UnicodeString
#+ int32_t len = 0xAFFFFFF;
#+ UnicodeString str;
#+ char16_t *buf = str.getBuffer(len);
#+ // A fast way to set buffer to valid Unicode.
#+ // 4E4E is a valid unicode character
#+ uprv_memset(buf, 0x4e, len * 2);
#+ str.releaseBuffer(len);
#+ UnicodeString dest;
#+ // Append it 16 times
#+ // 0xAFFFFFF times 16 is 0xA4FFFFF1,
#+ // which is greater than INT32_MAX, which is 0x7FFFFFFF.
#+ int64_t total = 0;
#+ for (int32_t i = 0; i < 16; i++) {
#+ dest.append(str);
#+ total += len;
#+ if (total <= INT32_MAX) {
#+ assertFalse("dest is not bogus", dest.isBogus());
#+ } else {
#+ assertTrue("dest should be bogus", dest.isBogus());
#+ }
#+ }
#+ dest.remove();
#+ total = 0;
#+ for (int32_t i = 0; i < 16; i++) {
#+ dest.append(str);
#+ total += len;
#+ if (total + len <= INT32_MAX) {
#+ assertFalse("dest is not bogus", dest.isBogus());
#+ } else if (total <= INT32_MAX) {
#+ // Check that a string of exactly the maximum size works
#+ UnicodeString str2;
#+ int32_t remain = INT32_MAX - total;
#+ char16_t *buf2 = str2.getBuffer(remain);
#+ if (buf2 == nullptr) {
#+ // if somehow memory allocation fail, return the test
#+ return;
#+ }
#+ uprv_memset(buf2, 0x4e, remain * 2);
#+ str2.releaseBuffer(remain);
#+ dest.append(str2);
#+ total += remain;
#+ assertEquals("When a string of exactly the maximum size works", (int64_t)INT32_MAX, total);
#+ assertEquals("When a string of exactly the maximum size works", INT32_MAX, dest.length());
#+ assertFalse("dest is not bogus", dest.isBogus());
#+
#+ // Check that a string size+1 goes bogus
#+ str2.truncate(1);
#+ dest.append(str2);
#+ total++;
#+ assertTrue("dest should be bogus", dest.isBogus());
#+ } else {
#+ assertTrue("dest should be bogus", dest.isBogus());
#+ }
#+ }
#+}
#diff --git a/icu4c/source/test/intltest/ustrtest.h b/icu4c/source/test/intltest/ustrtest.h
#index 218befdcc68..4a356a92c7a 100644
#--- a/icu4c/source/test/intltest/ustrtest.h
#+++ b/icu4c/source/test/intltest/ustrtest.h
#@@ -97,6 +97,7 @@ class UnicodeStringTest: public IntlTest {
# void TestWCharPointers();
# void TestNullPointers();
# void TestUnicodeStringInsertAppendToSelf();
#+ void TestLargeAppend();
# };
#
# #endif

1135
gnu/packages/patches/linux-libre-support-for-Pinebook-Pro.patch Normal file
View File

File diff suppressed because it is too large Load Diff

120
gnu/packages/perl.scm
View File

@ -25,6 +25,7 @@
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Stephen J. Scheck <sscheck@cpan.org>
;;; Copyright © 2020 Vincent Legoll <vincent.legoll@gmail.com>
;;; Copyright © 2020 Paul Garlick <pgarlick@tourbillion-technology.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -53,6 +54,7 @@
#:use-module (gnu packages base)
#:use-module (gnu packages compression)
#:use-module (gnu packages freedesktop)
#:use-module (gnu packages gd)
#:use-module (gnu packages less)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages perl-check)
@ -861,6 +863,101 @@ the Carp.pm module doesn't help.")
;; Either GPLv2 or the "Artistic" license.
(license (list gpl2 artistic2.0))))
(define-public circos
(package
(name "circos")
(version "0.69-9")
(source (origin
(method url-fetch)
(uri (string-append
"http://circos.ca/distribution/circos-" version ".tgz"))
(sha256
(base32 "1ll9yxbk0v64813np0qz6h8bc53qlnhg9y1053b57xgkxgmxgn1l"))
(patches (list (search-patch "circos-remove-findbin.patch")))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; There are no tests.
#:phases
(modify-phases %standard-phases
(delete 'configure)
(delete 'build)
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(datapath (string-append out "/share/Circos"))
(error (string-append out "/share/Circos/error"))
(fonts (string-append out "/share/Circos/fonts"))
(data (string-append out "/share/Circos/data"))
(tiles (string-append out "/share/Circos/tiles"))
(etc (string-append out "/share/Circos/etc"))
(lib (string-append out "/lib/perl5/site_perl/"
,(package-version perl)))
(install-directory (lambda (source target)
(mkdir-p target)
(copy-recursively source target))))
;; Circos looks into a relative path for its configuration
;; files. We need to provide an absolute path towards the
;; corresponding paths in the store.
(substitute* '("bin/circos" "etc/colors_fonts_patterns.conf"
"etc/gddiag.conf" "etc/brewer.conf" "README")
(("<<include etc") (string-append "<<include " etc)))
(substitute* '("etc/colors.conf" "etc/image.black.conf"
"etc/patterns.conf" "etc/image.conf")
(("<<include ") (string-append "<<include " etc "/")))
(substitute* '("etc/fonts.conf" "fonts/README.fonts")
(("= fonts") (string-append "= " fonts)))
(substitute* "etc/patterns.conf"
(("= tiles") (string-append "= " tiles)))
(substitute* "lib/Circos/Error.pm"
(("error/configuration.missing.txt")
(string-append error "/configuration.missing.txt")))
(substitute* "etc/housekeeping.conf"
(("# data_path = /home/martink/circos-tutorials ")
(string-append "data_path = " datapath)))
(substitute* "lib/Circos/Configuration.pm"
(("my @possibilities = \\(")
(string-append "my @possibilities = ("
"catfile( \"" datapath "\", $arg ), "
"catfile( \"" etc "\", $arg ), "
"catfile( \"" etc "/tracks\", $arg ), ")))
(for-each install-directory
(list "error" "fonts" "data" "tiles" "etc" "lib")
(list error fonts data tiles etc lib))
(install-file "bin/circos" bin)
#t))))))
(propagated-inputs
`(("perl" ,perl)
("perl-carp" ,perl-carp)
("perl-clone" ,perl-clone)
("perl-config-general" ,perl-config-general)
("perl-digest-md5" ,perl-digest-md5)
("perl-file-temp" ,perl-file-temp)
("perl-font-ttf" ,perl-font-ttf)
("perl-gd" ,perl-gd)
("perl-getopt-long" ,perl-getopt-long)
("perl-list-allutils" ,perl-list-allutils)
("perl-math-bezier" ,perl-math-bezier)
("perl-math-round" ,perl-math-round)
("perl-math-vecstat" ,perl-math-vecstat)
("perl-memoize" ,perl-memoize)
("perl-number-format" ,perl-number-format)
("perl-params-validate" ,perl-params-validate)
("perl-readonly" ,perl-readonly)
("perl-regexp-common" ,perl-regexp-common)
("perl-set-intspan" ,perl-set-intspan)
("perl-statistics-basic" ,perl-statistics-basic)
("perl-svg" ,perl-svg)
("perl-text-balanced" ,perl-text-balanced)
("perl-text-format" ,perl-text-format)
("perl-time-hires" ,perl-time-hires)))
(home-page "http://circos.ca/")
(synopsis "Generation of circularly composited renditions")
(description
"Circos is a program for the generation of publication-quality, circularly
composited renditions of genomic data and related annotations.")
(license gpl2+)))
(define-public perl-class-accessor
(package
(name "perl-class-accessor")
@ -5177,6 +5274,29 @@ Build a Mail::Internet object, and then send it out using Mail::Mailer.
@end table")
(license perl-license)))
(define-public perl-mail-sendmail
(package
(name "perl-mail-sendmail")
(version "0.80")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://cpan/authors/id/N/NE/NEILB/Mail-Sendmail-"
version
".tar.gz"))
(sha256
(base32
"1r38qbkj7jwj8cqy1rnqzkk81psxi08b1aiq392817f3bk5ri2jv"))))
(build-system perl-build-system)
(arguments `(#:tests? #f)) ;socket not available during build
(home-page "https://metacpan.org/release/Mail-Sendmail")
(synopsis "Simple platform independent mailer")
(description "Mail::Sendmail is a pure perl module that provides a
simple means to send email from a perl script. The module only
requires Perl5 and a network connection.")
(license perl-license)))
(define-public perl-math-bezier
(package
(name "perl-math-bezier")

174
gnu/packages/python-crypto.scm
View File

@ -21,6 +21,7 @@
;;; Copyright © 2018 Nam Nguyen <namn@berkeley.edu>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2019 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2020 Alexandros Theodotou <alex@zrythm.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -45,8 +46,10 @@
#:use-module (gnu packages)
#:use-module (gnu packages check)
#:use-module (gnu packages crypto)
#:use-module (gnu packages kerberos)
#:use-module (gnu packages libffi)
#:use-module (gnu packages multiprecision)
#:use-module (gnu packages password-utils)
#:use-module (gnu packages protobuf)
#:use-module (gnu packages python)
#:use-module (gnu packages python-check)
@ -308,6 +311,31 @@ etc.). The package is structured to make adding new modules easy.")
"python"
(package-inputs pycrypto)))))))
(define-public python-kerberos
(package
(name "python-kerberos")
(version "1.3.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "kerberos" version))
(sha256
(base32
"19663qxmma0i8bfbjc2iwy5hgq0g4pfb75r023v5dps68zfvffgh"))))
(build-system python-build-system)
(inputs
`(("mit-krb5" ,mit-krb5)))
(home-page "https://github.com/apple/ccs-pykerberos")
(synopsis
"Python Kerberos library used by CalendarServer")
(description
"This Python package is a high-level wrapper for Kerberos (GSSAPI)
operations. The goal is to avoid having to build a module that wraps the
entire Kerberos.framework, and instead offer a limited set of functions that
do what is needed for client/server Kerberos authentication based on
<http://www.ietf.org/rfc/rfc4559.txt>.")
(license license:asl2.0)))
(define-public python-keyring
(package
(name "python-keyring")
@ -377,6 +405,45 @@ password storage.")
(propagated-inputs
`(("python2-pycrypto" ,python2-pycrypto))))))
(define-public python-keyrings.alt
(package
(name "python-keyrings.alt")
(version "3.4.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "keyrings.alt" version))
(sha256
(base32
"0gdjdqpq2hf770p6iwi891mil0vbsdhvy88x0v8b2w4y4b28lcli"))
(modules '((guix build utils)))
(snippet
'(begin
(delete-file "keyrings/alt/_win_crypto.py")
;; Rely on python-keyring>20:
;; https://github.com/jaraco/keyrings.alt/issues/33
(substitute* '("keyrings/alt/tests/test_Gnome.py"
"keyrings/alt/tests/test_Google.py"
"keyrings/alt/tests/test_Windows.py"
"keyrings/alt/tests/test_file.py"
"keyrings/alt/tests/test_pyfs.py")
(("keyring.tests.test_backend") "keyring.testing.backend")
(("keyring.tests.util") "keyring.testing.util"))
#t))))
(build-system python-build-system)
(native-inputs
`(("python-keyring" ,python-keyring)
("python-pytest" ,python-pytest)
("python-setuptools-scm" ,python-setuptools-scm)))
(home-page "https://github.com/jaraco/keyrings.alt")
(synopsis "Alternate keyring implementations")
(description "Keyrings in this package may have security risks or other
implications. These backends were extracted from the main keyring project to
make them available for those who wish to employ them, but are discouraged for
general production use. Include this module and use its backends at your own
risk.")
(license license:expat)))
(define-public python-certifi
(package
(name "python-certifi")
@ -1214,6 +1281,35 @@ package provides a tool to securely sign firmware images for booting by
MCUboot.")
(license license:expat)))
(define-public python-ntlm-auth
(package
(name "python-ntlm-auth")
(version "1.4.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "ntlm-auth" version))
(sha256
(base32
"16mavidki4ma5ip8srqalr19gz4f5yn3cnmmgps1fmgfr24j63rm"))))
(build-system python-build-system)
(propagated-inputs
`(("python-cryptography" ,python-cryptography)))
(home-page "https://github.com/jborean93/ntlm-auth")
(synopsis
"Calculates NTLM Authentication codes")
(description
"This library handles the low-level details of NTLM authentication for
use in authenticating with a service that uses NTLM. It will create and parse
the 3 different message types in the order required and produce a base64
encoded value that can be attached to the HTTP header.
The goal of this library is to offer full NTLM support including signing and
sealing of messages as well as supporting MIC for message integrity and the
ability to customise and set limits on the messages sent. Please see Features
and Backlog for a list of what is and is not currently supported.")
(license license:expat)))
(define-public python-secretstorage
(package
(name "python-secretstorage")
@ -1264,3 +1360,81 @@ items and collections, editing items, locking and unlocking collections
"This is a low-level, pure Python DBus protocol client. It has an
I/O-free core, and integration modules for different event loops.")
(license license:expat)))
(define-public python-argon2-cffi
(package
(name "python-argon2-cffi")
(version "19.2.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "argon2-cffi" version))
(sha256
(base32
"18xxfw30gi3lwaz4vwb05iavzlrk3fa1x9fippzrgd3px8z65apz"))
(modules '((guix build utils)))
(snippet '(begin (delete-file-recursively "extras") #t))))
(build-system python-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(replace 'build
(lambda _
(setenv "ARGON2_CFFI_USE_SYSTEM" "1")
(invoke "python" "setup.py" "build")))
(replace 'check
(lambda* (#:key inputs outputs #:allow-other-keys)
(add-installed-pythonpath inputs outputs)
(invoke "pytest")
(invoke "python" "-m" "argon2" "--help")
;; see tox.ini
(invoke "python" "-m" "argon2" "-n" "1" "-t" "1" "-m" "8" "-p" "1"))))))
(propagated-inputs
`(("python-cffi" ,python-cffi)
("python-six" ,python-six)))
(inputs `(("argon2" ,argon2)))
(native-inputs
`(("python-hypothesis" ,python-hypothesis)
("python-pytest" ,python-pytest)))
(home-page "https://argon2-cffi.readthedocs.io/")
(synopsis "Secure Password Hashes for Python")
(description
"Argon2 is a secure password hashing algorithm. It is designed to have
both a configurable runtime as well as memory consumption. This means that you
can decide how long it takes to hash a password and how much memory is required.")
(license license:expat)))
(define-public python-privy
(package
(name "python-privy")
(version "6.0.0")
(source
(origin
(method git-fetch)
(uri (git-reference
;; Releases are untagged
(url "https://github.com/ofek/privy")
(commit "2838db3df239797c71bddacc48a4c49a83f35747")))
(file-name (git-file-name name version))
(sha256
(base32
"1m32dh5fqc8cy7jyf1z5fs6zvmdkbq5fi98hr609gbl7s0l0y0i9"))))
(build-system python-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
(invoke "python" "-m" "pytest"))))))
(native-inputs
`(("python-pytest" ,python-pytest)))
(propagated-inputs
`(("python-argon2-cffi" ,python-argon2-cffi)
("python-cryptography" ,python-cryptography)))
(home-page "https://www.dropbox.com/developers")
(synopsis "Library to password-protect your data")
(description
"Privy is a small and fast utility for password-protecting secret
data such as API keys, cryptocurrency wallets, or seeds for digital
signatures.")
(license (list license:expat license:asl2.0)))) ; dual licensed

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

@ -33,6 +33,7 @@
;;; Copyright © 2019 Tanguy Le Carrour <tanguy@bioneland.org>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020 Evan Straw <evan.straw99@gmail.com>
;;; Copyright © 2020 Alexandros Theodotou <alex@zrythm.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -1422,6 +1423,30 @@ than Python’s urllib2 library.")
(define-public python2-requests
(package-with-python2 python-requests))
(define-public python-requests_ntlm
(package
(name "python-requests_ntlm")
(version "1.1.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "requests_ntlm" version))
(sha256
(base32
"0wgbqzaq9w7bas16b7brdb75f91bh3275fb459093bk1ihpck2ci"))))
(build-system python-build-system)
(propagated-inputs
`(("python-cryptography" ,python-cryptography)
("python-ntlm-auth" ,python-ntlm-auth)
("python-requests" ,python-requests)))
(home-page "https://github.com/requests/requests-ntlm")
(synopsis
"NTLM authentication support for Requests")
(description
"This package allows for HTTP NTLM authentication using the requests
library.")
(license license:isc)))
(define-public python-requests-mock
(package
(name "python-requests-mock")
@ -2036,6 +2061,7 @@ provide an easy-to-use Python interface for building OAuth1 and OAuth2 clients."
`(#:tests? #f))
(propagated-inputs
`(("python-requests" ,python-requests)
("python-msgpack" ,python-msgpack)
("python-lockfile" ,python-lockfile)))
(home-page "https://github.com/ionrock/cachecontrol")
(synopsis "The httplib2 caching algorithms for use with requests")

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

@ -59,18 +59,21 @@
;;; Copyright © 2019, 2020 Brett Gilio <brettg@gnu.org>
;;; Copyright © 2019 Sam <smbaines8@gmail.com>
;;; Copyright © 2019 Jack Hill <jackhill@jackhill.us>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2019, 2020 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2019 Jacob MacDonald <jaccarmac@gmail.com>
;;; Copyright © 2019 Giacomo Leidi <goodoldpaul@autistici.org>
;;; Copyright © 2019 Wiktor Żelazny <wzelazny@vurv.cz>
;;; Copyright © 2019 Tanguy Le Carrour <tanguy@bioneland.org>
;;; Copyright © 2019, 2020 Tanguy Le Carrour <tanguy@bioneland.org>
;;; Copyright © 2019 Mădălin Ionel Patrașcu <madalinionel.patrascu@mdc-berlin.de>
;;; Copyright © 2020 Riku Viitanen <riku.viitanen@protonmail.com>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020 sirgazil <sirgazil@zoho.com>
;;; Copyright © 2020 Sebastian Schott <sschott@mailbox.org>
;;; Copyright © 2020 Alexandros Theodotou <alex@zrythm.org>
;;; Copyright © 2020 Josh Marshall <joshua.r.marshall.1991@gmail.com>
;;; Copyright © 2020 Alexandros Theodotou <alex@zrythm.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -111,6 +114,7 @@
#:use-module (gnu packages gnome)
#:use-module (gnu packages graphviz)
#:use-module (gnu packages graphics)
#:use-module (gnu packages gsasl)
#:use-module (gnu packages gstreamer)
#:use-module (gnu packages gtk)
#:use-module (gnu packages icu4c)
@ -2269,19 +2273,20 @@ compare, diff, and patch JSON and JSON-like structures in Python.")
(define-public python-jsonschema
(package
(name "python-jsonschema")
(version "3.0.1")
(version "3.2.0")
(source (origin
(method url-fetch)
(uri (pypi-uri "jsonschema" version))
(sha256
(base32
"03g20i1xfg4qdlk4475pl4pp7y0h37g1fbgs5qhy678q9xb822hc"))))
"0ykr61yiiizgvm3bzipa3l73rvj49wmrybbfwhvpgk3pscl5pa68"))))
(build-system python-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
(lambda* (#:key inputs outputs #:allow-other-keys)
(add-installed-pythonpath inputs outputs)
(setenv "PYTHONPATH" (string-append ".:" (getenv "PYTHONPATH")))
(invoke "trial" "jsonschema"))))))
(native-inputs
@ -2289,6 +2294,7 @@ compare, diff, and patch JSON and JSON-like structures in Python.")
("python-twisted" ,python-twisted)))
(propagated-inputs
`(("python-attrs" ,python-attrs)
("python-importlib-metadata" ,python-importlib-metadata) ;; python < 3.8
("python-pyrsistent" ,python-pyrsistent)
("python-six" ,python-six)))
(home-page "https://github.com/Julian/jsonschema")
@ -5045,6 +5051,35 @@ localized only in frequency instead of in time and frequency.")
(define-public python2-pywavelets
(package-with-python2 python-pywavelets))
(define-public python-pywinrm
(package
(name "python-pywinrm")
(version "0.4.1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "pywinrm" version))
(sha256
(base32
"10gabhhg3rgacd5ahmi2r128z99fzbrbx6mz1nnq0dxmhmn5rpjf"))))
(build-system python-build-system)
(propagated-inputs
`(("python-six" ,python-six)
("python-requests_ntlm" ,python-requests_ntlm)
("python-xmltodict" ,python-xmltodict)
("python-kerberos" ,python-kerberos)))
(native-inputs
`(("python-mock" ,python-mock)
("python-pytest" ,python-pytest)))
(home-page "https://github.com/diyan/pywinrm/")
(synopsis
"Python library for Windows Remote Management (WinRM)")
(description
"pywinrm is a Python client for the Windows Remote Management (WinRM)
service. It allows you to invoke commands on target Windows machines from
any machine that can run Python.")
(license license:expat)))
(define-public python-xcffib
(package
(name "python-xcffib")
@ -5337,13 +5372,13 @@ displayed.")
(define-public python-pexpect
(package
(name "python-pexpect")
(version "4.6.0")
(version "4.8.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "pexpect" version))
(sha256
(base32 "1fla85g47iaxxpjhp9vkxdnv4pgc7rplfy6ja491smrrk0jqi3ia"))))
(base32 "032cg337h8awydgypz6f4wx848lw8dyrj4zy988x0lyib4ws8rgw"))))
(build-system python-build-system)
(arguments
`(#:phases
@ -5357,7 +5392,10 @@ displayed.")
;; Many tests try to use the /bin directory which
;; is not present in the build environment.
;; Use one that's non-empty and unlikely to change.
(("/bin'") "/dev'"))
(("/bin'") "/dev'")
;; Disable failing test. See upstream bug report
;; https://github.com/pexpect/pexpect/issues/568
(("def test_bash") "def _test_bash"))
;; XXX: Socket connection test gets "Connection reset by peer".
;; Why does it not work? Delete for now.
(delete-file "tests/test_socket.py")
@ -7465,13 +7503,13 @@ should be stored on various operating systems.")
(define-public python-msgpack
(package
(name "python-msgpack")
(version "0.5.6")
(version "1.0.0")
(source (origin
(method url-fetch)
(uri (pypi-uri "msgpack" version))
(sha256
(base32
"1hz2dba1nvvn52afg34liijsm7kn65cmn06dl0xbwld6bb4cis0f"))))
"1h5mxh84rcw04dvxy1qbfn2hisavfqgilh9k09rgyjhd936dad4m"))))
(build-system python-build-system)
(arguments
`(#:modules ((guix build utils)
@ -7507,6 +7545,13 @@ reading and writing MessagePack data.")
(package
(inherit python-msgpack)
(name "python-msgpack-transitional")
(version "0.5.6")
(source (origin
(method url-fetch)
(uri (pypi-uri "msgpack" version))
(sha256
(base32
"1hz2dba1nvvn52afg34liijsm7kn65cmn06dl0xbwld6bb4cis0f"))))
(arguments
(substitute-keyword-arguments (package-arguments python-msgpack)
((#:phases phases)
@ -8234,22 +8279,24 @@ Jupyter Notebook format and Python APIs for working with notebooks.")
(define-public python-bleach
(package
(name "python-bleach")
(version "3.1.1")
(version "3.1.3")
(source
(origin
(method url-fetch)
(uri (pypi-uri "bleach" version))
(sha256
(base32
"0j4xlnw99m1xy0s7wxz9fk5f3c1n8r296fh75jn5p5j61w6qg2xa"))))
"0al437aw4p2xp83az5hhlrp913nsf0cg6kg4qj3fjhv4wakxipzq"))))
(build-system python-build-system)
(propagated-inputs
`(("python-webencodings" ,python-webencodings)
("python-six" ,python-six)))
(native-inputs
`(("python-pytest" ,python-pytest)
("python-pytest-runner" ,python-pytest-runner-2)))
(home-page "https://github.com/jsocol/bleach")
`(("python-datrie" ,python-datrie)
("python-genshi" ,python-genshi)
("python-lxml" ,python-lxml)
("python-pytest" ,python-pytest)))
(home-page "https://github.com/mozilla/bleach")
(synopsis "Whitelist-based HTML-sanitizing tool")
(description "Bleach is an easy whitelist-based HTML-sanitizing tool.")
(license license:asl2.0)))
@ -11216,14 +11263,14 @@ more, possibly remote, memcached servers.")
(define-public python-clikit
(package
(name "python-clikit")
(version "0.4.1")
(version "0.4.2")
(source
(origin
(method url-fetch)
(uri (pypi-uri "clikit" version))
(sha256
(base32
"10gab65pq0jdf589n33sj2513pxal2lisl4xwf1ijysdjxmpdr4a"))))
"1jnnr21hvzx4i29nbph1z96ympv0njiwyvngjq48w1q05133cwzn"))))
(build-system python-build-system)
(propagated-inputs
`(("python-pastel" ,python-pastel)
@ -11269,18 +11316,26 @@ strings require only one extra byte in addition to the strings themselves.")
(define-public python-cachy
(package
(name "python-cachy")
(version "0.2.0")
(version "0.3.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "cachy" version))
(sha256
(base32
"0v6mjyhgx6j7ya20bk69cr3gdzdkdf6psay0h090rscclgji65dp"))))
"1cb9naly8ampzlky7h74n5wj628l7jkpsh0c0jz0namlrvs82r8q"))))
(build-system python-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _ (invoke "pifpaf" "run" "memcached" "--port" "11211" "--"
"pytest"))))))
(native-inputs
`(("python-fakeredis" ,python-fakeredis)
`(("memcached" ,memcached)
("python-fakeredis" ,python-fakeredis)
("python-flexmock" ,python-flexmock)
("python-pifpaf" ,python-pifpaf)
("python-pytest" ,python-pytest)))
(propagated-inputs
`(("python-memcached" ,python-memcached)
@ -11297,34 +11352,38 @@ database, file, dict stores. Cachy supports python versions 2.7+ and 3.2+.")
(define-public poetry
(package
(name "poetry")
(version "0.12.17")
;; Poetry can only be built from source with poetry.
(version "1.0.5")
;; Poetry can only be built from source with Poetry.
(source
(origin
(method url-fetch)
(uri (pypi-uri "poetry" version))
(sha256
(base32
"0gxwcd65qjmzqzppf53x51sic1rbcd9py6cdzx3aprppipimslvf"))))
"02h387k0xssvv78yy82pcpknpq4w5ym2in1zl8cg9r5wljl5w6cf"))))
(build-system python-build-system)
(arguments
`(#:tests? #f ;; Pypi does not have tests.
#:phases
(modify-phases %standard-phases
(replace 'build
(add-before 'build 'patch-setup-py
(lambda _
;; Bug in poetry https://github.com/sdispater/poetry/issues/866.
(invoke "sed" "-i" "-e" "s/from distutils.core/from setuptools/"
"setup.py")
(substitute* "setup.py"
;; poetry won't update version as 21.0.0 relies on python > 3.6
(("keyring>=20.0.1,<21.0.0") "keyring>=21.0.0,<22.0.0")
(("pyrsistent>=0.14.2,<0.15.0") "pyrsistent>=0.14.2,<0.16.0")
(("importlib-metadata>=1.1.3,<1.2.0") "importlib-metadata>=1.1.3,<1.5.0"))
#t)))))
(propagated-inputs
`(("python-cachecontrol" ,python-cachecontrol)
("python-cachy" ,python-cachy)
("python-cleo" ,python-cleo)
("python-glob2" ,python-glob2)
("python-clikit" ,python-clikit)
("python-html5lib" ,python-html5lib)
("python-importlib-metadata" ,python-importlib-metadata) ;; python < 3.8
("python-jsonschema" ,python-jsonschema)
("python-msgpack" ,python-msgpack)
("python-keyring" ,python-keyring)
("python-pexpect" ,python-pexpect)
("python-pkginfo" ,python-pkginfo)
("python-pyparsing" ,python-pyparsing)
("python-pyrsistent" ,python-pyrsistent)
@ -11333,7 +11392,7 @@ database, file, dict stores. Cachy supports python versions 2.7+ and 3.2+.")
("python-shellingham" ,python-shellingham)
("python-tomlkit" ,python-tomlkit)
("python-virtualenv" ,python-virtualenv)))
(home-page "https://poetry.eustace.io/")
(home-page "https://python-poetry.org")
(synopsis "Python dependency management and packaging made easy")
(description "Poetry is a tool for dependency management and packaging
in Python. It allows you to declare the libraries your project depends on and
@ -16150,6 +16209,39 @@ MacFUSE. The binding is created using the standard @code{ctypes} library.")
(define-public python2-fusepy
(package-with-python2 python-fusepy))
(define-public python-fusepyng
(package
(name "python-fusepyng")
(version "1.0.7")
(source
(origin
(method url-fetch)
(uri (pypi-uri "fusepyng" version))
(sha256
(base32
"17w9iw6m6zjbmnhs4ikd27pq4mb1nan6k4ahlwyz40463vw6wkwb"))))
(build-system python-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'set-libfuse-path
(lambda* (#:key inputs #:allow-other-keys)
(let ((fuse (assoc-ref inputs "fuse")))
(substitute* "fusepyng.py"
(("os.environ.get\\('FUSE_LIBRARY_PATH'\\)")
(string-append "\"" fuse "/lib/libfuse.so\""))))
#t)))))
(inputs
`(("fuse" ,fuse)))
(propagated-inputs
`(("python-paramiko" ,python-paramiko)))
(home-page "https://github.com/rianhunter/fusepyng")
(synopsis "Simple ctypes bindings for FUSE")
(description "@code{fusepyng} is a Python module that provides a simple
interface to FUSE on various operating systems. It's just one file and is
implemented using @code{ctypes}.")
(license license:isc)))
(define-public python2-gdrivefs
(package
(name "python2-gdrivefs")
@ -16191,6 +16283,27 @@ MacFUSE. The binding is created using the standard @code{ctypes} library.")
under Python 2.7.")
(license license:gpl2)))
(define-public python-userspacefs
(package
(name "python-userspacefs")
(version "1.0.13")
(source
(origin
(method url-fetch)
(uri (pypi-uri "userspacefs" version))
(sha256
(base32
"0kyz52jyxw3m7hqvn5g6z0sx9cq6k0nq1wj44lvdrghdljjgyk2z"))))
(build-system python-build-system)
(propagated-inputs
`(("python-fusepyng" ,python-fusepyng)))
(home-page "https://github.com/rianhunter/userspacefs")
(synopsis "User-space file systems for Python")
(description
"@code{userspacefs} is a library that allows you to easily write
user-space file systems in Python.")
(license license:gpl3+)))
(define-public pybind11
(package
(name "pybind11")
@ -16781,6 +16894,11 @@ that is accessible to other projects developed in Cython.")
;; FIXME: Tests require many extra dependencies, and would introduce
;; a circular dependency on hypothesis, which uses this package.
'(#:tests? #f))
(propagated-inputs
`(("python-appdirs" ,python-appdirs)
("python-distlib" ,python-distlib)
("python-filelock" ,python-filelock)
("python-six" ,python-six-bootstrap)))
(home-page "http://www.grantjenks.com/docs/sortedcontainers/")
(synopsis "Sorted List, Sorted Dict, Sorted Set")
(description
@ -18464,3 +18582,202 @@ sequences.")
(define-public python2-fuzzywuzzy
(package-with-python2 python-fuzzywuzzy))
(define-public python-block-tracing
(package
(name "python-block-tracing")
(version "1.0.1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "block_tracing" version))
(sha256
(base32
"0s2y729qr5rs7n506qfh8cssk8m2bi6k2y5vbrh2z3raf2d01alz"))))
(build-system python-build-system)
(arguments '(#:tests? #f)) ; no tests
(home-page "https://github.com/rianhunter/block_tracing")
(synopsis "Protect process memory")
(description
"@code{block_tracing} is a tiny Python library that can be used to
prevent debuggers and other applications from inspecting the memory within
your process.")
(license license:expat)))
(define-public python-gcovr
(package
(name "python-gcovr")
(version "4.2")
(source
(origin
(method url-fetch)
(uri (pypi-uri "gcovr" version))
(sha256
(base32
"0gyady7x3v3l9fm1zan0idaggqqcm31y7g5vxk7h05p5h7f39bjs"))))
(build-system python-build-system)
(propagated-inputs
`(("python-lxml" ,python-lxml)
("python-jinja2" ,python-jinja2)))
(home-page "https://gcovr.com/")
(synopsis "Utility for generating code coverage results")
(description
"Gcovr provides a utility for managing the use of the GNU gcov
utility and generating summarized code coverage results. It is inspired
by the Python coverage.py package, which provides a similar utility for
Python.")
(license license:bsd-3)))
(define-public python-owslib
(package
(name "python-owslib")
(version "0.19.2")
(source
(origin
(method url-fetch)
(uri (pypi-uri "OWSLib" version))
(sha256
(base32 "0v8vg0naa9rywvd31cpq65ljbdclpsrx09788v4xj7lg10np8nk0"))))
(build-system python-build-system)
(arguments
'(#:tests? #f)) ; TODO: package dependencies required for tests.
(synopsis "Interface for Open Geospatial Consortium web service")
(description
"OWSLib is a Python package for client programming with Open Geospatial
Consortium (OGC) web service (hence OWS) interface standards, and their related
content models.")
(home-page "https://geopython.github.io/OWSLib/")
(license license:bsd-3)))
(define-public python-docusign-esign
(package
(name "python-docusign-esign")
(version "3.1.0")
(source (origin
(method url-fetch)
(uri (pypi-uri "docusign_esign" version))
(sha256
(base32
"01f3h03vc97syjlmqyl7xa5j90pzgmwpspc5a0gra9saynnbkx37"))))
(build-system python-build-system)
;; Testing requires undocumented setup changes, and so testing is disabled here.
(arguments `(#:tests? #f))
(propagated-inputs
`(("python-certifi", python-certifi)
("python-six", python-six)
("python-dateutil", python-dateutil)
("python-urllib3", python-urllib3)
("python-pyjwt", python-pyjwt)
("python-cryptography", python-cryptography)
("python-nose", python-nose)))
(synopsis "DocuSign Python Client")
(description "The Official DocuSign Python Client Library used to interact
with the eSign REST API. Send, sign, and approve documents using this client.")
(home-page "https://www.docusign.com/devcenter")
(license license:expat)))
(define-public python-xattr
(package
(name "python-xattr")
(version "0.9.7")
(source
(origin
(method url-fetch)
(uri (pypi-uri "xattr" version))
(sha256
(base32
"0i4xyiqbhjz2g16zbim17zjdbjkw79xsw8k59942vvq4is1cmfxh"))))
(build-system python-build-system)
(propagated-inputs
`(("python-cffi" ,python-cffi)))
(home-page "https://github.com/xattr/xattr")
(synopsis
"Python wrapper for extended filesystem attributes")
(description "This package provides a Python wrapper for using extended
filesystem attributes. Extended attributes extend the basic attributes of files
and directories in the file system. They are stored as name:data pairs
associated with file system objects (files, directories, symlinks, etc).")
(license license:expat)))
(define-public python-json-logger
(package
(name "python-json-logger")
(version "0.1.11")
(source
(origin
(method url-fetch)
(uri (pypi-uri "python-json-logger" version))
(sha256
(base32
"10g2ya6nsvn5vxzvq2wb8q4d43i3d7756i5rxyjna6d0y9i138xp"))))
(build-system python-build-system)
(home-page
"https://github.com/madzak/python-json-logger")
(synopsis "JSON log formatter in Python")
(description "This library allows standard Python logging to output log data
as JSON objects. With JSON we can make our logs more readable by machines and
we can stop writing custom parsers for syslog-type records.")
(license license:bsd-3)))
(define-public python-daiquiri
(package
(name "python-daiquiri")
(version "2.1.1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "daiquiri" version))
(sha256
(base32
"1qmank3c217ddiig3xr8ps0mqaydcp0q5a62in9a9g4zf72zjnqd"))))
(build-system python-build-system)
(propagated-inputs
`(("python-json-logger" ,python-json-logger)))
(native-inputs
`(("python-mock" ,python-mock)
("python-pytest" ,python-pytest)
("python-setuptools-scm" ,python-setuptools-scm)
("python-six" ,python-six)))
(home-page "https://github.com/jd/daiquiri")
(synopsis
"Library to configure Python logging easily")
(description "The daiquiri library provides an easy way to configure
logging in Python. It also provides some custom formatters and handlers.")
(license license:asl2.0)))
(define-public python-pifpaf
(package
(name "python-pifpaf")
(version "2.4.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "pifpaf" version))
(sha256
(base32
"150av2pylsjy8ykrpyi0vzy2q24s9rhh2ya01zvwnvj9j5dspviz"))))
(build-system python-build-system)
(arguments
`(#:tests? #f))
(propagated-inputs
`(("python-click" ,python-click)
("python-daiquiri" ,python-daiquiri)
("python-fixtures" ,python-fixtures)
("python-jinja2" ,python-jinja2)
("python-pbr" ,python-pbr)
("python-psutil" ,python-psutil)
("python-six" ,python-six)
("python-xattr" ,python-xattr)))
(native-inputs
`(("python-mock" ,python-mock)
("python-os-testr" ,python-os-testr)
("python-requests" ,python-requests)
("python-testrepository" ,python-testrepository)
("python-testtools" ,python-testtools)))
(home-page "https://github.com/jd/pifpaf")
(synopsis "Tools and fixtures to manage daemons for testing in Python")
(description "Pifpaf is a suite of fixtures and a command-line tool that
allows to start and stop daemons for a quick throw-away usage. This is typically
useful when needing these daemons to run integration testing. It originally
evolved from its precursor @code{overtest}.")
(license license:asl2.0)))

3
gnu/packages/rdf.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2015, 2016, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2020 Alexandros Theodotou <alex@zrythm.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -319,6 +320,8 @@ ideal (e.g. in LV2 implementations or embedded applications).")
(string-append "-Wl,-rpath="
(assoc-ref outputs "out") "/lib"))
#t)))))
(inputs
`(("pcre" ,pcre)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(propagated-inputs

26
gnu/packages/statistics.scm
View File

@ -2,7 +2,7 @@
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Vicente Vera Parra <vicentemvp@gmail.com>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2016, 2017, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Pjotr Prins <pjotr.guix@thebird.nl>
;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
@ -1762,14 +1762,14 @@ side.")
(define-public r-locfit
(package
(name "r-locfit")
(version "1.5-9.1")
(version "1.5-9.2")
(source
(origin
(method url-fetch)
(uri (cran-uri "locfit" version))
(sha256
(base32
"0lafrmq1q7x026m92h01hc9cjjiximqqi3v1g2hw7ai9vf7i897m"))))
"00l0s6cxnv95zybkgki0380fih2kr1kbm7m88x56phklln3nx27b"))))
(build-system r-build-system)
(propagated-inputs
`(("r-lattice" ,r-lattice)))
@ -3134,13 +3134,13 @@ using the multicore functionality of the parallel package.")
(define-public r-dt
(package
(name "r-dt")
(version "0.12")
(version "0.13")
(source (origin
(method url-fetch)
(uri (cran-uri "DT" version))
(sha256
(base32
"0089288ma1cj9nf4jscmpbagyqlg4r90mw8bwl4zv1d4hjl0d693"))))
"1db35mi4m4q3kha4vhvh693bv04y7h9pdawhsx8f234qjvz7783r"))))
(properties
`((upstream-name . "DT")))
(build-system r-build-system)
@ -3151,6 +3151,8 @@ using the multicore functionality of the parallel package.")
("r-jsonlite" ,r-jsonlite)
("r-magrittr" ,r-magrittr)
("r-promises" ,r-promises)))
(native-inputs
`(("r-knitr" ,r-knitr)))
(home-page "https://rstudio.github.io/DT")
(synopsis "R wrapper of the DataTables JavaScript library")
(description
@ -3166,7 +3168,7 @@ Shiny). The @code{DataTables} library has been included in this R package.")
(license (list license:gpl3
license:expat
license:asl2.0
(license:non-copyleft "http://www.wtfpl.net/txt/copying/")))))
license:wtfpl2))))
(define-public r-base64enc
(package
@ -3238,14 +3240,14 @@ path-wise fashion.")
(define-public r-pkgmaker
(package
(name "r-pkgmaker")
(version "0.31")
(version "0.31.1")
(source
(origin
(method url-fetch)
(uri (cran-uri "pkgmaker" version))
(sha256
(base32
"0cc6v6kpwxwwh7k7zyw13wqdp0f9qzzr1a7vv02lskgii54aa4nb"))))
"0r0ga20dy25v9y5gjbds4y6kaa5a7qknh503qdkzllcpzbibh0hp"))))
(build-system r-build-system)
(propagated-inputs
`(("r-assertthat" ,r-assertthat)
@ -3964,13 +3966,13 @@ package instead.")
(define-public r-hmisc
(package
(name "r-hmisc")
(version "4.3-1")
(version "4.4-0")
(source
(origin
(method url-fetch)
(uri (cran-uri "Hmisc" version))
(sha256
(base32 "02ni7719acdmc8pcbx07b7x2nqsjrwq4smnx9qlzqjmx4pmp3cwc"))))
(base32 "1ivfamwghd2z408fkhs7jy5zl3q0z1a2la16yi8js872br6cyvpi"))))
(properties `((upstream-name . "Hmisc")))
(build-system r-build-system)
(native-inputs
@ -4757,14 +4759,14 @@ can be efficiently implemented directly in the R language.")
(define-public r-robustbase
(package
(name "r-robustbase")
(version "0.93-5")
(version "0.93-6")
(source
(origin
(method url-fetch)
(uri (cran-uri "robustbase" version))
(sha256
(base32
"0mkzbsjl5nihyj7mzks14p6kr3spp44xvygjz4ran11gspdn9rdx"))))
"1cr478xi4n9jwsdpbq182a7ig47rpb413q28dz6d1am08sk6657a"))))
(build-system r-build-system)
(native-inputs
`(("gfortran" ,gfortran)))

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

@ -154,14 +154,14 @@ as well as the classic centralized workflow.")
(name "git")
;; XXX When updating Git, check if the special 'git-source' input to cgit
;; needs to be updated as well.
(version "2.25.2")
(version "2.26.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://kernel.org/software/scm/git/git-"
version ".tar.xz"))
(sha256
(base32
"08vivrv3my8nlp40pwsf7mcc5k7dwyh34hadjszx7qj8w01p34wv"))))
"1mlmwibfgcv42c28fxmbd3iim8fc06r17dljd8vdgq550z5hvkly"))))
(build-system gnu-build-system)
(native-inputs
`(("native-perl" ,perl)
@ -178,7 +178,7 @@ as well as the classic centralized workflow.")
version ".tar.xz"))
(sha256
(base32
"06nlw6vaqvavkr4nia9qvanqbhaig4hbg9r5f0i9lbvw1hmykfvq"))))
"09ilv5gg7167mwc0qqw2fz3lmdm360crnxc0xzkqn53wnsh4cziq"))))
;; For subtree documentation.
("asciidoc" ,asciidoc-py3)
("docbook-xsl" ,docbook-xsl)
@ -354,8 +354,10 @@ as well as the classic centralized workflow.")
(add-after 'install 'install-credential-netrc
(lambda* (#:key outputs #:allow-other-keys)
(let* ((netrc (assoc-ref outputs "credential-netrc")))
(install-file "contrib/credential/netrc/git-credential-netrc"
(install-file "contrib/credential/netrc/git-credential-netrc.perl"
(string-append netrc "/bin"))
(rename-file (string-append netrc "/bin/git-credential-netrc.perl")
(string-append netrc "/bin/git-credential-netrc"))
;; Previously, Git.pm was automatically found by netrc.
;; Perl 5.26 changed how it locates modules so that @INC no
;; longer includes the current working directory (the Perl

19
gnu/packages/video.scm
View File

@ -37,6 +37,7 @@
;;; Copyright © 2019 Riku Viitanen <riku.viitanen@protonmail.com>
;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2020 Josh Holland <josh@inv.alid.pw>
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;;
;;; This file is part of GNU Guix.
;;;
@ -750,7 +751,7 @@ ASS/SSA (Advanced Substation Alpha/SubStation Alpha) subtitle format.")
pixels, so that it can work on older video cards or text terminals. It
supports Unicode, 2048 colors, dithering of color images, and advanced text
canvas operations.")
(license (license:fsf-free "file://COPYING")))) ;WTFPL version 2
(license license:wtfpl2)))
(define-public libdca
(package
@ -1671,6 +1672,15 @@ To load this plugin, specify the following option when starting mpv:
(string-append "'" prefix "/etc/"))
(("'share/")
(string-append "'" prefix "/share/")))
#t)))
(add-after 'install 'install-completion
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(zsh (string-append out
"/share/zsh/site-functions")))
(mkdir-p zsh)
(copy-file "youtube-dl.zsh"
(string-append zsh "/_youtube-dl"))
#t))))))
(synopsis "Download videos from YouTube.com and other sites")
(description
@ -1817,7 +1827,7 @@ audio, images) from the Web. It can use either mpv or vlc for playback.")
(define-public youtube-viewer
(package
(name "youtube-viewer")
(version "3.7.4")
(version "3.7.5")
(source (origin
(method git-fetch)
(uri (git-reference
@ -1826,7 +1836,7 @@ audio, images) from the Web. It can use either mpv or vlc for playback.")
(file-name (git-file-name name version))
(sha256
(base32
"1plsm1sc04lwlg5h2gapxpykc3cpd4frjll14lamql89dm4a50vi"))))
"1caz56sxy554avz2vdv9gm7gyqcq0gyixzrh5v9ixmg6vxif5d4f"))))
(build-system perl-build-system)
(native-inputs
`(("perl-module-build" ,perl-module-build)))
@ -1835,6 +1845,7 @@ audio, images) from the Web. It can use either mpv or vlc for playback.")
("perl-file-sharedir" ,perl-file-sharedir)
("perl-gtk2" ,perl-gtk2)
("perl-json" ,perl-json)
("perl-json-xs" ,perl-json-xs)
("perl-libwww" ,perl-libwww)
("perl-lwp-protocol-https" ,perl-lwp-protocol-https)
("perl-lwp-useragent-cached" ,perl-lwp-useragent-cached)
@ -1849,7 +1860,7 @@ audio, images) from the Web. It can use either mpv or vlc for playback.")
`(#:modules ((guix build perl-build-system)
(guix build utils)
(srfi srfi-26))
#:module-build-flags '("--gtk")
#:module-build-flags '("--gtk2")
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'refer-to-inputs

28
gnu/packages/virtualization.scm
View File

@ -306,34 +306,6 @@ server and embedded PowerPC, and S390 guests.")
'("libusb" "mesa" "sdl2" "spice" "virglrenderer" "gtk+"
"usbredir" "libdrm" "libepoxy" "pulseaudio" "vde2")))))
;; The GRUB test suite fails with later versions of Qemu, so we
;; keep it at 2.10 for now. See
;; <https://lists.gnu.org/archive/html/bug-grub/2018-02/msg00004.html>.
;; This package is hidden since we do not backport updates to it.
(define-public qemu-minimal-2.10
(hidden-package
(package
(inherit qemu-minimal)
(version "2.10.2")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qemu.org/qemu-"
version ".tar.xz"))
(sha256
(base32
"17w21spvaxaidi2am5lpsln8yjpyp2zi3s3gc6nsxj5arlgamzgw"))
(patches
(search-patches "qemu-glibc-2.27.patch"))))
;; qemu-minimal-2.10 needs Python 2. Remove below once no longer necessary.
(native-inputs `(("python-2" ,python-2)
,@(fold alist-delete (package-native-inputs qemu-minimal)
'("python-wrapper" "python-sphinx"))))
(inputs
(fold alist-delete (package-inputs qemu-minimal)
;; Disable seccomp support, because it's not required for the GRUB
;; test suite, and because it fails with libseccomp 2.4.2 and later.
'("libseccomp"))))))
(define-public libosinfo
(package
(name "libosinfo")

6
gnu/packages/wm.scm
View File

@ -30,7 +30,7 @@
;;; Copyright © 2019 Evan Straw <evan.straw99@gmail.com>
;;; Copyright © 2019 Brett Gilio <brettg@gnu.org>
;;; Copyright © 2019 Noodles! <nnoodle@chiru.no>
;;; Copyright © 2019 Alexandru-Sergiu Marton <brown121407@member.fsf.org>
;;; Copyright © 2019, 2020 Alexandru-Sergiu Marton <brown121407@member.fsf.org>
;;; Copyright © 2020 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;;
@ -338,7 +338,7 @@ many programming languages.")
(define-public i3-gaps
(package (inherit i3-wm)
(name "i3-gaps")
(version "4.17.1")
(version "4.18")
(source (origin
(method url-fetch)
(uri (string-append
@ -346,7 +346,7 @@ many programming languages.")
version "/i3-" version ".tar.bz2"))
(sha256
(base32
"0gqcr6s53dk3f2y9h6cna00rnwnh4yymk96li7lbym3d84cxjzrs"))))
"0id4qm9a7kc5yawff85blmph4zbizhb6ka88aqm10wrpfsknri3j"))))
(home-page "https://github.com/Airblader/i3")
(synopsis "Tiling window manager with gaps")
(description "i3-gaps is a fork of i3wm, a tiling window manager

125
gnu/packages/xdisorg.scm
View File

@ -74,6 +74,7 @@
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages flex)
#:use-module (gnu packages freedesktop)
#:use-module (gnu packages gawk)
#:use-module (gnu packages gettext)
#:use-module (gnu packages gl)
#:use-module (gnu packages glib)
@ -2149,6 +2150,7 @@ configuring visual settings in different UI toolkits separately.")
(install-file "README.md" doc)
#t))))
#:make-flags (list "CC=gcc")
;; the package provides no test suite:
#:tests? #f))
(inputs
`(("libx11" ,libx11)
@ -2172,58 +2174,75 @@ tools to complement clipnotify.")
(let ((commit "a495bcc7a4ab125182a661c5808364f66938a87c")
(revision "1"))
(package
(name "clipmenu")
(version (string-append "5.6.0-"
revision "." (string-take commit 7)))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/cdown/clipnotify.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"12vvircdhl4psqi51cnfd6bqy85v2vwfcmdq1mimjgng727nwzys"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-hardcoded-paths
(lambda _
(substitute* "clipmenud"
(("has_clipnotify=0")
"has_clipnotify=1")
(("command -v clipnotify >/dev/null 2>&1 && has_clipnotify=1")
"")
(("clipnotify \\|\\| .*")
(string-append (which "clipnotify") "\n"))
(("xsel --logfile")
(string-append (which "xsel") " --logfile")))
(substitute* "clipmenu"
(("xsel --logfile")
(string-append (which "xsel") " --logfile")))
#t))
(delete 'configure)
(delete 'build)
(replace 'install
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(doc (string-append %output "/share/doc/"
,name "-" ,version)))
(install-file "clipdel" bin)
(install-file "clipmenu" bin)
(install-file "clipmenud" bin)
(install-file "README.md" doc)
#t))))
#:tests? #f))
(inputs
`(("clipnotify" ,clipnotify)
("xsel" ,xsel)))
(home-page "https://github.com/cdown/clipmenu")
(synopsis "Simple clipboard manager using dmenu or rofi and xsel")
(description "Start @command{clipmenud}, then run @command{clipmenu} to
(name "clipmenu")
(version (string-append "5.6.0-"
revision "." (string-take commit 7)))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/cdown/clipnotify.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"12vvircdhl4psqi51cnfd6bqy85v2vwfcmdq1mimjgng727nwzys"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'configure)
(delete 'build)
(replace 'install
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(doc (string-append %output "/share/doc/"
,name "-" ,version)))
(install-file "clipdel" bin)
(install-file "clipmenu" bin)
(install-file "clipmenud" bin)
(install-file "README.md" doc)
#t)))
(add-after 'install 'wrap-script
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(clipnotify (assoc-ref inputs "clipnotify"))
(coreutils-minimal (assoc-ref inputs "coreutils-minimal"))
(gawk (assoc-ref inputs "gawk"))
(util-linux (assoc-ref inputs "util-linux"))
(xdotool (assoc-ref inputs "xdotool"))
(xsel (assoc-ref inputs "xsel")))
(for-each
(lambda (prog)
(wrap-script (string-append out "/bin/" prog)
`("PATH" ":" prefix
,(map (lambda (dir)
(string-append dir "/bin"))
(list clipnotify coreutils-minimal
gawk util-linux xdotool xsel)))))
'("clipmenu" "clipmenud" "clipdel")))
#t))
(replace 'check
(lambda* (#:key inputs outputs #:allow-other-keys)
;; substitute a shebang appearing inside a string (the test
;; file writes this string to a temporary file):
(substitute* "tests/test-clipmenu"
(("#!/usr/bin/env bash")
(string-append "#!" (which "bash"))))
(invoke "tests/test-clipmenu")
#t)))))
(inputs
`(("clipnotify" ,clipnotify)
("coreutils-minimal" ,coreutils-minimal)
("gawk" ,gawk)
("guile" ,guile-3.0) ; for wrap-script
("util-linux" ,util-linux)
("xdotool" ,xdotool)
("xsel" ,xsel)))
(home-page "https://github.com/cdown/clipmenu")
(synopsis "Simple clipboard manager using dmenu or rofi and xsel")
(description "Start @command{clipmenud}, then run @command{clipmenu} to
select something to put on the clipboard.
When @command{clipmenud} detects changes to the clipboard contents, it writes
@ -2231,4 +2250,4 @@ them out to the cache directory. @command{clipmenu} reads the cache directory
to find all available clips and launches @command{dmenu} (or @command{rofi},
depending on the value of @code{CM_LAUNCHER}) to let the user select a clip.
After selection, the clip is put onto the PRIMARY and CLIPBOARD X selections.")
(license license:public-domain))))
(license license:public-domain))))

14
gnu/services/base.scm
View File

@ -817,13 +817,13 @@ tty/font pairs. The font can be the name of a font provided by the @code{kbd}
package or any valid argument to @command{setfont}, as in this example:
@example
'((\"tty1\" . \"LatGrkCyr-8x16\")
(\"tty2\" . (file-append
font-tamzen
\"/share/kbd/consolefonts/TamzenForPowerline10x20.psf\"))
(\"tty3\" . (file-append
font-terminus
\"/share/consolefonts/ter-132n\"))) ; for HDPI
`((\"tty1\" . \"LatGrkCyr-8x16\")
(\"tty2\" . ,(file-append
font-tamzen
\"/share/kbd/consolefonts/TamzenForPowerline10x20.psf\"))
(\"tty3\" . ,(file-append
font-terminus
\"/share/consolefonts/ter-132n\"))) ; for HDPI
@end example\n")))
(define* (console-font-service tty #:optional (font "LatGrkCyr-8x16"))

33
gnu/services/desktop.scm
View File

@ -5,7 +5,7 @@
;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2017 ng0 <ng0@n0.is>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
@ -36,7 +36,7 @@
#:use-module (gnu services networking)
#:use-module (gnu services sound)
#:use-module ((gnu system file-systems)
#:select (%elogind-file-systems))
#:select (%elogind-file-systems file-system))
#:use-module (gnu system)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
@ -106,6 +106,9 @@
elogind-service
elogind-service-type
%fontconfig-file-system
fontconfig-file-system-service
accountsservice-service-type
accountsservice-service
@ -797,6 +800,27 @@ when they log out."
;;;
;;; Fontconfig and other desktop file-systems.
;;;
(define %fontconfig-file-system
(file-system
(device "none")
(mount-point "/var/cache/fontconfig")
(type "tmpfs")
(flags '(read-only))
(check? #f)))
;; The global fontconfig cache directory can sometimes contain stale entries,
;; possibly referencing fonts that have been GC'd, so mount it read-only.
;; As mentioned https://debbugs.gnu.org/cgi/bugreport.cgi?bug=36924#8 and
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38046#10 and elsewhere.
(define fontconfig-file-system-service
(simple-service 'fontconfig-file-system
file-system-service-type
(list %fontconfig-file-system)))
;;;
;;; AccountsService service.
;;;
@ -1185,6 +1209,11 @@ or setting its password with passwd.")))
;; perform administrative tasks (similar to "sudo").
polkit-wheel-service
;; The global fontconfig cache directory can sometimes contain
;; stale entries, possibly referencing fonts that have been GC'd,
;; so mount it read-only.
fontconfig-file-system-service
;; NetworkManager and its applet.
(service network-manager-service-type)
(service wpa-supplicant-service-type) ;needed by NetworkManager

18
gnu/services/nfs.scm
View File

@ -274,9 +274,19 @@
rpcmountd-port rpcstatd-port nfsd-port nfsd-threads
pipefs-directory debug)
(list (shepherd-service
(documentation "Mount the nfsd pseudo file system.")
(provision '(/proc/fs/nfsd))
(start #~(lambda ()
(mount "nfsd" "/proc/fs/nfsd" "nfsd")
(member "/proc/fs/nfsd" (mount-points))))
(stop #~(lambda (pid . args)
(umount "/proc/fs/nfsd" MNT_DETACH)
(not (member "/proc/fs/nfsd" (mount-points))))))
(shepherd-service
(documentation "Run the NFS statd daemon.")
(provision '(rpc.statd))
(requirement '(rpcbind-daemon))
(requirement '(/proc/fs/nfsd rpcbind-daemon))
(start
#~(make-forkexec-constructor
(list #$(file-append nfs-utils "/sbin/rpc.statd")
@ -295,7 +305,7 @@
(shepherd-service
(documentation "Run the NFS mountd daemon.")
(provision '(rpc.mountd))
(requirement '(rpc.statd))
(requirement '(/proc/fs/nfsd rpc.statd))
(start
#~(make-forkexec-constructor
(list #$(file-append nfs-utils "/sbin/rpc.mountd")
@ -310,7 +320,7 @@
(shepherd-service
(documentation "Run the NFS daemon.")
(provision '(rpc.nfsd))
(requirement '(rpc.statd networking))
(requirement '(/proc/fs/nfsd rpc.statd networking))
(start
#~(lambda _
(zero? (system* #$(file-append nfs-utils "/sbin/rpc.nfsd")
@ -329,7 +339,7 @@
(shepherd-service
(documentation "Run the NFS mountd daemon and refresh exports.")
(provision '(nfs))
(requirement '(rpc.nfsd rpc.mountd rpc.statd rpcbind-daemon))
(requirement '(/proc/fs/nfsd rpc.nfsd rpc.mountd rpc.statd rpcbind-daemon))
(start
#~(lambda _
(let ((rpcdebug #$(file-append nfs-utils "/sbin/rpcdebug")))

17
gnu/system.scm
View File

@ -5,6 +5,7 @@
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -108,6 +109,7 @@
operating-system-skeletons
operating-system-sudoers-file
operating-system-swap-devices
operating-system-kernel-loadable-modules
operating-system-derivation
operating-system-profile
@ -168,6 +170,8 @@
(kernel operating-system-kernel ; package
(default linux-libre))
(kernel-loadable-modules operating-system-kernel-loadable-modules
(default '())) ; list of packages
(kernel-arguments operating-system-user-kernel-arguments
(default '("quiet"))) ; list of gexps/strings
(bootloader operating-system-bootloader) ; <bootloader-configuration>
@ -472,9 +476,16 @@ OS."
"Return the basic entries of the 'system' directory of OS for use as the
value of the SYSTEM-SERVICE-TYPE service."
(let ((locale (operating-system-locale-directory os)))
(mlet %store-monad ((kernel -> (operating-system-kernel os))
(initrd -> (operating-system-initrd-file os))
(params (operating-system-boot-parameters-file os)))
(mlet* %store-monad ((kernel -> (operating-system-kernel os))
(modules ->
(operating-system-kernel-loadable-modules os))
(kernel
(profile-derivation
(packages->manifest
(cons kernel modules))
#:hooks (list linux-module-database)))
(initrd -> (operating-system-initrd-file os))
(params (operating-system-boot-parameters-file os)))
(return `(("kernel" ,kernel)
("parameters" ,params)
("initrd" ,initrd)

2
gnu/system/examples/asus-c201.tmpl
View File

@ -18,7 +18,7 @@
;; The ASUS C201PA requires a very particular kernel to boot,
;; as well as the following arguments.
(kernel linux-libre-arm-veyron)
(kernel linux-libre-arm-generic)
(kernel-arguments '("console=tty1"))
;; We do not need any special modules for initrd, and the

233
gnu/tests/install.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -31,15 +32,23 @@
#:use-module (gnu packages cryptsetup)
#:use-module (gnu packages linux)
#:use-module (gnu packages ocr)
#:use-module (gnu packages openbox)
#:use-module (gnu packages package-management)
#:use-module (gnu packages ratpoison)
#:use-module (gnu packages suckless)
#:use-module (gnu packages virtualization)
#:use-module (gnu packages wm)
#:use-module (gnu packages xorg)
#:use-module (gnu services desktop)
#:use-module (gnu services networking)
#:use-module (gnu services xorg)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix grafts)
#:use-module (guix gexp)
#:use-module (guix utils)
#:use-module (srfi srfi-1)
#:export (%test-installed-os
%test-installed-extlinux-os
%test-iso-image-installer
@ -51,7 +60,8 @@
%test-jfs-root-os
%test-gui-installed-os
%test-gui-installed-os-encrypted))
%test-gui-installed-os-encrypted
%test-gui-installed-desktop-os-encrypted))
;;; Commentary:
;;;
@ -202,6 +212,7 @@ reboot\n")
(gnu installer tests)
(guix combinators))))
(installation-disk-image-file-system-type "ext4")
(install-size 'guess)
(target-size (* 2200 MiB)))
"Run SCRIPT (a shell script following the system installation procedure) in
OS to install TARGET-OS. Return a VM image of TARGET-SIZE bytes containing
@ -219,7 +230,7 @@ packages defined in installation-os."
(image (system-disk-image
(operating-system-with-gc-roots
os (list target))
#:disk-image-size 'guess
#:disk-image-size install-size
#:file-system-type
installation-disk-image-file-system-type)))
(define install
@ -940,73 +951,81 @@ build (current-guix) and then store a couple of full system images.")
(define %root-password "foo")
(define* (gui-test-program marionette #:key (encrypted? #f))
(define* (gui-test-program marionette
#:key
(desktop? #f)
(encrypted? #f))
#~(let ()
(define (screenshot file)
(marionette-control (string-append "screendump " file)
#$marionette))
(define-syntax-rule (marionette-eval* exp marionette)
(or (marionette-eval exp marionette)
(throw 'marionette-eval-failure 'exp)))
(setvbuf (current-output-port) 'none)
(setvbuf (current-error-port) 'none)
(marionette-eval '(use-modules (gnu installer tests))
#$marionette)
(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)
(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)
(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* '(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)
(marionette-eval* '(define installer-socket
(open-installer-socket))
#$marionette)
(screenshot "installer-start.ppm")
(marionette-eval '(choose-locale+keyboard installer-socket)
#$marionette)
(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)
(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)
(marionette-eval* '(choose-services installer-socket
#:choose-desktop-environment?
(const #$desktop?)
#:choose-network-service?
(const #f))
#$marionette)
(screenshot "installer-partitioning.ppm")
(marionette-eval '(choose-partitioning installer-socket
#:encrypted? #$encrypted?
#:passphrase #$%luks-passphrase)
#$marionette)
(marionette-eval* '(choose-partitioning installer-socket
#:encrypted? #$encrypted?
#:passphrase #$%luks-passphrase)
#$marionette)
(screenshot "installer-run.ppm")
(marionette-eval '(conclude-installation installer-socket)
#$marionette)
(marionette-eval* '(conclude-installation installer-socket)
#$marionette)
(sync)
#t))
@ -1033,53 +1052,111 @@ build (current-guix) and then store a couple of full system images.")
(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)))))
(define* (installation-target-os-for-gui-tests
#:key (encrypted? #f))
(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)))))
(define* (installation-target-desktop-os-for-gui-tests
#:key (encrypted? #f))
(operating-system
(inherit (installation-target-os-for-gui-tests
#:encrypted? encrypted?))
(keyboard-layout (keyboard-layout "us" "altgr-intl"))
;; Make sure that all the packages and services that may be used by the
;; graphical installer are available.
(packages (append
(list openbox awesome i3-wm i3status
dmenu st ratpoison xterm)
%base-packages))
(services
(append
(list (service gnome-desktop-service-type)
(service xfce-desktop-service-type)
(service mate-desktop-service-type)
(service enlightenment-desktop-service-type)
(set-xorg-configuration
(xorg-configuration
(keyboard-layout keyboard-layout)))
(service marionette-service-type
(marionette-configuration
(imported-modules '((gnu services herd)
(guix build utils)
(guix combinators))))))
%desktop-services))))
(define* (guided-installation-test name
#:key
(desktop? #f)
(encrypted? #f)
target-os
(install-size 'guess)
(target-size (* 2200 MiB)))
(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
(mlet* %store-monad
((image (run-install target-os '(this is unused)
#:script #f
#:os installation-os-for-gui-tests
#:install-size install-size
#:target-size target-size
#:gui-test
(lambda (marionette)
(gui-test-program
marionette
#:desktop? desktop?
#:encrypted? encrypted?))))
(command (qemu-command/writable-image image)))
(run-basic-test target-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))
(guided-installation-test
"gui-installed-os"
#:target-os (installation-target-os-for-gui-tests)))
(define %test-gui-installed-os-encrypted
(guided-installation-test "gui-installed-os-encrypted"
#:encrypted? #t))
(guided-installation-test
"gui-installed-os-encrypted"
#:encrypted? #t
#:target-os (installation-target-os-for-gui-tests
#:encrypted? #t)))
;; Building a desktop image is very time and space consuming. Install all
;; desktop environments in a single test to reduce the overhead.
(define %test-gui-installed-desktop-os-encrypted
(guided-installation-test "gui-installed-desktop-os-encrypted"
#:desktop? #t
#:encrypted? #t
#:target-os
(installation-target-desktop-os-for-gui-tests
#:encrypted? #t)
;; XXX: The disk-image size guess is too low. Use
;; a constant value until this is fixed.
#:install-size (* 8000 MiB)
#:target-size (* 9000 MiB)))
;;; install.scm ends here

103
gnu/tests/linux-modules.scm Normal file
View File

@ -0,0 +1,103 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.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 tests linux-modules)
#:use-module (gnu packages linux)
#:use-module (gnu system)
#:use-module (gnu system vm)
#:use-module (gnu tests)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (guix monads)
#:use-module (guix store)
#:export (%test-loadable-kernel-modules-0
%test-loadable-kernel-modules-1
%test-loadable-kernel-modules-2))
;;; Commentary:
;;;
;;; Test <operating-system> kernel-loadable-modules.
;;;
;;; Code:
(define* (module-loader-program os modules)
"Return an executable store item that, upon being evaluated, will dry-run
load MODULES."
(program-file
"load-kernel-modules.scm"
(with-imported-modules (source-module-closure '((guix build utils)))
#~(begin
(use-modules (guix build utils))
(for-each (lambda (module)
(invoke (string-append #$kmod "/bin/modprobe") "-n" "--"
module))
'#$modules)))))
(define* (run-loadable-kernel-modules-test module-packages module-names)
"Run a test of an OS having MODULE-PACKAGES, and modprobe MODULE-NAMES."
(define os
(marionette-operating-system
(operating-system
(inherit (simple-operating-system))
(kernel-loadable-modules module-packages))
#:imported-modules '((guix combinators))))
(define vm (virtual-machine os))
(define (test script)
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(srfi srfi-64))
(define marionette
(make-marionette (list #$vm)))
(mkdir #$output)
(chdir #$output)
(test-begin "loadable-kernel-modules")
(test-assert "script successfully evaluated"
(marionette-eval
'(primitive-load #$script)
marionette))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "loadable-kernel-modules" (test (module-loader-program os module-names))))
(define %test-loadable-kernel-modules-0
(system-test
(name "loadable-kernel-modules-0")
(description "Tests loadable kernel modules facility of <operating-system>
with no extra modules.")
(value (run-loadable-kernel-modules-test '() '()))))
(define %test-loadable-kernel-modules-1
(system-test
(name "loadable-kernel-modules-1")
(description "Tests loadable kernel modules facility of <operating-system>
with one extra module.")
(value (run-loadable-kernel-modules-test
(list ddcci-driver-linux)
'("ddcci")))))
(define %test-loadable-kernel-modules-2
(system-test
(name "loadable-kernel-modules-2")
(description "Tests loadable kernel modules facility of <operating-system>
with two extra modules.")
(value (run-loadable-kernel-modules-test
(list acpi-call-linux-module ddcci-driver-linux)
'("acpi_call" "ddcci")))))

2
gnu/tests/nfs.scm
View File

@ -236,7 +236,7 @@
(use-modules (gnu services herd))
(start-service 'nfs))
marionette)
(wait-for-file "/var/run/rpc.statd.pid")))
(wait-for-file "/var/run/rpc.statd.pid" marionette)))
(test-assert "nfs share is advertised"
(marionette-eval

160
guix/build-system/linux-module.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -45,27 +46,16 @@
(let ((module (resolve-interface '(gnu packages linux))))
(module-ref module 'linux-libre)))
(define (default-kmod)
"Return the default kmod package."
;; Do not use `@' to avoid introducing circular dependencies.
(define (system->arch system)
(let ((module (resolve-interface '(gnu packages linux))))
(module-ref module 'kmod)))
(define (default-gcc)
"Return the default gcc package."
;; Do not use `@' to avoid introducing circular dependencies.
(let ((module (resolve-interface '(gnu packages gcc))))
(module-ref module 'gcc-7)))
((module-ref module 'system->linux-architecture) system)))
(define (make-linux-module-builder linux)
(package
(inherit linux)
(name (string-append (package-name linux) "-module-builder"))
(native-inputs
`(("linux" ,linux)
,@(package-native-inputs linux)))
(inputs
`(("linux" ,linux)))
(arguments
(substitute-keyword-arguments (package-arguments linux)
((#:phases phases)
@ -97,33 +87,43 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs))
`(#:source #:target #:gcc #:kmod #:linux #:inputs #:native-inputs
,@(if target '() '(#:target))))
(and (not target) ;XXX: no cross-compilation
(bag
(name name)
(system system)
(host-inputs `(,@(if source
`(("source" ,source))
'())
,@inputs
,@(standard-packages)))
(build-inputs `(("linux" ,linux) ; for "Module.symvers".
("linux-module-builder"
,(make-linux-module-builder linux))
,@native-inputs
;; TODO: Remove "gmp", "mpfr", "mpc" since they are
;; only needed to compile the gcc plugins. Maybe
;; remove "flex", "bison", "elfutils", "perl",
;; "openssl". That leaves very little ("bc", "gcc",
;; "kmod").
,@(package-native-inputs linux)))
(outputs outputs)
(build linux-module-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
(bag
(name name)
(system system) (target target)
(build-inputs `(,@(if source
`(("source" ,source))
'())
,@native-inputs
;; TODO: Remove "gmp", "mpfr", "mpc" since they are
;; only needed to compile the gcc plugins. Maybe
;; remove "flex", "bison", "elfutils", "perl",
;; "openssl". That leaves very little ("bc", "gcc",
;; "kmod").
,@(package-native-inputs linux)
,@(if target
;; Use the standard cross inputs of
;; 'gnu-build-system'.
(standard-cross-packages target 'host)
'())
;; Keep the standard inputs of 'gnu-build-system'.
,@(standard-packages)))
(host-inputs `(,@inputs
("linux" ,linux)
("linux-module-builder"
,(make-linux-module-builder linux))))
(target-inputs (if target
(standard-cross-packages target 'target)
'()))
(outputs outputs)
(build (if target linux-module-build-cross linux-module-build))
(arguments (strip-keyword-arguments private-keywords arguments))))
(define* (linux-module-build store name inputs
#:key
target
(search-paths '())
(tests? #t)
(phases '(@ (guix build linux-module-build-system)
@ -152,6 +152,8 @@
search-paths)
#:phases ,phases
#:system ,system
#:target ,target
#:arch ,(system->arch (or target system))
#:tests? ,tests?
#:outputs %outputs
#:inputs %build-inputs)))
@ -173,6 +175,88 @@
#:guile-for-build guile-for-build
#:substitutable? substitutable?))
(define* (linux-module-build-cross
store name
#:key
target native-drvs target-drvs
(guile #f)
(outputs '("out"))
(search-paths '())
(native-search-paths '())
(tests? #f)
(phases '(@ (guix build linux-module-build-system)
%standard-phases))
(system (%current-system))
(substitutable? #t)
(imported-modules
%linux-module-build-system-modules)
(modules '((guix build linux-module-build-system)
(guix build utils))))
(define builder
`(begin
(use-modules ,@modules)
(let ()
(define %build-host-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name path)
`(,name . ,path)))
native-drvs))
(define %build-target-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name (? package? pkg) sub ...)
(let ((drv (package-cross-derivation store pkg
target system)))
`(,name . ,(apply derivation->output-path drv sub))))
((name path)
`(,name . ,path)))
target-drvs))
(linux-module-build #:name ,name
#:source ,(match (assoc-ref native-drvs "source")
(((? derivation? source))
(derivation->output-path source))
((source)
source)
(source
source))
#:system ,system
#:target ,target
#:arch ,(system->arch (or target system))
#:outputs %outputs
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths
',(map search-path-specification->sexp
search-paths)
#:native-search-paths
',(map
search-path-specification->sexp
native-search-paths)
#:phases ,phases
#:tests? ,tests?))))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system
#:inputs (append native-drvs target-drvs)
#:outputs outputs
#:modules imported-modules
#:guile-for-build guile-for-build
#:substitutable? substitutable?))
(define linux-module-build-system
(build-system
(name 'linux-module)

7
guix/build/download.scm
View File

@ -693,6 +693,13 @@ otherwise simply ignore them."
(()
(format (current-error-port) "failed to download ~s from ~s~%"
file url)
;; Remove FILE in case we made an incomplete download, for example due
;; to ENOSPC.
(catch 'system-error
(lambda ()
(delete-file file))
(const #f))
#f))))
;;; download.scm ends here

13
guix/build/emacs-utils.scm
View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;; Copyright © 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2018, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2019 Leo Prikler <leo.prikler@student.tugraz.at>
;;;
;;; This file is part of GNU Guix.
@ -21,6 +21,7 @@
(define-module (guix build emacs-utils)
#:use-module (guix build utils)
#:use-module (ice-9 format)
#:export (%emacs
emacs-batch-eval
emacs-batch-edit-file
@ -47,10 +48,12 @@
expr
(format #f "~s" expr)))
(define (emacs-batch-eval expr)
"Run Emacs in batch mode, and execute the elisp code EXPR."
(define* (emacs-batch-eval expr #:key dynamic?)
"Run Emacs in batch mode, and execute the Elisp code EXPR. If DYNAMIC? is
true, evaluate using dynamic scoping."
(invoke (%emacs) "--quick" "--batch"
(string-append "--eval=" (expr->string expr))))
(format #f "--eval=(eval '~a ~:[t~;nil~])"
(expr->string expr) dynamic?)))
(define (emacs-batch-edit-file file expr)
"Load FILE in Emacs using batch mode, and execute the elisp code EXPR."
@ -70,7 +73,7 @@
(expr `(let ((backup-inhibited t)
(generated-autoload-file ,file))
(update-directory-autoloads ,directory))))
(emacs-batch-eval expr)))
(emacs-batch-eval expr #:dynamic? #t)))
(define* (emacs-byte-compile-directory dir)
"Byte compile all files in DIR and its sub-directories."

17
guix/build/linux-module-build-system.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -33,14 +34,13 @@
;; Code:
;; Copied from make-linux-libre's "configure" phase.
(define* (configure #:key inputs target #:allow-other-keys)
(define* (configure #:key inputs target arch #:allow-other-keys)
(setenv "KCONFIG_NOTIMESTAMP" "1")
(setenv "KBUILD_BUILD_TIMESTAMP" (getenv "SOURCE_DATE_EPOCH"))
;(let ((arch ,(system->linux-architecture
; (or (%current-target-system)
; (%current-system)))))
; (setenv "ARCH" arch)
; (format #t "`ARCH' set to `~a'~%" (getenv "ARCH")))
(setenv "ARCH" arch)
(format #t "`ARCH' set to `~a'~%" (getenv "ARCH"))
(when target
(setenv "CROSS_COMPILE" (string-append target "-"))
(format #t "`CROSS_COMPILE' set to `~a'~%"
@ -85,8 +85,9 @@
(replace 'install install)))
(define* (linux-module-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
"Build the given package, applying all of PHASES in order, with a Linux kernel in attendance."
#:allow-other-keys #:rest args)
"Build the given package, applying all of PHASES in order, with a Linux
kernel in attendance."
(apply gnu:gnu-build
#:inputs inputs #:phases phases
args))

64
guix/build/syscalls.scm
View File

@ -1104,47 +1104,49 @@ exception if it's already taken."
#t)
(define (call-with-file-lock file thunk)
(let ((port (catch 'system-error
(lambda ()
(lock-file file))
(lambda args
;; When using the statically-linked Guile in the initrd,
;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore
;; that error since we're typically the only process running
;; at this point.
(if (= ENOSYS (system-error-errno args))
#f
(apply throw args))))))
(let ((port #f))
(dynamic-wind
(lambda ()
#t)
(set! port
(catch 'system-error
(lambda ()
(lock-file file))
(lambda args
;; When using the statically-linked Guile in the initrd,
;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore
;; that error since we're typically the only process running
;; at this point.
(if (= ENOSYS (system-error-errno args))
#f
(apply throw args))))))
thunk
(lambda ()
(when port
(unlock-file port))))))
(define (call-with-file-lock/no-wait file thunk handler)
(let ((port (catch #t
(lambda ()
(lock-file file #:wait? #f))
(lambda (key . args)
(match key
('flock-error
(apply handler args)
;; No open port to the lock, so return #f.
#f)
('system-error
;; When using the statically-linked Guile in the initrd,
;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore
;; that error since we're typically the only process running
;; at this point.
(if (= ENOSYS (system-error-errno (cons key args)))
#f
(apply throw key args)))
(_ (apply throw key args)))))))
(let ((port #f))
(dynamic-wind
(lambda ()
#t)
(set! port
(catch #t
(lambda ()
(lock-file file #:wait? #f))
(lambda (key . args)
(match key
('flock-error
(apply handler args)
;; No open port to the lock, so return #f.
#f)
('system-error
;; When using the statically-linked Guile in the initrd,
;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore
;; that error since we're typically the only process running
;; at this point.
(if (= ENOSYS (system-error-errno (cons key args)))
#f
(apply throw key args)))
(_ (apply throw key args)))))))
thunk
(lambda ()
(when port

9
guix/cache.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -33,13 +33,6 @@
;;;
;;; Code:
(cond-expand
(guile-2.2
;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it.
(define time-monotonic time-tai))
(else #t))
(define (obsolete? date now ttl)
"Return #t if DATE is obsolete compared to NOW + TTL seconds."
(time>? (subtract-duration now (make-time time-duration 0 ttl))

97
guix/import/cran.scm
View File

@ -21,6 +21,7 @@
(define-module (guix import cran)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 popen)
#:use-module ((ice-9 rdelim) #:select (read-string read-line))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
@ -37,10 +38,14 @@
#:use-module (guix base32)
#:use-module ((guix download) #:select (download-to-store))
#:use-module (guix import utils)
#:use-module ((guix build utils) #:select (find-files))
#:use-module ((guix build utils)
#:select (find-files
delete-file-recursively
with-directory-excursion))
#:use-module (guix utils)
#:use-module (guix git)
#:use-module ((guix build-system r) #:select (cran-uri bioconductor-uri))
#:use-module (guix ui)
#:use-module (guix upstream)
#:use-module (guix packages)
#:use-module (gnu packages)
@ -191,11 +196,26 @@ bioconductor package NAME, or #F if the package is unknown."
;; Little helper to download URLs only once.
(define download
(memoize
(lambda* (url #:optional git)
(lambda* (url #:key method)
(with-store store
(if git
(latest-repository-commit store url)
(download-to-store store url))))))
(cond
((eq? method 'git)
(latest-repository-commit store url))
((eq? method 'hg)
(call-with-temporary-directory
(lambda (dir)
(unless (zero? (system* "hg" "clone" url dir))
(leave (G_ "~A: hg download failed~%") url))
(with-directory-excursion dir
(let* ((port (open-pipe* OPEN_READ "hg" "id" "--id"))
(changeset (string-trim-right (read-string port))))
(close-pipe port)
(for-each delete-file-recursively
(find-files dir "^\\.hg$" #:directories? #t))
(let ((store-directory
(add-to-store store (basename url) #t "sha256" dir)))
(values store-directory changeset)))))))
(else (download-to-store store url)))))))
(define (fetch-description repository name)
"Return an alist of the contents of the DESCRIPTION file for the R package
@ -244,13 +264,25 @@ from ~s: ~a (~s)~%"
(and (string-prefix? "http" name)
;; Download the git repository at "NAME"
(call-with-values
(lambda () (download name #t))
(lambda () (download name #:method 'git))
(lambda (dir commit)
(and=> (description->alist (with-input-from-file
(string-append dir "/DESCRIPTION") read-string))
(lambda (meta)
(cons* `(git . ,name)
`(git-commit . ,commit)
meta)))))))
((hg)
(and (string-prefix? "http" name)
;; Download the mercurial repository at "NAME"
(call-with-values
(lambda () (download name #:method 'hg))
(lambda (dir changeset)
(and=> (description->alist (with-input-from-file
(string-append dir "/DESCRIPTION") read-string))
(lambda (meta)
(cons* `(hg . ,name)
`(hg-changeset . ,changeset)
meta)))))))))
(define (listify meta field)
@ -404,11 +436,13 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(let* ((base-url (case repository
((cran) %cran-url)
((bioconductor) %bioconductor-url)
((git) #f)))
((git) #f)
((hg) #f)))
(uri-helper (case repository
((cran) cran-uri)
((bioconductor) bioconductor-uri)
((git) #f)))
((git) #f)
((hg) #f)))
(name (assoc-ref meta "Package"))
(synopsis (assoc-ref meta "Title"))
(version (assoc-ref meta "Version"))
@ -416,11 +450,13 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
;; Some packages have multiple home pages. Some have none.
(home-page (case repository
((git) (assoc-ref meta 'git))
((hg) (assoc-ref meta 'hg))
(else (match (listify meta "URL")
((url rest ...) url)
(_ (string-append base-url name))))))
(source-url (case repository
((git) (assoc-ref meta 'git))
((hg) (assoc-ref meta 'hg))
(else
(match (apply uri-helper name version
(case repository
@ -431,9 +467,13 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
((? string? url) url)
(_ #f)))))
(git? (assoc-ref meta 'git))
(source (download source-url git?))
(hg? (assoc-ref meta 'hg))
(source (download source-url #:method (cond
(git? 'git)
(hg? 'hg)
(else #f))))
(sysdepends (append
(if (needs-zlib? source (not git?)) '("zlib") '())
(if (needs-zlib? source (not (or git? hg?))) '("zlib") '())
(filter (lambda (name)
(not (member name invalid-packages)))
(map string-downcase (listify meta "SystemRequirements")))))
@ -451,33 +491,45 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(version ,(case repository
((git)
`(git-version ,version revision commit))
((hg)
`(string-append ,version "-" revision "." changeset))
(else version)))
(source (origin
(method ,(if git?
'git-fetch
'url-fetch))
(method ,(cond
(git? 'git-fetch)
(hg? 'hg-fetch)
(else 'url-fetch)))
(uri ,(case repository
((git)
`(git-reference
(url ,(assoc-ref meta 'git))
(commit commit)))
((hg)
`(hg-reference
(url ,(assoc-ref meta 'hg))
(changeset changeset)))
(else
`(,(procedure-name uri-helper) ,name version
,@(or (and=> (assoc-ref meta 'bioconductor-type)
(lambda (type)
(list (list 'quote type))))
'())))))
,@(if git?
'((file-name (git-file-name name version)))
'())
,@(cond
(git?
'((file-name (git-file-name name version))))
(hg?
'((file-name (string-append name "-" version "-checkout"))))
(else '()))
(sha256
(base32
,(bytevector->nix-base32-string
(case repository
((git)
(file-hash source (negate vcs-file?) #t))
((hg)
(file-hash source (negate vcs-file?) #t))
(else (file-sha256 source))))))))
,@(if (not (and git?
,@(if (not (and git? hg?
(equal? (string-append "r-" name)
(cran-guix-name name))))
`((properties ,`(,'quasiquote ((,'upstream-name . ,name)))))
@ -486,9 +538,9 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
,@(maybe-inputs sysdepends)
,@(maybe-inputs (map cran-guix-name propagate) 'propagated-inputs)
,@(maybe-inputs
`(,@(if (needs-fortran? source (not git?))
`(,@(if (needs-fortran? source (not (or git? hg?)))
'("gfortran") '())
,@(if (needs-pkg-config? source (not git?))
,@(if (needs-pkg-config? source (not (or git? hg?)))
'("pkg-config") '())
,@(if (needs-knitr? meta)
'("r-knitr") '()))
@ -506,6 +558,10 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
`(let ((commit ,(assoc-ref meta 'git-commit))
(revision "1"))
,package))
((hg)
`(let ((changeset ,(assoc-ref meta 'hg-changeset))
(revision "1"))
,package))
(else package))
propagate)))
@ -521,6 +577,9 @@ s-expression corresponding to that package, or #f on failure."
((git)
;; Retry import from Bioconductor
(cran->guix-package package-name 'bioconductor))
((hg)
;; Retry import from Bioconductor
(cran->guix-package package-name 'bioconductor))
((bioconductor)
;; Retry import from CRAN
(cran->guix-package package-name 'cran))

2
guix/import/crate.scm
View File

@ -112,7 +112,7 @@ record or #f if it was not found."
(url (string-append (%crate-base-url) path)))
(match (assoc-ref (or (json-fetch url) '()) "dependencies")
((? vector? vector)
(map json->crate-dependency (vector->list vector)))
(delete-duplicates (map json->crate-dependency (vector->list vector))))
(_
'()))))

12
guix/licenses.scm
View File

@ -75,10 +75,12 @@
ms-pl
ncsa
nmap
ogl-psi1.0
openldap2.8 openssl
perl-license
psfl public-domain
qpl
qwt1.0
repoze
ruby
sgifreeb2.0
@ -517,6 +519,11 @@ at URI, which may be a file:// URI pointing the package's tree."
"https://svn.nmap.org/nmap/COPYING"
"https://fedoraproject.org/wiki/Licensing/Nmap"))
(define ogl-psi1.0
(license "Open Government Licence for Public Sector Information"
"https://www.nationalarchives.gov.uk/doc/open-government-licence/version/1/"
#f))
(define openssl
(license "OpenSSL"
"http://directory.fsf.org/wiki/License:OpenSSL"
@ -549,6 +556,11 @@ at URI, which may be a file:// URI pointing the package's tree."
"http://directory.fsf.org/wiki/License:QPLv1.0"
"http://www.gnu.org/licenses/license-list.html#QPL"))
(define qwt1.0
(license "QWT 1.0"
"http://qwt.sourceforge.net/qwtlicense.html"
"GNU Lesser General Public License with exceptions"))
(define repoze
(license "Repoze"
"http://repoze.org/LICENSE.txt"

48
guix/lint.scm
View File

@ -100,7 +100,8 @@
lint-checker?
lint-checker-name
lint-checker-description
lint-checker-check))
lint-checker-check
lint-checker-requires-store?))
;;;
@ -155,7 +156,9 @@
;; 'certainty' level.
(name lint-checker-name)
(description lint-checker-description)
(check lint-checker-check))
(check lint-checker-check)
(requires-store? lint-checker-requires-store?
(default #f)))
(define (properly-starts-sentence? s)
(string-match "^[(\"'`[:upper:][:digit:]]" s))
@ -915,9 +918,9 @@ descriptions maintained upstream."
(define exception-with-kind-and-args?
(const #f))))
(define (check-derivation package)
(define* (check-derivation package #:key store)
"Emit a warning if we fail to compile PACKAGE to a derivation."
(define (try system)
(define (try store system)
(catch #t ;TODO: Remove 'catch' when Guile 2.x is no longer supported.
(lambda ()
(guard (c ((store-protocol-error? c)
@ -936,25 +939,29 @@ descriptions maintained upstream."
(G_ "failed to create ~a derivation: ~a")
(list system
(condition-message c)))))
(with-store store
;; Disable grafts since it can entail rebuilds.
(parameterize ((%graft? #f))
(package-derivation store package system #:graft? #f)
(parameterize ((%graft? #f))
(package-derivation store package system #:graft? #f)
;; If there's a replacement, make sure we can compute its
;; derivation.
(match (package-replacement package)
(#f #t)
(replacement
(package-derivation store replacement system
#:graft? #f)))))))
;; If there's a replacement, make sure we can compute its
;; derivation.
(match (package-replacement package)
(#f #t)
(replacement
(package-derivation store replacement system
#:graft? #f))))))
(lambda args
(make-warning package
(G_ "failed to create ~a derivation: ~s")
(list system args)))))
(filter lint-warning?
(map try (package-supported-systems package))))
(define (check-with-store store)
(filter lint-warning?
(map (cut try store <>) (package-supported-systems package))))
;; For backwards compatability, don't rely on store being set
(or (and=> store check-with-store)
(with-store store
(check-with-store store))))
(define (check-license package)
"Warn about type errors of the 'license' field of PACKAGE."
@ -1328,9 +1335,10 @@ or a list thereof")
(description "Check for autogenerated tarballs")
(check check-source-unstable-tarball))
(lint-checker
(name 'derivation)
(description "Report failure to compile a package to a derivation")
(check check-derivation))
(name 'derivation)
(description "Report failure to compile a package to a derivation")
(check check-derivation)
(requires-store? #t))
(lint-checker
(name 'patch-file-names)
(description "Validate file names and availability of patches")

8
guix/packages.scm
View File

@ -363,12 +363,12 @@ object."
(let ((field (assoc field inits)))
(match field
((_ value)
(let ((props (source-properties value)))
(and props
(let ((loc (and=> (source-properties value)
source-properties->location)))
(and loc
;; Preserve the original file name, which may be a
;; relative file name.
(let ((loc (source-properties->location props)))
(set-field loc (location-file) file)))))
(set-field loc (location-file) file))))
(_
#f))))
(_

58
guix/profiles.scm
View File

@ -10,6 +10,7 @@
;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -139,7 +140,9 @@
%current-profile
ensure-profile-directory
canonicalize-profile
user-friendly-profile))
user-friendly-profile
linux-module-database))
;;; Commentary:
;;;
@ -1139,6 +1142,51 @@ for both major versions of GTK+."
(hook . gtk-im-modules)))
(return #f)))))
(define (linux-module-database manifest)
"Return a derivation that unites all the kernel modules of the manifest
and creates the dependency graph of all these kernel modules.
This is meant to be used as a profile hook."
(define kmod ; lazy reference
(module-ref (resolve-interface '(gnu packages linux)) 'kmod))
(define build
(with-imported-modules
(source-module-closure '((guix build utils)
(gnu build linux-modules)))
#~(begin
(use-modules (ice-9 ftw)
(ice-9 match)
(srfi srfi-1) ; append-map
(gnu build linux-modules))
(let* ((inputs '#$(manifest-inputs manifest))
(module-directories
(map (lambda (directory)
(string-append directory "/lib/modules"))
inputs))
(directory-entries
(lambda (directory)
(scandir directory (lambda (basename)
(not
(string-prefix? "." basename))))))
;; Note: Should usually result in one entry.
(versions (delete-duplicates
(append-map directory-entries
module-directories))))
(match versions
((version)
(let ((old-path (getenv "PATH")))
(setenv "PATH" #+(file-append kmod "/bin"))
(make-linux-module-directory inputs version #$output)
(setenv "PATH" old-path)))
(_ (error "Specified Linux kernel and Linux kernel modules
are not all of the same version")))))))
(gexp->derivation "linux-module-database" build
#:local-build? #t
#:substitutable? #f
#:properties
`((type . profile-hook)
(hook . linux-module-database))))
(define (xdg-desktop-database manifest)
"Return a derivation that builds the @file{mimeinfo.cache} database from
desktop files. It's used to query what applications can handle a given
@ -1546,7 +1594,13 @@ are cross-built for TARGET."
;; Disable substitution because it would trigger a
;; connection to the substitute server, which is likely
;; to have no substitute to offer.
#:substitutable? #f)))
#:substitutable? #f
#:properties `((type . profile)
(profile
(count
. ,(length
(manifest-entries manifest))))))))
(define* (profile-search-paths profile
#:optional (manifest (profile-manifest profile))

9
guix/progress.scm
View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
@ -96,13 +96,6 @@ stopped."
;;; File download progress report.
;;;
(cond-expand
(guile-2.2
;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it.
(define time-monotonic time-tai))
(else #t))
(define (nearest-exact-integer x)
"Given a real number X, return the nearest exact integer, with ties going to
the nearest exact even integer."

50
guix/scripts/archive.scm
View File

@ -259,12 +259,7 @@ build and a list of store files to transfer."
resulting archive to the standard output port."
(let-values (((drv files)
(options->derivations+files store opts)))
(show-what-to-build store drv
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:dry-run? (assoc-ref opts 'dry-run?))
(if (or (assoc-ref opts 'dry-run?)
(build-derivations store drv))
(if (build-derivations store drv)
(export-paths store files (current-output-port)
#:recursive? (assoc-ref opts 'export-recursive?))
(leave (G_ "unable to export the given packages~%")))))
@ -382,22 +377,27 @@ output port."
(with-status-verbosity (assoc-ref opts 'verbosity)
(with-store store
(set-build-options-from-command-line store opts)
(cond ((assoc-ref opts 'export)
(export-from-store store opts))
((assoc-ref opts 'import)
(import-paths store (current-input-port)))
((assoc-ref opts 'missing)
(let* ((files (lines (current-input-port)))
(missing (remove (cut valid-path? store <>)
files)))
(format #t "~{~a~%~}" missing)))
((assoc-ref opts 'list)
(list-contents (current-input-port)))
((assoc-ref opts 'extract)
=>
(lambda (target)
(restore-file (current-input-port) target)))
(else
(leave
(G_ "either '--export' or '--import' \
must be specified~%"))))))))))))
(with-build-handler
(build-notifier #:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run?
(assoc-ref opts 'dry-run?))
(cond ((assoc-ref opts 'export)
(export-from-store store opts))
((assoc-ref opts 'import)
(import-paths store (current-input-port)))
((assoc-ref opts 'missing)
(let* ((files (lines (current-input-port)))
(missing (remove (cut valid-path? store <>)
files)))
(format #t "~{~a~%~}" missing)))
((assoc-ref opts 'list)
(list-contents (current-input-port)))
((assoc-ref opts 'extract)
=>
(lambda (target)
(restore-file (current-input-port) target)))
(else
(leave
(G_ "either '--export' or '--import' \
must be specified~%")))))))))))))

114
guix/scripts/build.scm
View File

@ -952,64 +952,60 @@ needed."
;; Set the build options before we do anything else.
(set-build-options-from-command-line store opts)
(parameterize ((current-terminal-columns (terminal-columns))
(with-build-handler (build-notifier #:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run?
(assoc-ref opts 'dry-run?))
(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))
(drv (options->derivations store opts))
(urls (map (cut string-append <> "/log")
(if (assoc-ref opts 'substitutes?)
(or (assoc-ref opts 'substitute-urls)
;; XXX: This does not necessarily match the
;; daemon's substitute URLs.
%default-substitute-urls)
'())))
(items (filter-map (match-lambda
(('argument . (? store-path? file))
;; If FILE is a .drv that's not in
;; store, keep it so that it can be
;; substituted.
(and (or (not (derivation-path? file))
(not (file-exists? file)))
file))
(_ #f))
opts))
(roots (filter-map (match-lambda
(('gc-root . root) root)
(_ #f))
opts)))
;; 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))
(drv (options->derivations store opts))
(urls (map (cut string-append <> "/log")
(if (assoc-ref opts 'substitutes?)
(or (assoc-ref opts 'substitute-urls)
;; XXX: This does not necessarily match the
;; daemon's substitute URLs.
%default-substitute-urls)
'())))
(items (filter-map (match-lambda
(('argument . (? store-path? file))
;; If FILE is a .drv that's not in
;; store, keep it so that it can be
;; substituted.
(and (or (not (derivation-path? file))
(not (file-exists? file)))
file))
(_ #f))
opts))
(roots (filter-map (match-lambda
(('gc-root . root) root)
(_ #f))
opts)))
(unless (or (assoc-ref opts 'log-file?)
(assoc-ref opts 'derivations-only?))
(show-what-to-build store drv
#:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run? (assoc-ref opts 'dry-run?)
#:mode mode))
(cond ((assoc-ref opts 'log-file?)
;; Pass 'show-build-log' the output file names, not the
;; derivation file names, because there can be several
;; derivations leading to the same output.
(for-each (cut show-build-log store <> urls)
(delete-duplicates
(append (map derivation->output-path drv)
items))))
((assoc-ref opts 'derivations-only?)
(format #t "~{~a~%~}" (map derivation-file-name drv))
(for-each (cut register-root store <> <>)
(map (compose list derivation-file-name) drv)
roots))
((not (assoc-ref opts 'dry-run?))
(and (build-derivations store (append drv items)
mode)
(for-each show-derivation-outputs drv)
(for-each (cut register-root store <> <>)
(map (lambda (drv)
(map cdr
(derivation->output-paths drv)))
drv)
roots))))))))))
(cond ((assoc-ref opts 'log-file?)
;; Pass 'show-build-log' the output file names, not the
;; derivation file names, because there can be several
;; derivations leading to the same output.
(for-each (cut show-build-log store <> urls)
(delete-duplicates
(append (map derivation->output-path drv)
items))))
((assoc-ref opts 'derivations-only?)
(format #t "~{~a~%~}" (map derivation-file-name drv))
(for-each (cut register-root store <> <>)
(map (compose list derivation-file-name) drv)
roots))
(else
(and (build-derivations store (append drv items)
mode)
(for-each show-derivation-outputs drv)
(for-each (cut register-root store <> <>)
(map (lambda (drv)
(map cdr
(derivation->output-paths drv)))
drv)
roots)))))))))))

89
guix/scripts/copy.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -61,49 +61,40 @@ number (or #f) corresponding to SPEC."
(x
(leave (G_ "~a: invalid SSH specification~%") spec))))
(define (send-to-remote-host target opts)
(define (send-to-remote-host local target opts)
"Send ITEMS to TARGET. ITEMS is a list of store items or package names; for ;
package names, build the underlying packages before sending them."
(with-store local
(set-build-options-from-command-line local opts)
(let-values (((user host port)
(ssh-spec->user+host+port target))
((drv items)
(options->derivations+files local opts)))
(show-what-to-build local drv
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:dry-run? (assoc-ref opts 'dry-run?))
(let-values (((user host port)
(ssh-spec->user+host+port target))
((drv items)
(options->derivations+files local opts)))
(and (build-derivations local drv)
(let* ((session (open-ssh-session host #:user user
#:port (or port 22)))
(sent (send-files local items
(connect-to-remote-daemon session)
#:recursive? #t)))
(format #t "~{~a~%~}" sent)
sent))))
(and (or (assoc-ref opts 'dry-run?)
(build-derivations local drv))
(let* ((session (open-ssh-session host #:user user
#:port (or port 22)))
(sent (send-files local items
(connect-to-remote-daemon session)
#:recursive? #t)))
(format #t "~{~a~%~}" sent)
sent)))))
(define (retrieve-from-remote-host source opts)
(define (retrieve-from-remote-host local source opts)
"Retrieve ITEMS from SOURCE."
(with-store local
(let*-values (((user host port)
(ssh-spec->user+host+port source))
((session)
(open-ssh-session host #:user user #:port (or port 22)))
((remote)
(connect-to-remote-daemon session)))
(set-build-options-from-command-line local opts)
;; TODO: Here we could to compute and build the derivations on REMOTE
;; rather than on LOCAL (one-off offloading) but that is currently too
;; slow due to the many RPC round trips. So we just assume that REMOTE
;; contains ITEMS.
(let*-values (((drv items)
(options->derivations+files local opts))
((retrieved)
(retrieve-files local items remote #:recursive? #t)))
(format #t "~{~a~%~}" retrieved)
retrieved))))
(let*-values (((user host port)
(ssh-spec->user+host+port source))
((session)
(open-ssh-session host #:user user #:port (or port 22)))
((remote)
(connect-to-remote-daemon session)))
;; TODO: Here we could to compute and build the derivations on REMOTE
;; rather than on LOCAL (one-off offloading) but that is currently too
;; slow due to the many RPC round trips. So we just assume that REMOTE
;; contains ITEMS.
(let*-values (((drv items)
(options->derivations+files local opts))
((retrieved)
(retrieve-files local items remote #:recursive? #t)))
(format #t "~{~a~%~}" retrieved)
retrieved)))
;;;
@ -142,6 +133,10 @@ Copy ITEMS to or from the specified host over SSH.\n"))
(let ((level (string->number* arg)))
(alist-cons 'verbosity level
(alist-delete 'verbosity result)))))
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
(option '(#\h "help") #f #f
(lambda args
(show-help)
@ -176,7 +171,13 @@ Copy ITEMS to or from the specified host over SSH.\n"))
(let* ((opts (parse-command-line args %options (list %default-options)))
(source (assoc-ref opts 'source))
(target (assoc-ref opts 'destination)))
(with-status-verbosity (assoc-ref opts 'verbosity)
(cond (target (send-to-remote-host target opts))
(source (retrieve-from-remote-host source opts))
(else (leave (G_ "use '--to' or '--from'~%"))))))))
(with-store store
(set-build-options-from-command-line store opts)
(with-build-handler (build-notifier #:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run?
(assoc-ref opts 'dry-run?))
(with-status-verbosity (assoc-ref opts 'verbosity)
(cond (target (send-to-remote-host store target opts))
(source (retrieve-from-remote-host store source opts))
(else (leave (G_ "use '--to' or '--from'~%"))))))))))

55
guix/scripts/deploy.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 David Thompson <davet@gnu.org>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -97,6 +98,22 @@ Perform the deployment specified by FILE.\n"))
environment-modules))))
(load* file module)))
(define (show-what-to-deploy machines)
"Show the list of machines to deploy, MACHINES."
(let ((count (length machines)))
(format (current-error-port)
(N_ "The following ~*machine will be deployed:~%"
"The following ~d machines will be deployed:~%"
count)
count)
(display (indented-string
(fill-paragraph (string-join (map machine-display-name machines)
", ")
(- (%text-width) 2) 2)
2)
(current-error-port))
(display "\n\n" (current-error-port))))
(define (guix-deploy . args)
(define (handle-argument arg result)
(alist-cons 'file arg result))
@ -105,22 +122,28 @@ Perform the deployment specified by FILE.\n"))
#:argument-handler handle-argument))
(file (assq-ref opts 'file))
(machines (or (and file (load-source-file file)) '())))
(show-what-to-deploy machines)
(with-status-verbosity (assoc-ref opts 'verbosity)
(with-store store
(set-build-options-from-command-line store opts)
(for-each (lambda (machine)
(info (G_ "deploying to ~a...~%")
(machine-display-name machine))
(parameterize ((%graft? (assq-ref opts 'graft?)))
(guard (c ((message-condition? c)
(report-error (G_ "failed to deploy ~a: ~a~%")
(machine-display-name machine)
(condition-message c)))
((deploy-error? c)
(when (deploy-error-should-roll-back c)
(info (G_ "rolling back ~a...~%")
(machine-display-name machine))
(run-with-store store (roll-back-machine machine)))
(apply throw (deploy-error-captured-args c))))
(run-with-store store (deploy-machine machine)))))
machines)))))
(with-build-handler (build-notifier #:use-substitutes?
(assoc-ref opts 'substitutes?))
(for-each (lambda (machine)
(info (G_ "deploying to ~a...~%")
(machine-display-name machine))
(parameterize ((%graft? (assq-ref opts 'graft?)))
(guard (c ((message-condition? c)
(report-error (G_ "failed to deploy ~a: ~a~%")
(machine-display-name machine)
(condition-message c)))
((deploy-error? c)
(when (deploy-error-should-roll-back c)
(info (G_ "rolling back ~a...~%")
(machine-display-name machine))
(run-with-store store (roll-back-machine machine)))
(apply throw (deploy-error-captured-args c))))
(run-with-store store (deploy-machine machine))
(info (G_ "successfully deployed ~a~%")
(machine-display-name machine)))))
machines))))))

132
guix/scripts/environment.scm
View File

@ -362,19 +362,6 @@ for the corresponding packages."
opts)
manifest-entry=?)))
(define* (build-environment derivations opts)
"Build the DERIVATIONS required by the environment using the build options
in OPTS."
(let ((substitutes? (assoc-ref opts 'substitutes?))
(dry-run? (assoc-ref opts 'dry-run?)))
(mbegin %store-monad
(show-what-to-build* derivations
#:use-substitutes? substitutes?
#:dry-run? dry-run?)
(if dry-run?
(return #f)
(built-derivations derivations)))))
(define (manifest->derivation manifest system bootstrap?)
"Return the derivation for a profile of MANIFEST.
BOOTSTRAP? specifies whether to use the bootstrap Guile to build the profile."
@ -718,67 +705,68 @@ message if any test fails."
(with-store store
(with-status-verbosity (assoc-ref opts 'verbosity)
(define manifest
(options/resolve-packages store opts))
(with-build-handler (build-notifier #:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run?
(assoc-ref opts 'dry-run?))
(with-status-verbosity (assoc-ref opts 'verbosity)
(define manifest
(options/resolve-packages store opts))
(set-build-options-from-command-line store opts)
(set-build-options-from-command-line store opts)
;; Use the bootstrap Guile when requested.
(parameterize ((%graft? (assoc-ref opts 'graft?))
(%guile-for-build
(package-derivation
store
(if bootstrap?
%bootstrap-guile
(default-guile)))))
(run-with-store store
;; Containers need a Bourne shell at /bin/sh.
(mlet* %store-monad ((bash (environment-bash container?
bootstrap?
system))
(prof-drv (manifest->derivation
manifest system bootstrap?))
(profile -> (derivation->output-path prof-drv))
(gc-root -> (assoc-ref opts 'gc-root)))
;; Use the bootstrap Guile when requested.
(parameterize ((%graft? (assoc-ref opts 'graft?))
(%guile-for-build
(package-derivation
store
(if bootstrap?
%bootstrap-guile
(default-guile)))))
(run-with-store store
;; Containers need a Bourne shell at /bin/sh.
(mlet* %store-monad ((bash (environment-bash container?
bootstrap?
system))
(prof-drv (manifest->derivation
manifest system bootstrap?))
(profile -> (derivation->output-path prof-drv))
(gc-root -> (assoc-ref opts 'gc-root)))
;; First build the inputs. This is necessary even for
;; --search-paths. Additionally, we might need to build bash for
;; a container.
(mbegin %store-monad
(build-environment (if (derivation? bash)
(list prof-drv bash)
(list prof-drv))
opts)
(mwhen gc-root
(register-gc-root profile gc-root))
;; First build the inputs. This is necessary even for
;; --search-paths. Additionally, we might need to build bash for
;; a container.
(mbegin %store-monad
(built-derivations (if (derivation? bash)
(list prof-drv bash)
(list prof-drv)))
(mwhen gc-root
(register-gc-root profile gc-root))
(cond
((assoc-ref opts 'dry-run?)
(return #t))
((assoc-ref opts 'search-paths)
(show-search-paths profile manifest #:pure? pure?)
(return #t))
(container?
(let ((bash-binary
(if bootstrap?
(derivation->output-path bash)
(string-append (derivation->output-path bash)
"/bin/sh"))))
(launch-environment/container #:command command
#:bash bash-binary
#:user user
#:user-mappings mappings
#:profile profile
#:manifest manifest
#:white-list white-list
#:link-profile? link-prof?
#:network? network?
#:map-cwd? (not no-cwd?))))
(cond
((assoc-ref opts 'search-paths)
(show-search-paths profile manifest #:pure? pure?)
(return #t))
(container?
(let ((bash-binary
(if bootstrap?
(derivation->output-path bash)
(string-append (derivation->output-path bash)
"/bin/sh"))))
(launch-environment/container #:command command
#:bash bash-binary
#:user user
#:user-mappings mappings
#:profile profile
#:manifest manifest
#:white-list white-list
#:link-profile? link-prof?
#:network? network?
#:map-cwd? (not no-cwd?))))
(else
(return
(exit/status
(launch-environment/fork command profile manifest
#:white-list white-list
#:pure? pure?))))))))))))))
(else
(return
(exit/status
(launch-environment/fork command profile manifest
#:white-list white-list
#:pure? pure?)))))))))))))))

38
guix/scripts/lint.scm
View File

@ -30,6 +30,7 @@
#:use-module (guix packages)
#:use-module (guix lint)
#:use-module (guix ui)
#:use-module (guix store)
#:use-module (guix scripts)
#:use-module (guix scripts build)
#:use-module (gnu packages)
@ -53,7 +54,7 @@
(lint-warning-message lint-warning))))
warnings))
(define (run-checkers package checkers)
(define* (run-checkers package checkers #:key store)
"Run the given CHECKERS on PACKAGE."
(let ((tty? (isatty? (current-error-port))))
(for-each (lambda (checker)
@ -63,7 +64,9 @@
(lint-checker-name checker))
(force-output (current-error-port)))
(emit-warnings
((lint-checker-check checker) package)))
(if (lint-checker-requires-store? checker)
((lint-checker-check checker) package #:store store)
((lint-checker-check checker) package))))
checkers)
(when tty?
(format (current-error-port) "\x1b[K")
@ -167,12 +170,27 @@ run the checkers on all packages.\n"))
(_ #f))
(reverse opts)))
(checkers (or (assoc-ref opts 'checkers) %all-checkers)))
(cond
((assoc-ref opts 'list?)
(when (assoc-ref opts 'list?)
(list-checkers-and-exit checkers))
((null? args)
(fold-packages (lambda (p r) (run-checkers p checkers)) '()))
(else
(for-each (lambda (spec)
(run-checkers (specification->package spec) checkers))
args)))))
(let ((any-lint-checker-requires-store?
(any lint-checker-requires-store? checkers)))
(define (call-maybe-with-store proc)
(if any-lint-checker-requires-store?
(with-store store
(proc store))
(proc #f)))
(call-maybe-with-store
(lambda (store)
(cond
((null? args)
(fold-packages (lambda (p r) (run-checkers p checkers
#:store store)) '()))
(else
(for-each (lambda (spec)
(run-checkers (specification->package spec) checkers
#:store store))
args))))))))

200
guix/scripts/pack.scm
View File

@ -373,6 +373,10 @@ added to the pack."
;; file system since it's useless in this case.
"-no-recovery"
;; Do not attempt to store extended attributes.
;; See <https://bugs.gnu.org/40043>.
"-no-xattrs"
;; Set file times and the file system creation time to
;; one second after the Epoch.
"-all-time" "1" "-mkfs-time" "1"
@ -1022,108 +1026,106 @@ Create a bundle of PACKAGE.\n"))
;; Set the build options before we do anything else.
(set-build-options-from-command-line store opts)
(parameterize ((%graft? (assoc-ref opts 'graft?))
(%guile-for-build (package-derivation
store
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(default-guile))
(assoc-ref opts 'system)
#:graft? (assoc-ref opts 'graft?))))
(let* ((dry-run? (assoc-ref opts 'dry-run?))
(derivation? (assoc-ref opts 'derivation-only?))
(relocatable? (assoc-ref opts 'relocatable?))
(proot? (eq? relocatable? 'proot))
(manifest (let ((manifest (manifest-from-args store opts)))
;; Note: We cannot honor '--bootstrap' here because
;; 'glibc-bootstrap' lacks 'libc.a'.
(if relocatable?
(map-manifest-entries
(cut wrapped-manifest-entry <> #:proot? proot?)
manifest)
manifest)))
(pack-format (assoc-ref opts 'format))
(name (string-append (symbol->string pack-format)
"-pack"))
(target (assoc-ref opts 'target))
(bootstrap? (assoc-ref opts 'bootstrap?))
(compressor (if bootstrap?
bootstrap-xz
(assoc-ref opts 'compressor)))
(archiver (if (equal? pack-format 'squashfs)
squashfs-tools
(if bootstrap?
%bootstrap-coreutils&co
tar)))
(symlinks (assoc-ref opts 'symlinks))
(build-image (match (assq-ref %formats pack-format)
((? procedure? proc) proc)
(#f
(leave (G_ "~a: unknown pack format~%")
pack-format))))
(localstatedir? (assoc-ref opts 'localstatedir?))
(entry-point (assoc-ref opts 'entry-point))
(profile-name (assoc-ref opts 'profile-name))
(gc-root (assoc-ref opts 'gc-root)))
(define (lookup-package package)
(manifest-lookup manifest (manifest-pattern (name package))))
(with-build-handler (build-notifier #:dry-run?
(assoc-ref opts 'dry-run?)
#:use-substitutes?
(assoc-ref opts 'substitutes?))
(parameterize ((%graft? (assoc-ref opts 'graft?))
(%guile-for-build (package-derivation
store
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(default-guile))
(assoc-ref opts 'system)
#:graft? (assoc-ref opts 'graft?))))
(let* ((derivation? (assoc-ref opts 'derivation-only?))
(relocatable? (assoc-ref opts 'relocatable?))
(proot? (eq? relocatable? 'proot))
(manifest (let ((manifest (manifest-from-args store opts)))
;; Note: We cannot honor '--bootstrap' here because
;; 'glibc-bootstrap' lacks 'libc.a'.
(if relocatable?
(map-manifest-entries
(cut wrapped-manifest-entry <> #:proot? proot?)
manifest)
manifest)))
(pack-format (assoc-ref opts 'format))
(name (string-append (symbol->string pack-format)
"-pack"))
(target (assoc-ref opts 'target))
(bootstrap? (assoc-ref opts 'bootstrap?))
(compressor (if bootstrap?
bootstrap-xz
(assoc-ref opts 'compressor)))
(archiver (if (equal? pack-format 'squashfs)
squashfs-tools
(if bootstrap?
%bootstrap-coreutils&co
tar)))
(symlinks (assoc-ref opts 'symlinks))
(build-image (match (assq-ref %formats pack-format)
((? procedure? proc) proc)
(#f
(leave (G_ "~a: unknown pack format~%")
pack-format))))
(localstatedir? (assoc-ref opts 'localstatedir?))
(entry-point (assoc-ref opts 'entry-point))
(profile-name (assoc-ref opts 'profile-name))
(gc-root (assoc-ref opts 'gc-root)))
(define (lookup-package package)
(manifest-lookup manifest (manifest-pattern (name package))))
(when (null? (manifest-entries manifest))
(warning (G_ "no packages specified; building an empty pack~%")))
(when (null? (manifest-entries manifest))
(warning (G_ "no packages specified; building an empty pack~%")))
(when (and (eq? pack-format 'squashfs)
(not (any lookup-package '("bash" "bash-minimal"))))
(warning (G_ "Singularity requires you to provide a shell~%"))
(display-hint (G_ "Add @code{bash} or @code{bash-minimal} \
(when (and (eq? pack-format 'squashfs)
(not (any lookup-package '("bash" "bash-minimal"))))
(warning (G_ "Singularity requires you to provide a shell~%"))
(display-hint (G_ "Add @code{bash} or @code{bash-minimal} \
to your package list.")))
(run-with-store store
(mlet* %store-monad ((profile (profile-derivation
manifest
(run-with-store store
(mlet* %store-monad ((profile (profile-derivation
manifest
;; Always produce relative
;; symlinks for Singularity (see
;; <https://bugs.gnu.org/34913>).
#:relative-symlinks?
(or relocatable?
(eq? 'squashfs pack-format))
;; Always produce relative
;; symlinks for Singularity (see
;; <https://bugs.gnu.org/34913>).
#:relative-symlinks?
(or relocatable?
(eq? 'squashfs pack-format))
#:hooks (if bootstrap?
'()
%default-profile-hooks)
#:locales? (not bootstrap?)
#:target target))
(drv (build-image name profile
#:target
target
#:compressor
compressor
#:symlinks
symlinks
#:localstatedir?
localstatedir?
#:entry-point
entry-point
#:profile-name
profile-name
#:archiver
archiver)))
(mbegin %store-monad
(munless derivation?
(show-what-to-build* (list drv)
#:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run? dry-run?))
(mwhen derivation?
(return (format #t "~a~%"
(derivation-file-name drv))))
(munless (or derivation? dry-run?)
(built-derivations (list drv))
(mwhen gc-root
(register-root* (match (derivation->output-paths drv)
(((names . items) ...)
items))
gc-root))
(return (format #t "~a~%"
(derivation->output-path drv))))))
#:system (assoc-ref opts 'system))))))))
#:hooks (if bootstrap?
'()
%default-profile-hooks)
#:locales? (not bootstrap?)
#:target target))
(drv (build-image name profile
#:target
target
#:compressor
compressor
#:symlinks
symlinks
#:localstatedir?
localstatedir?
#:entry-point
entry-point
#:profile-name
profile-name
#:archiver
archiver)))
(mbegin %store-monad
(mwhen derivation?
(return (format #t "~a~%"
(derivation-file-name drv))))
(munless derivation?
(built-derivations (list drv))
(mwhen gc-root
(register-root* (match (derivation->output-paths drv)
(((names . items) ...)
items))
gc-root))
(return (format #t "~a~%"
(derivation->output-path drv))))))
#:system (assoc-ref opts 'system)))))))))

33
guix/scripts/package.scm
View File

@ -130,8 +130,7 @@ denote ranges as interpreted by 'matching-generations'."
#:key
(hooks %default-profile-hooks)
allow-collisions?
bootstrap? use-substitutes?
dry-run?)
bootstrap?)
"Build a new generation of PROFILE, a file name, using the packages
specified in MANIFEST, a manifest object. When ALLOW-COLLISIONS? is true,
do not treat collisions in MANIFEST as an error. HOOKS is a list of \"profile
@ -142,12 +141,8 @@ hooks\" run when building the profile."
#:hooks (if bootstrap? '() hooks)
#:locales? (not bootstrap?))))
(prof (derivation->output-path prof-drv)))
(show-what-to-build store (list prof-drv)
#:use-substitutes? use-substitutes?
#:dry-run? dry-run?)
(cond
(dry-run? #t)
((and (file-exists? profile)
(and=> (readlink* profile) (cut string=? prof <>)))
(format (current-error-port) (G_ "nothing to be done~%")))
@ -164,10 +159,6 @@ hooks\" run when building the profile."
(switch-symlinks profile (basename name))
(unless (string=? profile %current-profile)
(register-gc-root store name))
(format #t (N_ "~a package in profile~%"
"~a packages in profile~%"
count)
count)
(display-search-path-hint entries profile)))
(warn-about-disk-space profile))))))
@ -918,9 +909,7 @@ processed, #f otherwise."
#:dry-run? dry-run?)
(build-and-use-profile store profile new
#:allow-collisions? allow-collisions?
#:bootstrap? bootstrap?
#:use-substitutes? substitutes?
#:dry-run? dry-run?)))))
#:bootstrap? bootstrap?)))))
;;;
@ -949,10 +938,14 @@ option processing with 'parse-command-line'."
(%graft? (assoc-ref opts 'graft?)))
(with-status-verbosity (assoc-ref opts 'verbosity)
(set-build-options-from-command-line (%store) opts)
(parameterize ((%guile-for-build
(package-derivation
(%store)
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(default-guile)))))
(process-actions (%store) opts)))))))
(with-build-handler (build-notifier #:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run?
(assoc-ref opts 'dry-run?))
(parameterize ((%guile-for-build
(package-derivation
(%store)
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(default-guile)))))
(process-actions (%store) opts))))))))

135
guix/scripts/pull.scm
View File

@ -269,7 +269,7 @@ code, to PORT."
(let ((body (or (assoc-ref body language)
(assoc-ref body (%default-message-language))
"")))
(format port " ~a~%"
(format port "~a~%"
(indented-string
(parameterize ((%text-width (- (%text-width) 4)))
(string-trim-right
@ -389,8 +389,7 @@ previous generation. Return true if there are news to display."
(display-channel-news profile))
(define* (build-and-install instances profile
#:key use-substitutes? dry-run?)
(define* (build-and-install instances profile)
"Build the tool from SOURCE, and install it in PROFILE. When DRY-RUN? is
true, display what would be built without actually building it."
(define update-profile
@ -403,29 +402,27 @@ true, display what would be built without actually building it."
(mlet %store-monad ((manifest (channel-instances->manifest instances)))
(mbegin %store-monad
(update-profile profile manifest
#:use-substitutes? use-substitutes?
#:hooks %channel-profile-hooks
#:dry-run? dry-run?)
(munless dry-run?
(return (newline))
(return
(let ((more? (list (display-profile-news profile #:concise? #t)
(display-channel-news-headlines profile))))
(when (any ->bool more?)
(display-hint
(G_ "Run @command{guix pull --news} to read all the news.")))))
(if guix-command
(let ((new (map (cut string-append <> "/bin/guix")
(list (user-friendly-profile profile)
profile))))
;; Is the 'guix' command previously in $PATH the same as the new
;; one? If the answer is "no", then suggest 'hash guix'.
(unless (member guix-command new)
(display-hint (format #f (G_ "After setting @code{PATH}, run
#:hooks %channel-profile-hooks)
(return
(let ((more? (list (display-profile-news profile #:concise? #t)
(display-channel-news-headlines profile))))
(newline)
(when (any ->bool more?)
(display-hint
(G_ "Run @command{guix pull --news} to read all the news.")))))
(if guix-command
(let ((new (map (cut string-append <> "/bin/guix")
(list (user-friendly-profile profile)
profile))))
;; Is the 'guix' command previously in $PATH the same as the new
;; one? If the answer is "no", then suggest 'hash guix'.
(unless (member guix-command new)
(display-hint (format #f (G_ "After setting @code{PATH}, run
@command{hash guix} to make sure your shell refers to @file{~a}.")
(first new))))
(return #f))
(return #f))))))
(first new))))
(return #f))
(return #f)))))
(define (honor-lets-encrypt-certificates! store)
"Tell Guile-Git to use the Let's Encrypt certificates."
@ -523,19 +520,6 @@ true, display what would be built without actually building it."
;;; Queries.
;;;
(define (indented-string str indent)
"Return STR with each newline preceded by IDENT spaces."
(define indent-string
(make-list indent #\space))
(list->string
(string-fold-right (lambda (chr result)
(if (eqv? chr #\newline)
(cons chr (append indent-string result))
(cons chr result)))
'()
str)))
(define profile-package-alist
(mlambda (profile)
"Return a name/version alist representing the packages in PROFILE."
@ -592,7 +576,7 @@ Return true when there is more package info to display."
(define (pretty str column)
(indented-string (fill-paragraph str (- (%text-width) 4)
column)
4))
4 #:initial-indent? #f))
(define concise/max-item-count
;; Maximum number of items to display when CONCISE? is true.
@ -760,10 +744,12 @@ Use '~/.config/guix/channels.scm' instead."))
(define (guix-pull . args)
(with-error-handling
(with-git-error-handling
(let* ((opts (parse-command-line args %options
(list %default-options)))
(channels (channel-list opts))
(profile (or (assoc-ref opts 'profile) %current-profile)))
(let* ((opts (parse-command-line args %options
(list %default-options)))
(substitutes? (assoc-ref opts 'substitutes?))
(dry-run? (assoc-ref opts 'dry-run?))
(channels (channel-list opts))
(profile (or (assoc-ref opts 'profile) %current-profile)))
(cond ((assoc-ref opts 'query)
(process-query opts profile))
((assoc-ref opts 'generation)
@ -773,38 +759,37 @@ Use '~/.config/guix/channels.scm' instead."))
(with-status-verbosity (assoc-ref opts 'verbosity)
(parameterize ((%current-system (assoc-ref opts 'system))
(%graft? (assoc-ref opts 'graft?)))
(set-build-options-from-command-line store opts)
(ensure-default-profile)
(honor-x509-certificates store)
(with-build-handler (build-notifier #:use-substitutes?
substitutes?
#:dry-run? dry-run?)
(set-build-options-from-command-line store opts)
(ensure-default-profile)
(honor-x509-certificates store)
(let ((instances (latest-channel-instances store channels)))
(format (current-error-port)
(N_ "Building from this channel:~%"
"Building from these channels:~%"
(length instances)))
(for-each (lambda (instance)
(let ((channel
(channel-instance-channel instance)))
(format (current-error-port)
" ~10a~a\t~a~%"
(channel-name channel)
(channel-url channel)
(string-take
(channel-instance-commit instance)
7))))
instances)
(parameterize ((%guile-for-build
(package-derivation
store
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(default-guile)))))
(with-profile-lock profile
(run-with-store store
(build-and-install instances profile
#:dry-run?
(assoc-ref opts 'dry-run?)
#:use-substitutes?
(assoc-ref opts 'substitutes?)))))))))))))))
(let ((instances (latest-channel-instances store channels)))
(format (current-error-port)
(N_ "Building from this channel:~%"
"Building from these channels:~%"
(length instances)))
(for-each (lambda (instance)
(let ((channel
(channel-instance-channel instance)))
(format (current-error-port)
" ~10a~a\t~a~%"
(channel-name channel)
(channel-url channel)
(string-take
(channel-instance-commit instance)
7))))
instances)
(parameterize ((%guile-for-build
(package-derivation
store
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(default-guile)))))
(with-profile-lock profile
(run-with-store store
(build-and-install instances profile)))))))))))))))
;;; pull.scm ends here

7
guix/scripts/substitute.scm
View File

@ -102,13 +102,6 @@
;;;
;;; Code:
(cond-expand
(guile-2.2
;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it.
(define time-monotonic time-tai))
(else #t))
(define %narinfo-cache-directory
;; A local cache of narinfos, to avoid going to the network. Most of the
;; time, 'guix substitute' is called by guix-daemon as root and stores its

96
guix/scripts/system.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
@ -27,6 +27,7 @@
#:use-module ((guix status) #:select (with-status-verbosity))
#:use-module (guix store)
#:autoload (guix store database) (register-path)
#:use-module (guix describe)
#:use-module (guix grafts)
#:use-module (guix gexp)
#:use-module (guix derivations)
@ -403,7 +404,6 @@ STORE is an open connection to the store."
#:old-entries old-entries)))
(drvs -> (list bootcfg)))
(mbegin %store-monad
(show-what-to-build* drvs)
(built-derivations drvs)
;; Only install bootloader configuration file.
(install-bootloader local-eval bootloader-config bootcfg
@ -719,16 +719,11 @@ checking this by themselves in their 'check' procedure."
(define (maybe-suggest-running-guix-pull)
"Suggest running 'guix pull' if this has never been done before."
;; The reason for this is that the 'guix' binding that we see here comes
;; from either ~/.config/latest or, if it's missing, from the
;; globally-installed Guix, which is necessarily older. See
;; <http://lists.gnu.org/archive/html/guix-devel/2014-08/msg00057.html> for
;; a discussion.
(define latest
(string-append (config-directory) "/current"))
(unless (file-exists? latest)
(warning (G_ "~a not found: 'guix pull' was never run~%") latest)
;; Check whether we're running a 'guix pull'-provided 'guix' command. When
;; 'current-profile' returns #f, we may be running the globally-installed
;; 'guix' and thus run the risk of deploying an older 'guix'. See
;; <https://lists.gnu.org/archive/html/guix-devel/2014-08/msg00057.html>
(unless (or (current-profile) (getenv "GUIX_UNINSTALLED"))
(warning (G_ "Consider running 'guix pull' before 'reconfigure'.~%"))
(warning (G_ "Failing to do that may downgrade your system!~%"))))
@ -837,8 +832,7 @@ static checks."
(% (if derivations-only?
(return (for-each (compose println derivation-file-name)
drvs))
(maybe-build drvs #:dry-run? dry-run?
#:use-substitutes? use-substitutes?))))
(built-derivations drvs))))
(if (or dry-run? derivations-only?)
(return #f)
@ -1139,42 +1133,46 @@ resulting from command-line parsing."
(with-store store
(set-build-options-from-command-line store opts)
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(case action
((extension-graph)
(export-extension-graph os (current-output-port)))
((shepherd-graph)
(export-shepherd-graph os (current-output-port)))
(else
(unless (memq action '(build init))
(warn-about-old-distro #:suggested-command
"guix system reconfigure"))
(with-build-handler (build-notifier #:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run?
(assoc-ref opts 'dry-run?))
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(case action
((extension-graph)
(export-extension-graph os (current-output-port)))
((shepherd-graph)
(export-shepherd-graph os (current-output-port)))
(else
(unless (memq action '(build init))
(warn-about-old-distro #:suggested-command
"guix system reconfigure"))
(perform-action action os
#:dry-run? dry?
#:derivations-only? (assoc-ref opts
'derivations-only?)
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:skip-safety-checks?
(assoc-ref opts 'skip-safety-checks?)
#:file-system-type (assoc-ref opts 'file-system-type)
#:image-size (assoc-ref opts 'image-size)
#:full-boot? (assoc-ref opts 'full-boot?)
#:container-shared-network?
(assoc-ref opts 'container-shared-network?)
#:mappings (filter-map (match-lambda
(('file-system-mapping . m)
m)
(_ #f))
opts)
#:install-bootloader? bootloader?
#:target target-file
#:bootloader-target bootloader-target
#:gc-root (assoc-ref opts 'gc-root)))))
#:target target
#:system system))
(perform-action action os
#:dry-run? dry?
#:derivations-only? (assoc-ref opts
'derivations-only?)
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:skip-safety-checks?
(assoc-ref opts 'skip-safety-checks?)
#:file-system-type (assoc-ref opts 'file-system-type)
#:image-size (assoc-ref opts 'image-size)
#:full-boot? (assoc-ref opts 'full-boot?)
#:container-shared-network?
(assoc-ref opts 'container-shared-network?)
#:mappings (filter-map (match-lambda
(('file-system-mapping . m)
m)
(_ #f))
opts)
#:install-bootloader? bootloader?
#:target target-file
#:bootloader-target bootloader-target
#:gc-root (assoc-ref opts 'gc-root)))))
#:target target
#:system system)))
(warn-about-disk-space)))
(define (resolve-subcommand name)

7
guix/scripts/weather.scm
View File

@ -106,13 +106,6 @@ scope."
'()
packages)))))
(cond-expand
(guile-2.2
;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it.
(define time-monotonic time-tai))
(else #t))
(define (call-with-time thunk kont)
"Call THUNK and pass KONT the elapsed time followed by THUNK's return
values."

22
guix/ssh.scm
View File

@ -1,5 +1,5 @@
;;; 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>
;;;
;;; This file is part of GNU Guix.
;;;
@ -405,11 +405,24 @@ to the system ACL file if it has not yet been authorized."
"Send the subset of FILES from LOCAL (a local store) that's missing to
REMOTE, a remote store. When RECURSIVE? is true, send the closure of FILES.
Return the list of store items actually sent."
(define (inferior-remote-eval* exp session)
(guard (c ((inferior-exception? c)
(match (inferior-exception-arguments c)
(('quit 7)
(report-module-error (remote-store-host remote)))
(_
(report-inferior-exception c (remote-store-host remote))))))
(inferior-remote-eval exp session)))
;; Compute the subset of FILES missing on SESSION and send them.
(let* ((files (if recursive? (requisites local files) files))
(session (channel-get-session (store-connection-socket remote)))
(missing (inferior-remote-eval
(missing (inferior-remote-eval*
`(begin
(eval-when (load expand eval)
(unless (resolve-module '(guix) #:ensure #f)
(exit 7)))
(use-modules (guix)
(srfi srfi-1) (srfi srfi-26))
@ -567,4 +580,9 @@ own module directory. Run @command{ssh ~A env | grep GUILE_LOAD_PATH} to
check.")
host)))
(define (report-inferior-exception exception host)
"Report EXCEPTION, an &inferior-exception that occurred on HOST."
(raise-error (G_ "exception occurred on remote host '~A': ~s")
host (inferior-exception-arguments exception)))
;;; ssh.scm ends here

10
guix/status.scm
View File

@ -1,5 +1,5 @@
;;; 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 © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
@ -476,6 +476,14 @@ addition to build events."
"applying ~a grafts for ~a..."
count))
count drv)))
('profile
(let ((count (match (assq-ref properties 'profile)
(#f 0)
(lst (or (assq-ref lst 'count) 0)))))
(format port (info (N_ "building profile with ~a package..."
"building profile with ~a packages..."
count))
count)))
('profile-hook
(let ((hook-type (assq-ref properties 'hook)))
(or (and=> (hook-message hook-type)

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