diff options
author | Marius Bakke <mbakke@fastmail.com> | 2019-07-07 01:18:18 +0200 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2019-07-07 01:18:18 +0200 |
commit | 36175a3a9eb5bd4096de4e06e1f6b0e8cd895d84 (patch) | |
tree | 7c2d8dd2267b2dc533d5f59acc137641e2325e52 /gnu | |
parent | 42dcfca4cc424aa790d8fb62eb327782fd08aad7 (diff) | |
parent | c72647fbae675654e32e17a6891980a7b9272a71 (diff) |
Merge branch 'master' into staging
Diffstat (limited to 'gnu')
-rw-r--r-- | gnu/build/linux-container.scm | 7 | ||||
-rw-r--r-- | gnu/ci.scm | 6 | ||||
-rw-r--r-- | gnu/local.mk | 6 | ||||
-rw-r--r-- | gnu/machine.scm | 107 | ||||
-rw-r--r-- | gnu/machine/ssh.scm | 369 | ||||
-rw-r--r-- | gnu/packages/bioinformatics.scm | 6 | ||||
-rw-r--r-- | gnu/packages/dictionaries.scm | 4 | ||||
-rw-r--r-- | gnu/packages/gnome.scm | 2 | ||||
-rw-r--r-- | gnu/packages/guile-xyz.scm | 2 | ||||
-rw-r--r-- | gnu/packages/image.scm | 30 | ||||
-rw-r--r-- | gnu/packages/lisp.scm | 501 | ||||
-rw-r--r-- | gnu/packages/logo.scm | 71 | ||||
-rw-r--r-- | gnu/packages/patchutils.scm | 4 | ||||
-rw-r--r-- | gnu/packages/photo.scm | 8 | ||||
-rw-r--r-- | gnu/packages/pulseaudio.scm | 58 | ||||
-rw-r--r-- | gnu/packages/python-xyz.scm | 118 | ||||
-rw-r--r-- | gnu/packages/serialization.scm | 14 | ||||
-rw-r--r-- | gnu/packages/wine.scm | 6 | ||||
-rw-r--r-- | gnu/tests/docker.scm | 18 | ||||
-rw-r--r-- | gnu/tests/install.scm | 2 | ||||
-rw-r--r-- | gnu/tests/singularity.scm | 18 |
21 files changed, 1303 insertions, 54 deletions
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm index e86ac606c0..6ccb924861 100644 --- a/gnu/build/linux-container.scm +++ b/gnu/build/linux-container.scm @@ -130,9 +130,14 @@ for the process." "/dev/random" "/dev/urandom" "/dev/tty" - "/dev/ptmx" "/dev/fuse")) + ;; Mount a new devpts instance on /dev/pts. + (when (file-exists? "/dev/ptmx") + (mount* "none" (scope "/dev/pts") "devpts" 0 + "newinstance,mode=0620") + (symlink "/dev/pts/ptmx" (scope "/dev/ptmx"))) + ;; Setup the container's /dev/console by bind mounting the pseudo-terminal ;; associated with standard input when there is one. (let* ((in (current-input-port)) diff --git a/gnu/ci.scm b/gnu/ci.scm index e108b4b15b..4885870e16 100644 --- a/gnu/ci.scm +++ b/gnu/ci.scm @@ -193,9 +193,11 @@ system.") (define channel-build-system ;; Build system used to "convert" a channel instance to a package. (let* ((build (lambda* (store name inputs - #:key instance #:allow-other-keys) + #:key instance system + #:allow-other-keys) (run-with-store store - (channel-instances->derivation (list instance))))) + (channel-instances->derivation (list instance)) + #:system system))) (lower (lambda* (name #:key system instance #:allow-other-keys) (bag (name name) diff --git a/gnu/local.mk b/gnu/local.mk index 6e90d88689..68a43330c4 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -299,6 +299,7 @@ GNU_SYSTEM_MODULES = \ %D%/packages/llvm.scm \ %D%/packages/lout.scm \ %D%/packages/logging.scm \ + %D%/packages/logo.scm \ %D%/packages/lolcode.scm \ %D%/packages/lsof.scm \ %D%/packages/lua.scm \ @@ -564,6 +565,9 @@ GNU_SYSTEM_MODULES = \ %D%/system/uuid.scm \ %D%/system/vm.scm \ \ + %D%/machine.scm \ + %D%/machine/ssh.scm \ + \ %D%/build/accounts.scm \ %D%/build/activation.scm \ %D%/build/bootloader.scm \ @@ -629,7 +633,7 @@ INSTALLER_MODULES = \ %D%/installer/newt/user.scm \ %D%/installer/newt/utils.scm \ %D%/installer/newt/welcome.scm \ - %D%/installer/newt/wifi.scm + %D%/installer/newt/wifi.scm # Always ship the installer modules but compile them only when # ENABLE_INSTALLER is true. diff --git a/gnu/machine.scm b/gnu/machine.scm new file mode 100644 index 0000000000..0b79402b0a --- /dev/null +++ b/gnu/machine.scm @@ -0,0 +1,107 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 David Thompson <davet@gnu.org> +;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.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 machine) + #:use-module (gnu system) + #:use-module (guix derivations) + #:use-module (guix monads) + #:use-module (guix records) + #:use-module (guix store) + #:use-module ((guix utils) #:select (source-properties->location)) + #:export (environment-type + environment-type? + environment-type-name + environment-type-description + environment-type-location + + machine + machine? + this-machine + + machine-system + machine-environment + machine-configuration + machine-display-name + + deploy-machine + machine-remote-eval)) + +;;; Commentary: +;;; +;;; This module provides the types used to declare individual machines in a +;;; heterogeneous Guix deployment. The interface allows users of specify system +;;; configurations and the means by which resources should be provisioned on a +;;; per-host basis. +;;; +;;; Code: + + +;;; +;;; Declarations for resources that can be provisioned. +;;; + +(define-record-type* <environment-type> environment-type + make-environment-type + environment-type? + + ;; Interface to the environment type's deployment code. Each procedure + ;; should take the same arguments as the top-level procedure of this file + ;; that shares the same name. For example, 'machine-remote-eval' should be + ;; of the form '(machine-remote-eval machine exp)'. + (machine-remote-eval environment-type-machine-remote-eval) ; procedure + (deploy-machine environment-type-deploy-machine) ; procedure + + ;; Metadata. + (name environment-type-name) ; symbol + (description environment-type-description ; string + (default #f)) + (location environment-type-location ; <location> + (default (and=> (current-source-location) + source-properties->location)) + (innate))) + + +;;; +;;; Declarations for machines in a deployment. +;;; + +(define-record-type* <machine> machine + make-machine + machine? + this-machine + (system machine-system) ; <operating-system> + (environment machine-environment) ; symbol + (configuration machine-configuration ; configuration object + (default #f))) ; specific to environment + +(define (machine-display-name machine) + "Return the host-name identifying MACHINE." + (operating-system-host-name (machine-system machine))) + +(define (machine-remote-eval machine exp) + "Evaluate EXP, a gexp, on MACHINE. Ensure that all the elements EXP refers to +are built and deployed to MACHINE beforehand." + (let ((environment (machine-environment machine))) + ((environment-type-machine-remote-eval environment) machine exp))) + +(define (deploy-machine machine) + "Monadic procedure transferring the new system's OS closure to the remote +MACHINE, activating it on MACHINE and switching MACHINE to the new generation." + (let ((environment (machine-environment machine))) + ((environment-type-deploy-machine environment) machine))) diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm new file mode 100644 index 0000000000..a7d1a967ae --- /dev/null +++ b/gnu/machine/ssh.scm @@ -0,0 +1,369 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.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 machine ssh) + #:use-module (gnu bootloader) + #:use-module (gnu machine) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu system) + #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix i18n) + #:use-module (guix modules) + #:use-module (guix monads) + #:use-module (guix records) + #:use-module (guix remote) + #:use-module (guix ssh) + #:use-module (guix store) + #:use-module (ice-9 match) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-35) + #:export (managed-host-environment-type + + machine-ssh-configuration + machine-ssh-configuration? + machine-ssh-configuration + + machine-ssh-configuration-host-name + machine-ssh-configuration-port + machine-ssh-configuration-user + machine-ssh-configuration-session)) + +;;; Commentary: +;;; +;;; This module implements remote evaluation and system deployment for +;;; machines that are accessable over SSH and have a known host-name. In the +;;; sense of the broader "machine" interface, we describe the environment for +;;; such machines as 'managed-host. +;;; +;;; Code: + + +;;; +;;; Parameters for the SSH client. +;;; + +(define-record-type* <machine-ssh-configuration> machine-ssh-configuration + make-machine-ssh-configuration + machine-ssh-configuration? + this-machine-ssh-configuration + (host-name machine-ssh-configuration-host-name) ; string + (port machine-ssh-configuration-port ; integer + (default 22)) + (user machine-ssh-configuration-user ; string + (default "root")) + (identity machine-ssh-configuration-identity ; path to a private key + (default #f)) + (session machine-ssh-configuration-session ; session + (default #f))) + +(define (machine-ssh-session machine) + "Return the SSH session that was given in MACHINE's configuration, or create +one from the configuration's parameters if one was not provided." + (maybe-raise-unsupported-configuration-error machine) + (let ((config (machine-configuration machine))) + (or (machine-ssh-configuration-session config) + (let ((host-name (machine-ssh-configuration-host-name config)) + (user (machine-ssh-configuration-user config)) + (port (machine-ssh-configuration-port config)) + (identity (machine-ssh-configuration-identity config))) + (open-ssh-session host-name + #:user user + #:port port + #:identity identity))))) + + +;;; +;;; Remote evaluation. +;;; + +(define (managed-host-remote-eval machine exp) + "Internal implementation of 'machine-remote-eval' for MACHINE instances with +an environment type of 'managed-host." + (maybe-raise-unsupported-configuration-error machine) + (remote-eval exp (machine-ssh-session machine))) + + +;;; +;;; System deployment. +;;; + +(define (switch-to-system machine) + "Monadic procedure creating a new generation on MACHINE and execute the +activation script for the new system configuration." + (define (remote-exp drv script) + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles) + (guix utils))) + #~(begin + (use-modules (guix config) + (guix profiles) + (guix utils)) + + (define %system-profile + (string-append %state-directory "/profiles/system")) + + (let* ((system #$drv) + (number (1+ (generation-number %system-profile))) + (generation (generation-file-name %system-profile number))) + (switch-symlinks generation system) + (switch-symlinks %system-profile generation) + ;; The implementation of 'guix system reconfigure' saves the + ;; load path and environment here. This is unnecessary here + ;; because each invocation of 'remote-eval' runs in a distinct + ;; Guile REPL. + (setenv "GUIX_NEW_SYSTEM" system) + ;; The activation script may write to stdout, which confuses + ;; 'remote-eval' when it attempts to read a result from the + ;; remote REPL. We work around this by forcing the output to a + ;; string. + (with-output-to-string + (lambda () + (primitive-load #$script)))))))) + + (let* ((os (machine-system machine)) + (script (operating-system-activation-script os))) + (mlet* %store-monad ((drv (operating-system-derivation os))) + (machine-remote-eval machine (remote-exp drv script))))) + +;; XXX: Currently, this does NOT attempt to restart running services. This is +;; also the case with 'guix system reconfigure'. +;; +;; See <https://issues.guix.info/issue/33508>. +(define (upgrade-shepherd-services machine) + "Monadic procedure unloading and starting services on the remote as needed +to realize the MACHINE's system configuration." + (define target-services + ;; Monadic expression evaluating to a list of (name output-path) pairs for + ;; all of MACHINE's services. + (mapm %store-monad + (lambda (service) + (mlet %store-monad ((file ((compose lower-object + shepherd-service-file) + service))) + (return (list (shepherd-service-canonical-name service) + (derivation->output-path file))))) + (service-value + (fold-services (operating-system-services (machine-system machine)) + #:target-type shepherd-root-service-type)))) + + (define (remote-exp target-services) + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + + (define running + (filter live-service-running (current-services))) + + (define (essential? service) + ;; Return #t if SERVICE is essential and should not be unloaded + ;; under any circumstance. + (memq (first (live-service-provision service)) + '(root shepherd))) + + (define (obsolete? service) + ;; Return #t if SERVICE can be safely unloaded. + (and (not (essential? service)) + (every (lambda (requirements) + (not (memq (first (live-service-provision service)) + requirements))) + (map live-service-requirement running)))) + + (define to-unload + (filter obsolete? + (remove (lambda (service) + (memq (first (live-service-provision service)) + (map first '#$target-services))) + running))) + + (define to-start + (remove (lambda (service-pair) + (memq (first service-pair) + (map (compose first live-service-provision) + running))) + '#$target-services)) + + ;; Unload obsolete services. + (for-each (lambda (service) + (false-if-exception + (unload-service service))) + to-unload) + + ;; Load the service files for any new services and start them. + (load-services/safe (map second to-start)) + (for-each start-service (map first to-start)) + + #t))) + + (mlet %store-monad ((target-services target-services)) + (machine-remote-eval machine (remote-exp target-services)))) + +(define (machine-boot-parameters machine) + "Monadic procedure returning a list of 'boot-parameters' for the generations +of MACHINE's system profile, ordered from most recent to oldest." + (define bootable-kernel-arguments + (@@ (gnu system) bootable-kernel-arguments)) + + (define remote-exp + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles))) + #~(begin + (use-modules (guix config) + (guix profiles) + (ice-9 textual-ports)) + + (define %system-profile + (string-append %state-directory "/profiles/system")) + + (define (read-file path) + (call-with-input-file path + (lambda (port) + (get-string-all port)))) + + (map (lambda (generation) + (let* ((system-path (generation-file-name %system-profile + generation)) + (boot-parameters-path (string-append system-path + "/parameters")) + (time (stat:mtime (lstat system-path)))) + (list generation + system-path + time + (read-file boot-parameters-path)))) + (reverse (generation-numbers %system-profile))))))) + + (mlet* %store-monad ((generations (machine-remote-eval machine remote-exp))) + (return + (map (lambda (generation) + (match generation + ((generation system-path time serialized-params) + (let* ((params (call-with-input-string serialized-params + read-boot-parameters)) + (root (boot-parameters-root-device params)) + (label (boot-parameters-label params))) + (boot-parameters + (inherit params) + (label + (string-append label " (#" + (number->string generation) ", " + (let ((time (make-time time-utc 0 time))) + (date->string (time-utc->date time) + "~Y-~m-~d ~H:~M")) + ")")) + (kernel-arguments + (append (bootable-kernel-arguments system-path root) + (boot-parameters-kernel-arguments params)))))))) + generations)))) + +(define (install-bootloader machine) + "Create a bootloader entry for the new system generation on MACHINE, and +configure the bootloader to boot that generation by default." + (define bootloader-installer-script + (@@ (guix scripts system) bootloader-installer-script)) + + (define (remote-exp installer bootcfg bootcfg-file) + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((gnu build install) + (guix store) + (guix utils))) + #~(begin + (use-modules (gnu build install) + (guix store) + (guix utils)) + (let* ((gc-root (string-append "/" %gc-roots-directory "/bootcfg")) + (temp-gc-root (string-append gc-root ".new"))) + + (switch-symlinks temp-gc-root gc-root) + + (unless (false-if-exception + (begin + ;; The implementation of 'guix system reconfigure' + ;; saves the load path here. This is unnecessary here + ;; because each invocation of 'remote-eval' runs in a + ;; distinct Guile REPL. + (install-boot-config #$bootcfg #$bootcfg-file "/") + ;; The installation script may write to stdout, which + ;; confuses 'remote-eval' when it attempts to read a + ;; result from the remote REPL. We work around this + ;; by forcing the output to a string. + (with-output-to-string + (lambda () + (primitive-load #$installer))))) + (delete-file temp-gc-root) + (error "failed to install bootloader")) + + (rename-file temp-gc-root gc-root) + #t))))) + + (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine))) + (let* ((os (machine-system machine)) + (bootloader ((compose bootloader-configuration-bootloader + operating-system-bootloader) + os)) + (bootloader-target (bootloader-configuration-target + (operating-system-bootloader os))) + (installer (bootloader-installer-script + (bootloader-installer bootloader) + (bootloader-package bootloader) + bootloader-target + "/")) + (menu-entries (map boot-parameters->menu-entry boot-parameters)) + (bootcfg (operating-system-bootcfg os menu-entries)) + (bootcfg-file (bootloader-configuration-file bootloader))) + (machine-remote-eval machine (remote-exp installer bootcfg bootcfg-file))))) + +(define (deploy-managed-host machine) + "Internal implementation of 'deploy-machine' for MACHINE instances with an +environment type of 'managed-host." + (maybe-raise-unsupported-configuration-error machine) + (mbegin %store-monad + (switch-to-system machine) + (upgrade-shepherd-services machine) + (install-bootloader machine))) + + +;;; +;;; Environment type. +;;; + +(define managed-host-environment-type + (environment-type + (machine-remote-eval managed-host-remote-eval) + (deploy-machine deploy-managed-host) + (name 'managed-host-environment-type) + (description "Provisioning for machines that are accessable over SSH +and have a known host-name. This entails little more than maintaining an SSH +connection to the host."))) + +(define (maybe-raise-unsupported-configuration-error machine) + "Raise an error if MACHINE's configuration is not an instance of +<machine-ssh-configuration>." + (let ((config (machine-configuration machine)) + (environment (environment-type-name (machine-environment machine)))) + (unless (and config (machine-ssh-configuration? config)) + (raise (condition + (&message + (message (format #f (G_ "unsupported machine configuration '~a' +for environment of type '~a'") + config + environment)))))))) diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index 9a30a0eaff..f8ac41c249 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -14069,11 +14069,11 @@ choosing which reads pass the filter.") ;; <https://github.com/jts/nanopolish#installing-a-particular-release>. ;; Also, the differences between release and current version seem to be ;; significant. - (let ((commit "50e8b5cc62f9b46f5445f5c5e8c5ab7263ea6d9d") + (let ((commit "6331dc4f15b9dfabb954ba3fae9d76b6c3ca6377") (revision "1")) (package (name "nanopolish") - (version (git-version "0.10.2" revision commit)) + (version (git-version "0.11.1" revision commit)) (source (origin (method git-fetch) @@ -14083,7 +14083,7 @@ choosing which reads pass the filter.") (recursive? #t))) (file-name (git-file-name name version)) (sha256 - (base32 "09j5gz57yr9i34a27vbl72i4g8syv2zzgmsfyjq02yshmnrvkjs6")) + (base32 "15ikl3d37y49pwd7vx36xksgsqajhf24q7qqsnpl15dqqyy5qgbc")) (modules '((guix build utils))) (snippet '(begin diff --git a/gnu/packages/dictionaries.scm b/gnu/packages/dictionaries.scm index 9f4dc59cc8..d3a3f8d832 100644 --- a/gnu/packages/dictionaries.scm +++ b/gnu/packages/dictionaries.scm @@ -218,7 +218,7 @@ It comes with a German-English dictionary with approximately 270,000 entries.") (define-public grammalecte (package (name "grammalecte") - (version "1.1.1") + (version "1.2") (source (origin (method url-fetch/zipbomb) @@ -226,7 +226,7 @@ It comes with a German-English dictionary with approximately 270,000 entries.") "Grammalecte-fr-v" version ".zip")) (sha256 (base32 - "1al4c3976wgxijxghxqb1banarj82hwad51kln87xj2r5kwcfm05")))) + "0dwizai6w9yn617y7cnqdiwv77vn22p18s9sypypbl1bl695cnma")))) (build-system python-build-system) (home-page "https://grammalecte.net") (synopsis "French spelling and grammar checker") diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index 2820be0022..88d293ee9f 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -7232,7 +7232,7 @@ is suitable as a default application in a Desktop environment.") ("intltool" ,intltool) ("pkg-config" ,pkg-config))) (inputs - `(("gtksourceview" ,gtksourceview) + `(("gtksourceview" ,gtksourceview-3) ("libsm" ,libsm))) (home-page "https://wiki.gnome.org/Apps/Xpad") (synopsis "Virtual sticky note") diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm index f652a94d2e..d479fb6ea9 100644 --- a/gnu/packages/guile-xyz.scm +++ b/gnu/packages/guile-xyz.scm @@ -2348,7 +2348,7 @@ more expressive and flexible than the traditional @code{format} procedure.") ("perl" ,perl) ("pkg-config" ,pkg-config) ("texinfo" ,texinfo) - ("texlive" ,texlive))) + ("texlive" ,(texlive-union (list texlive-generic-epsf))))) (propagated-inputs `(("dbus-glib" ,dbus-glib) ("guile" ,guile-2.2) diff --git a/gnu/packages/image.scm b/gnu/packages/image.scm index ef477fa6f1..fabc2fb2d1 100644 --- a/gnu/packages/image.scm +++ b/gnu/packages/image.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2015, 2016 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> @@ -1066,6 +1066,34 @@ and XMP metadata of images in various formats.") ;; <https://launchpad.net/ubuntu/precise/+source/exiv2/+copyright>. (license license:gpl2+))) +(define-public exiv2-0.26 + (package + (inherit exiv2) + (version "0.26") + (source (origin + (method url-fetch) + (uri (list (string-append "https://www.exiv2.org/builds/exiv2-" + version "-trunk.tar.gz") + (string-append "https://www.exiv2.org/exiv2-" + version ".tar.gz") + (string-append "https://fossies.org/linux/misc/exiv2-" + version ".tar.gz"))) + (patches (search-patches "exiv2-CVE-2017-14860.patch" + "exiv2-CVE-2017-14859-14862-14864.patch")) + (sha256 + (base32 + "1yza317qxd8yshvqnay164imm0ks7cvij8y8j86p1gqi1153qpn7")))) + (build-system gnu-build-system) + (arguments '(#:tests? #f)) ; no `check' target + (propagated-inputs + `(("expat" ,expat) + ("zlib" ,zlib))) + (native-inputs + `(("intltool" ,intltool))) + + ;; People should rely on the newer version, so don't expose it. + (properties `((hidden? . #t))))) + (define-public devil (package (name "devil") diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 8250340467..3aa2429595 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -5863,11 +5863,12 @@ and @code{kqueue(2)}), a pathname library and file-system utilities.") `(("iolib.asdf" ,sbcl-iolib.asdf) ("iolib.conf" ,sbcl-iolib.conf) ("iolib.grovel" ,sbcl-iolib.grovel) - ("iolib.base", sbcl-iolib.base) - ("bordeaux-threads", sbcl-bordeaux-threads) - ("idna", sbcl-idna) - ("swap-bytes", sbcl-swap-bytes) - ("libfixposix", libfixposix))) + ("iolib.base" ,sbcl-iolib.base) + ("bordeaux-threads" ,sbcl-bordeaux-threads) + ("idna" ,sbcl-idna) + ("swap-bytes" ,sbcl-swap-bytes) + ("libfixposix" ,libfixposix) + ("cffi" ,sbcl-cffi))) (native-inputs `(("fiveam" ,sbcl-fiveam))) (arguments @@ -5953,12 +5954,12 @@ floating point values to IEEE 754 binary representation.") (name "sbcl-closure-common") (build-system asdf-build-system/sbcl) (version (git-version "20101006" revision commit)) - (home-page "https://github.com/sharplispers/closure-common") + (home-page "https://common-lisp.net/project/cxml/") (source (origin (method git-fetch) (uri (git-reference - (url home-page) + (url "https://github.com/sharplispers/closure-common") (commit commit))) (file-name (git-file-name name version)) (sha256 @@ -5973,6 +5974,111 @@ Closure is a reference to the web browser it was originally written for.") ;; TODO: License? (license #f)))) +(define-public sbcl-cxml+xml + (let ((commit "00b22bf4c4cf11c993d5866fae284f95ab18e6bf") + (revision "1")) + (package + (name "sbcl-cxml+xml") + (build-system asdf-build-system/sbcl) + (version (git-version "0.0.0" revision commit)) + (home-page "https://common-lisp.net/project/cxml/") + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/sharplispers/cxml") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "13kif7rf3gqdycsk9zq0d7y0g9y81krkl0z87k0p2fkbjfgrph37")))) + (inputs + `(("closure-common" ,sbcl-closure-common) + ("puri" ,sbcl-puri) + ("trivial-gray-streams" ,sbcl-trivial-gray-streams))) + (arguments + `(#:asd-file "cxml.asd" + #:asd-system-name "cxml/xml")) + (synopsis "Common Lisp XML parser") + (description "CXML implements a namespace-aware, validating XML 1.0 +parser as well as the DOM Level 2 Core interfaces. Two parser interfaces are +offered, one SAX-like, the other similar to StAX.") + (license license:llgpl)))) + +(define sbcl-cxml+dom + (package + (inherit sbcl-cxml+xml) + (name "sbcl-cxml+dom") + (inputs + `(("closure-common" ,sbcl-closure-common) + ("puri" ,sbcl-puri) + ("cxml+xml" ,sbcl-cxml+xml))) + (arguments + `(#:asd-file "cxml.asd" + #:asd-system-name "cxml/dom")))) + +(define sbcl-cxml+klacks + (package + (inherit sbcl-cxml+xml) + (name "sbcl-cxml+klacks") + (inputs + `(("closure-common" ,sbcl-closure-common) + ("puri" ,sbcl-puri) + ("cxml+xml" ,sbcl-cxml+xml))) + (arguments + `(#:asd-file "cxml.asd" + #:asd-system-name "cxml/klacks")))) + +(define sbcl-cxml+test + (package + (inherit sbcl-cxml+xml) + (name "sbcl-cxml+test") + (inputs + `(("closure-common" ,sbcl-closure-common) + ("puri" ,sbcl-puri) + ("cxml+xml" ,sbcl-cxml+xml))) + (arguments + `(#:asd-file "cxml.asd" + #:asd-system-name "cxml/test")))) + +(define-public sbcl-cxml + (package + (inherit sbcl-cxml+xml) + (name "sbcl-cxml") + (inputs + `(("closure-common" ,sbcl-closure-common) + ("puri" ,sbcl-puri) + ("trivial-gray-streams" ,sbcl-trivial-gray-streams) + ("cxml+dom" ,sbcl-cxml+dom) + ("cxml+klacks" ,sbcl-cxml+klacks) + ("cxml+test" ,sbcl-cxml+test))) + (arguments + `(#:asd-file "cxml.asd" + #:asd-system-name "cxml" + #:phases + (modify-phases %standard-phases + (add-after 'build 'install-dtd + (lambda* (#:key outputs #:allow-other-keys) + (install-file "catalog.dtd" + (string-append + (assoc-ref outputs "out") + "/lib/" (%lisp-type))))) + (add-after 'create-asd 'remove-component + ;; XXX: The original .asd has no components, but our build system + ;; creates an entry nonetheless. We need to remove it for the + ;; generated .asd to load properly. See trivia.trivial for a + ;; similar problem. + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (asd (string-append out "/lib/sbcl/cxml.asd"))) + (substitute* asd + ((" :components +") + "")) + (substitute* asd + ((" *\\(\\(:compiled-file \"cxml--system\"\\)\\)") + "")))))))))) + (define-public sbcl-cl-reexport (let ((commit "312f3661bbe187b5f28536cd7ec2956e91366c3b") (revision "1")) @@ -6092,3 +6198,384 @@ cookie headers, cookie creation, cookie jar creation and more.") (description "Dexador is yet another HTTP client for Common Lisp with neat APIs and connection-pooling. It is meant to supersede Drakma.") (license license:expat)))) + +(define-public sbcl-lisp-namespace + (let ((commit "28107cafe34e4c1c67490fde60c7f92dc610b2e0") + (revision "1")) + (package + (name "sbcl-lisp-namespace") + (build-system asdf-build-system/sbcl) + (version (git-version "0.1" revision commit)) + (home-page "https://github.com/guicho271828/lisp-namespace") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1jw2wykp06z2afb9nm1lgfzll5cjlj36pnknjx614057zkkxq4iy")))) + (inputs + `(("alexandria" ,sbcl-alexandria))) + (native-inputs + `(("fiveam" ,sbcl-fiveam))) + (arguments + `(#:test-asd-file "lisp-namespace.test.asd" + ;; XXX: Component LISP-NAMESPACE-ASD::LISP-NAMESPACE.TEST not found + #:tests? #f)) + (synopsis "LISP-N, or extensible namespaces in Common Lisp") + (description "Common Lisp already has major 2 namespaces, function +namespace and value namespace (or variable namespace), but there are actually +more — e.g., class namespace. +This library offers macros to deal with symbols from any namespace.") + (license license:llgpl)))) + +(define-public sbcl-trivial-cltl2 + (let ((commit "8eec8407df833e8f27df8a388bc10913f16d9e83") + (revision "1")) + (package + (name "sbcl-trivial-cltl2") + (build-system asdf-build-system/sbcl) + (version (git-version "0.1.1" revision commit)) + (home-page "https://github.com/Zulu-Inuoe/trivial-cltl2") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1dyyxz17vqv8hlfwq287gl8xxbvcnq798ajb7p5jdjz91wqf4bgk")))) + (synopsis "Simple CLtL2 compatibility layer for Common Lisp") + (description "This library is a portable compatibility layer around +\"Common Lisp the Language, 2nd +Edition\" (@url{https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node102.html}) +and it exports symbols from implementation-specific packages.") + (license license:llgpl)))) + +(define-public sbcl-introspect-environment + (let ((commit "fff42f8f8fd0d99db5ad6c5812e53de7d660020b") + (revision "1")) + (package + (name "sbcl-introspect-environment") + (build-system asdf-build-system/sbcl) + (version (git-version "0.1" revision commit)) + (home-page "https://github.com/Bike/introspect-environment") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1i305n0wfmpac63ni4i3vixnnkl8daw5ncxy0k3dv92krgx6qzhp")))) + (native-inputs + `(("fiveam" ,sbcl-fiveam))) + (synopsis "Common Lisp environment introspection portability layer") + (description "This library is a small interface to portable but +nonstandard introspection of Common Lisp environments. It is intended to +allow a bit more compile-time introspection of environments in Common Lisp. + +Quite a bit of information is available at the time a macro or compiler-macro +runs; inlining info, type declarations, that sort of thing. This information +is all standard - any Common Lisp program can @code{(declare (integer x))} and +such. + +This info ought to be accessible through the standard @code{&environment} +parameters, but it is not. Several implementations keep the information for +their own purposes but do not make it available to user programs, because +there is no standard mechanism to do so. + +This library uses implementation-specific hooks to make information available +to users. This is currently supported on SBCL, CCL, and CMUCL. Other +implementations have implementations of the functions that do as much as they +can and/or provide reasonable defaults.") + (license license:wtfpl2)))) + +(define-public sbcl-type-i + (let ((commit "dea233f45f94064105ec09f0767de338f67dcbe2") + (revision "1")) + (package + (name "sbcl-type-i") + (build-system asdf-build-system/sbcl) + (version (git-version "0.1" revision commit)) + (home-page "https://github.com/guicho271828/type-i") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "039g5pbrhh65s0bhr9314gmd2nwc2y5lp2377c5qrc2lxky89qs3")))) + (inputs + `(("alexandria" ,sbcl-alexandria) + ("introspect-environment" ,sbcl-introspect-environment) + ("trivia.trivial" ,sbcl-trivia.trivial))) + (native-inputs + `(("fiveam" ,sbcl-fiveam))) + (arguments + `(#:test-asd-file "type-i.test.asd")) + (synopsis "Type inference utility on unary predicates for Common Lisp") + (description "This library tries to provide a way to detect what kind of +type the given predicate is trying to check. This is different from inferring +the return type of a function.") + (license license:llgpl)))) + +(define-public sbcl-optima + (let ((commit "373b245b928c1a5cce91a6cb5bfe5dd77eb36195") + (revision "1")) + (package + (name "sbcl-optima") + (build-system asdf-build-system/sbcl) + (version (git-version "0.1" revision commit)) + (home-page "https://github.com/m2ym/optima") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1yw4ymq7ms89342kkvb3aqxgv0w38m9kd8ikdqxxzyybnkjhndal")))) + (inputs + `(("alexandria" ,sbcl-alexandria) + ("closer-mop" ,sbcl-closer-mop))) + (native-inputs + `(("eos" ,sbcl-eos))) + (arguments + ;; XXX: Circular dependencies: tests depend on optima.ppcre which depends on optima. + `(#:tests? #f + #:test-asd-file "optima.test.asd")) + (synopsis "Optimized pattern matching library for Common Lisp") + (description "Optima is a fast pattern matching library which uses +optimizing techniques widely used in the functional programming world.") + (license license:expat)))) + +(define-public sbcl-fare-quasiquote + (package + (name "sbcl-fare-quasiquote") + (build-system asdf-build-system/sbcl) + (version "20171130") + (home-page "http://common-lisp.net/project/fare-quasiquote") + (source + (origin + (method url-fetch) + (uri (string-append "http://beta.quicklisp.org/archive/fare-quasiquote/" + (date->string (string->date version "~Y~m~d") "~Y-~m-~d") + "/fare-quasiquote-" + version + "-git.tgz")) + (sha256 + (base32 + "00brmh7ndsi0c97nibi8cy10j3l4gmkyrfrr5jr5lzkfb7ngyfqa")))) + (inputs + `(("fare-utils" ,sbcl-fare-utils))) + (arguments + ;; XXX: Circular dependencies: Tests depend on subsystems, which depend on the main systems. + `(#:tests? #f + #:phases + (modify-phases %standard-phases + ;; XXX: Require 1.0.0 version of fare-utils, and we package some + ;; commits after 1.0.0.5, but ASDF fails to read the + ;; "-REVISION-COMMIT" part generated by Guix. + (add-after 'unpack 'patch-requirement + (lambda _ + (substitute* "fare-quasiquote.asd" + (("\\(:version \"fare-utils\" \"1.0.0\"\\)") "\"fare-utils\""))))))) + (synopsis "Pattern-matching friendly implementation of quasiquote for Common Lisp") + (description "The main purpose of this n+2nd reimplementation of +quasiquote is enable matching of quasiquoted patterns, using Optima or +Trivia.") + (license license:expat))) + +(define-public sbcl-fare-quasiquote-readtable + (package + (inherit sbcl-fare-quasiquote) + (name "sbcl-fare-quasiquote-readtable") + (inputs + `(("fare-quasiquote" ,sbcl-fare-quasiquote) + ("named-readtables" ,sbcl-named-readtables))) + (description "The main purpose of this n+2nd reimplementation of +quasiquote is enable matching of quasiquoted patterns, using Optima or +Trivia. + +This packages uses fare-quasiquote with named-readtable."))) + +(define-public sbcl-trivia.level0 + (let ((commit "902e0c65602bbfe96ae82e679330b3771ddc7603") + (revision "1")) + (package + (name "sbcl-trivia.level0") + (build-system asdf-build-system/sbcl) + (version (git-version "0.0.0" revision commit)) + (home-page "https://github.com/guicho271828/trivia") + (source + (origin + (method git-fetch) + (uri (git-reference + (url home-page) + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "11qbab30qqnfy9mx3x9fvgcw1jbvh1qn2cqv3p8xdn2m8981jvhr")))) + (inputs + `(("alexandria" ,sbcl-alexandria))) + (synopsis "Pattern matching in Common Lisp") + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima.") + (license license:llgpl)))) + +(define-public sbcl-trivia.level1 + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.level1") + (inputs + `(("trivia.level0" ,sbcl-trivia.level0))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the core patterns of Trivia."))) + +(define-public sbcl-trivia.level2 + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.level2") + (inputs + `(("trivia.level1" ,sbcl-trivia.level1) + ("lisp-namespace" ,sbcl-lisp-namespace) + ("trivial-cltl2" ,sbcl-trivial-cltl2) + ("closer-mop" ,sbcl-closer-mop))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains a non-optimized pattern matcher compatible with Optima, +with extensible optimizer interface."))) + +(define-public sbcl-trivia.trivial + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.trivial") + (inputs + `(("trivia.level2" ,sbcl-trivia.level2))) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'create-asd-file + (lambda* (#:key outputs inputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (lib (string-append out "/lib/" (%lisp-type))) + (level2 (assoc-ref inputs "trivia.level2"))) + (mkdir-p lib) + (install-file "trivia.trivial.asd" lib) + ;; XXX: This .asd does not have any component and the build + ;; system fails to work in this case. We should update the + ;; build system to handle component-less .asd. + ;; TODO: How do we append to file in Guile? It seems that + ;; (open-file ... "a") gets a "Permission denied". + (substitute* (string-append lib "/trivia.trivial.asd") + (("\"\\)") + (string-append "\") + +(progn (asdf/source-registry:ensure-source-registry) + (setf (gethash + \"trivia.level2\" + asdf/source-registry:*source-registry*) + #p\"" + level2 + "/share/common-lisp/sbcl-bundle-systems/trivia.level2.asd\"))"))))))))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the base level system of Trivia with a trivial optimizer."))) + +(define-public sbcl-trivia.balland2006 + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.balland2006") + (inputs + `(("trivia.trivial" ,sbcl-trivia.trivial) + ("iterate" ,sbcl-iterate) + ("type-i" ,sbcl-type-i) + ("alexandria" ,sbcl-alexandria))) + (arguments + ;; Tests are done in trivia itself. + `(#:tests? #f)) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the base level system of Trivia with a trivial optimizer."))) + +(define-public sbcl-trivia.ppcre + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.ppcre") + (inputs + `(("trivia.trivial" ,sbcl-trivia.trivial) + ("cl-ppcre" ,sbcl-cl-ppcre))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the PPCRE extention."))) + +(define-public sbcl-trivia.quasiquote + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.quasiquote") + (inputs + `(("trivia.trivial" ,sbcl-trivia.trivial) + ("fare-quasiquote" ,sbcl-fare-quasiquote) + ("fare-quasiquote-readtable" ,sbcl-fare-quasiquote-readtable))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the fare-quasiquote extension."))) + +(define-public sbcl-trivia.cffi + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia.cffi") + (inputs + `(("cffi" ,sbcl-cffi) + ("trivia.trivial" ,sbcl-trivia.trivial))) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima. + +This system contains the CFFI foreign slot access extension."))) + +(define-public sbcl-trivia + (package + (inherit sbcl-trivia.level0) + (name "sbcl-trivia") + (inputs + `(("trivia.balland2006" ,sbcl-trivia.balland2006))) + (native-inputs + `(("fiveam" ,sbcl-fiveam) + ("trivia.ppcre" ,sbcl-trivia.ppcre) + ("trivia.quasiquote" ,sbcl-trivia.quasiquote) + ("trivia.cffi" ,sbcl-trivia.cffi) + ("optima" ,sbcl-optima))) + (arguments + `(#:test-asd-file "trivia.test.asd")) + (description "Trivia is a pattern matching compiler that is compatible +with Optima, another pattern matching library for Common Lisp. It is meant to +be faster and more extensible than Optima."))) diff --git a/gnu/packages/logo.scm b/gnu/packages/logo.scm new file mode 100644 index 0000000000..17c3990a94 --- /dev/null +++ b/gnu/packages/logo.scm @@ -0,0 +1,71 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu packages logo) + #:use-module (gnu packages qt) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix download) + #:use-module (guix packages) + #:use-module (guix build-system gnu)) + +(define-public qlogo + (package + (name "qlogo") + (version "0.92") + (source + (origin + (method url-fetch) + (uri (string-append "https://qlogo.org/assets/sources/QLogo-" + version ".tgz")) + (sha256 + (base32 + "0cpyj1ji6hjy7zzz05672f0j6fr0mwpc1y3sq36hhkv2fkpidw22")))) + (build-system gnu-build-system) + (inputs + `(("qtbase" ,qtbase))) + (arguments + `(#:phases + (modify-phases %standard-phases + (replace 'configure + (lambda* (#:key outputs #:allow-other-keys) + (substitute* "QLogo.pro" + (("target\\.path = /usr/bin") + (string-append "target.path = " + (assoc-ref outputs "out") "/bin"))) + (invoke "qmake" "QLogo.pro"))) + ;; The check phase rebuilds the source for tests. So, it needs to be + ;; run after the install phase has installed the outputs of the build + ;; phase. + (delete 'check) + (add-after 'install 'check + (lambda _ + ;; Clean files created by the build phase. + (invoke "make" "clean") + ;; QLogo tries to create its "dribble file" in the home + ;; directory. So, set HOME. + (setenv "HOME" "/tmp") + ;; Build and run tests. + (invoke "qmake" "TestQLogo.pro") + (invoke "make" "-j" (number->string (parallel-job-count))) + (invoke "./testqlogo")))))) + (home-page "https://qlogo.org") + (synopsis "Logo interpreter using Qt and OpenGL") + (description "QLogo is an interpreter for the Logo language written in C++ +using Qt and OpenGL. Specifically, it mimics, as reasonably as possible, the +UCBLogo interpreter.") + (license license:gpl2+))) diff --git a/gnu/packages/patchutils.scm b/gnu/packages/patchutils.scm index 687864c008..a63d889cff 100644 --- a/gnu/packages/patchutils.scm +++ b/gnu/packages/patchutils.scm @@ -307,7 +307,7 @@ you to figure out what is going on in that merge you keep avoiding.") (define-public patchwork (package (name "patchwork") - (version "2.1.2") + (version "2.1.4") (source (origin (method git-fetch) (uri (git-reference @@ -316,7 +316,7 @@ you to figure out what is going on in that merge you keep avoiding.") (file-name (git-file-name name version)) (sha256 (base32 - "06ng5pv6744w98zkyfm0ldkmpdgnsql3gbbbh6awq61sr2ndr3qw")))) + "0zi1hcqb0pi2diyznbv0c1631qk4rx02zl8ghyrr59g3ljlyr18y")))) (build-system python-build-system) (arguments `(;; TODO: Tests require a running database diff --git a/gnu/packages/photo.scm b/gnu/packages/photo.scm index b2e3edca18..cf7da80642 100644 --- a/gnu/packages/photo.scm +++ b/gnu/packages/photo.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2017 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il> @@ -70,14 +70,14 @@ (define-public libraw (package (name "libraw") - (version "0.19.2") + (version "0.19.3") (source (origin (method url-fetch) (uri (string-append "https://www.libraw.org/data/LibRaw-" version ".tar.gz")) (sha256 (base32 - "0i4nhjm5556xgn966x0i503ygk2wafq6z83kg0lisacjjab4f3a0")))) + "0xs1qb6pcvc4c43fy5xi3nkqxcif77gakkw99irf0fc5iccdd5px")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) @@ -445,7 +445,7 @@ and enhance them.") (inputs `(("boost" ,boost) ("enblend-enfuse" ,enblend-enfuse) - ("exiv2" ,exiv2) + ("exiv2" ,exiv2-0.26) ("fftw" ,fftw) ("flann" ,flann) ("freeglut" ,freeglut) diff --git a/gnu/packages/pulseaudio.scm b/gnu/packages/pulseaudio.scm index 96d15bdf9c..fa48d8a7a6 100644 --- a/gnu/packages/pulseaudio.scm +++ b/gnu/packages/pulseaudio.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2017 Stefan Reichör <stefan@xsteve.at> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018 Pierre Langlois <pierre.langlois@gmx.com> +;;; Copyright © 2019 Alex Griffin <a@ajgrf.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,6 +28,7 @@ (define-module (gnu packages pulseaudio) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix git-download) #:use-module ((guix licenses) #:prefix l:) #:use-module (guix build-system gnu) #:use-module (guix build-system python) @@ -43,6 +45,10 @@ #:use-module (gnu packages web) #:use-module (gnu packages linux) #:use-module (gnu packages m4) + #:use-module (gnu packages protobuf) + #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) + #:use-module (gnu packages python-web) #:use-module (gnu packages pkg-config) #:use-module (gnu packages xiph)) @@ -303,3 +309,55 @@ sinks.") (description "Pulsemixer is a PulseAudio mixer with command-line and curses-style interfaces.") (license l:expat))) + +(define-public pulseaudio-dlna + ;; The last release was in 2016; use a more recent commit. + (let ((commit "4472928dd23f274193f14289f59daec411023ab0") + (revision "1")) + (package + (name "pulseaudio-dlna") + (version (git-version "0.5.2" revision commit)) + (source + (origin + (method git-fetch) + (uri (git-reference + (url "https://github.com/masmu/pulseaudio-dlna.git") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1dfn7036vrq49kxv4an7rayypnm5dlawsf02pfsldw877hzdamqk")))) + (build-system python-build-system) + (arguments `(#:python ,python-2)) + (inputs + `(("python2-chardet" ,python2-chardet) + ("python2-dbus" ,python2-dbus) + ("python2-docopt" ,python2-docopt) + ("python2-futures" ,python2-futures) + ("python2-pygobject" ,python2-pygobject) + ("python2-lxml" ,python2-lxml) + ("python2-netifaces" ,python2-netifaces) + ("python2-notify2" ,python2-notify2) + ("python2-protobuf" ,python2-protobuf) + ("python2-psutil" ,python2-psutil) + ("python2-requests" ,python2-requests) + ("python2-pyroute2" ,python2-pyroute2) + ("python2-setproctitle" ,python2-setproctitle) + ("python2-zeroconf" ,python2-zeroconf))) + (home-page "https://github.com/masmu/pulseaudio-dlna") + (synopsis "Stream audio to DLNA/UPnP and Chromecast devices") + (description "This lightweight streaming server brings DLNA/UPnP and +Chromecast support to PulseAudio. It can stream your current PulseAudio +playback to different UPnP devices (UPnP Media Renderers, including Sonos +devices and some Smart TVs) or Chromecasts in your network. You should also +install one or more of the following packages alongside pulseaudio-dlna: + +@itemize +@item ffmpeg - transcoding support for multiple codecs +@item flac - FLAC transcoding support +@item lame - MP3 transcoding support +@item opus-tools - Opus transcoding support +@item sox - WAV transcoding support +@item vorbis-tools - Vorbis transcoding support +@end itemize") + (license l:gpl3+)))) diff --git a/gnu/packages/python-xyz.scm b/gnu/packages/python-xyz.scm index e9cf681cde..2273f1ce74 100644 --- a/gnu/packages/python-xyz.scm +++ b/gnu/packages/python-xyz.scm @@ -61,6 +61,7 @@ ;;; Copyright © 2019 Sam <smbaines8@gmail.com> ;;; Copyright © 2019 Jack Hill <jackhill@jackhill.us> ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net> +;;; Copyright © 2019 Alex Griffin <a@ajgrf.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -660,14 +661,14 @@ other machines, such as over the network.") (define-public python-setuptools (package (name "python-setuptools") - (version "40.0.0") + (version "41.0.1") (source (origin (method url-fetch) (uri (pypi-uri "setuptools" version ".zip")) (sha256 (base32 - "0pq116lr14gnc62v76nk0npkm6krb2mpp7p9ab369zgv4n7dnah1")) + "04sns22y2hhsrwfy1mha2lgslvpjsjsz8xws7h2rh5a7ylkd28m2")) (modules '((guix build utils))) (snippet '(begin @@ -4331,19 +4332,18 @@ services for your Python modules and applications.") (define-public python-olefile (package (name "python-olefile") - (version "0.45.1") + (version "0.46") (source (origin (method url-fetch) - (uri (string-append "https://github.com/decalage2/olefile/archive/v" - version ".tar.gz")) + (uri (string-append "https://github.com/decalage2/olefile/releases/" + "download/v" version "/olefile-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 - "18ai19zwagm6nli14k8bii31ipbab2rp7plrvsm6gmfql551a8ai")))) + "1kjxh4gr651hpqkjfv89cfzr40hyvf3vjlda7mifiail83j7j07m")))) (build-system python-build-system) - (home-page - "https://www.decalage.info/python/olefileio") + (home-page "https://www.decalage.info/python/olefileio") (synopsis "Read and write Microsoft OLE2 files.") (description "@code{olefile} can parse, read and write Microsoft OLE2 files (Structured @@ -5632,6 +5632,33 @@ implementation of D-Bus.") ;; "ValueError: unichr() arg not in range(0x10000) (narrow Python build)" (arguments `(#:tests? #f)))) +(define-public python-notify2 + (package + (name "python-notify2") + (version "0.3.1") + (source + (origin + (method url-fetch) + (uri (pypi-uri "notify2" version)) + (sha256 + (base32 + "0z8rrv9rsg1r2qgh2dxj3dfj5xnki98kgi3w839kqby4a26i1yik")))) + (build-system python-build-system) + (arguments `(#:tests? #f)) ; tests depend on system state + (native-inputs + `(("python-dbus" ,python-dbus))) + (home-page "https://bitbucket.org/takluyver/pynotify2") + (synopsis "Python interface to D-Bus notifications") + (description + "Pynotify2 provides a Python interface for sending D-Bus notifications. +It is a reimplementation of pynotify in pure Python, and an alternative to +the GObject Introspection bindings to libnotify for non-GTK applications.") + (license (list license:bsd-2 + license:lgpl2.1+)))) + +(define-public python2-notify2 + (package-with-python2 python-notify2)) + (define-public python-lxml (package (name "python-lxml") @@ -5706,14 +5733,14 @@ converts incoming documents to Unicode and outgoing documents to UTF-8.") (define-public python-soupsieve (package (name "python-soupsieve") - (version "1.9.1") + (version "1.9.2") (source (origin (method url-fetch) (uri (pypi-uri "soupsieve" version)) (sha256 (base32 - "1jnzkiwmjl6yvqckc9mf689g87b6yz07sv868hap2aa5arggy3mj")))) + "0in9rc9q3h8w5b4qf7kvl3qxcvw6vrz35ckblchgf70hm6pg3dbj")))) (build-system python-build-system) (arguments `(#:tests? #f)) ;;XXX: 2 tests fail currently despite claming they were to be @@ -6904,6 +6931,41 @@ and MAC network addresses.") (define-public python2-netaddr (package-with-python2 python-netaddr)) +(define-public python2-pyroute2 + (package + (name "python2-pyroute2") + (version "0.5.6") + (source + (origin + (method url-fetch) + (uri (pypi-uri "pyroute2" version)) + (sha256 + (base32 + "1gmz4r1w0yzj6fjjypnalmfyy0lnfznydyn62gi3wk50j5hhxbny")))) + (build-system python-build-system) + (arguments + `(#:python ,python-2)) ;Python 3.x is not supported + (home-page "https://github.com/svinota/pyroute2") + (synopsis "Python netlink library") + (description + "Pyroute2 is a pure Python netlink library with minimal dependencies. +Supported netlink families and protocols include: +@itemize +@item rtnl, network settings - addresses, routes, traffic controls +@item nfnetlink - netfilter API: ipset, nftables, ... +@item ipq - simplest userspace packet filtering, iptables QUEUE target +@item devlink - manage and monitor devlink-enabled hardware +@item generic - generic netlink families + @itemize + @item nl80211 - wireless functions API (basic support) + @item taskstats - extended process statistics + @item acpi_events - ACPI events monitoring + @item thermal_events - thermal events monitoring + @item VFS_DQUOT - disk quota events monitoring + @end itemize +@end itemize") + (license license:gpl2+))) + (define-public python-wrapt (package (name "python-wrapt") @@ -15798,6 +15860,42 @@ by Igor Pavlov.") (define-public python2-pylzma (package-with-python2 python-pylzma)) +(define-public python2-zeroconf + (package + (name "python2-zeroconf") + + ;; This is the last version that supports Python 2.x. + (version "0.19.1") + (source + (origin + (method url-fetch) + (uri (pypi-uri "zeroconf" version)) + (sha256 + (base32 + "0ykzg730n915qbrq9bn5pn06bv6rb5zawal4sqjyfnjjm66snkj3")))) + (build-system python-build-system) + (arguments + `(#:python ,python-2 + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'patch-requires + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "setup.py" + (("enum-compat") + "enum34")) + #t))))) + (native-inputs + `(("python2-six" ,python2-six) + ("python2-enum32" ,python2-enum34) + ("python2-netifaces" ,python2-netifaces) + ("python2-typing" ,python2-typing))) + (home-page "https://github.com/jstasiak/python-zeroconf") + (synopsis "Pure Python mDNS service discovery") + (description + "Pure Python multicast DNS (mDNS) service discovery library (Bonjour/Avahi +compatible).") + (license license:lgpl2.1+))) + (define-public python-bsddb3 (package (name "python-bsddb3") diff --git a/gnu/packages/serialization.scm b/gnu/packages/serialization.scm index ae1ef9749b..505c196abd 100644 --- a/gnu/packages/serialization.scm +++ b/gnu/packages/serialization.scm @@ -297,18 +297,16 @@ that implements both the msgpack and msgpack-rpc specifications.") (define-public jsoncpp (package (name "jsoncpp") - (version "1.8.4") + (version "1.9.0") + (home-page "https://github.com/open-source-parsers/jsoncpp") (source (origin - (method url-fetch) - (uri (string-append - "https://github.com/open-source-parsers/jsoncpp/archive/" - version ".tar.gz")) - (file-name (string-append name "-" version ".tar.gz")) + (method git-fetch) + (uri (git-reference (url home-page) (commit version))) + (file-name (git-file-name name version)) (sha256 (base32 - "1dpxk8hkni5dq4mdw8qbaj40jmid3a31d1gh8iqcnfwkw34ym7f4")))) + "10wnwlq92gp32f5p55kjcc12jfsl0yq6f2y4abb0si6wym12krw9")))) (build-system cmake-build-system) - (home-page "https://github.com/open-source-parsers/jsoncpp") (arguments `(#:configure-flags '("-DBUILD_SHARED_LIBS:BOOL=YES"))) (synopsis "C++ library for interacting with JSON") diff --git a/gnu/packages/wine.scm b/gnu/packages/wine.scm index 72f0e1fd55..b76c9d18b9 100644 --- a/gnu/packages/wine.scm +++ b/gnu/packages/wine.scm @@ -310,7 +310,7 @@ integrate Windows applications into your desktop.") (define-public wine-staging-patchset-data (package (name "wine-staging-patchset-data") - (version "4.11") + (version "4.12") (source (origin (method git-fetch) @@ -320,7 +320,7 @@ integrate Windows applications into your desktop.") (file-name (git-file-name name version)) (sha256 (base32 - "0h8qldqr9w1kwn48qgg5m1cs2xqkv8xxg2c66cvfka91hy886jcf")))) + "1drsrps6bd5gcafzcfrr9pzajhh5s6qg5la7q4qpwzlng9969f3r")))) (build-system trivial-build-system) (native-inputs `(("bash" ,bash) @@ -366,7 +366,7 @@ integrate Windows applications into your desktop.") (file-name (string-append name "-" version ".tar.xz")) (sha256 (base32 - "1rmyfwlynzs2niz7l2lwjs2axm6in6gb43ldbzyzsflxsmk5fl9f")))) + "1az5pcczq2zl1cvfdggzf89n0sf77m3fjkc8rnna8qr3n585q4h0")))) (inputs `(("autoconf" ,autoconf) ; for autoreconf ("faudio" ,faudio) ("ffmpeg" ,ffmpeg) diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index f2674cdbe8..3ec5c3d6ee 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -27,7 +27,6 @@ #:use-module (gnu services networking) #:use-module (gnu services docker) #:use-module (gnu services desktop) - #:use-module (gnu packages bootstrap) ; %bootstrap-guile #:use-module (gnu packages docker) #:use-module (gnu packages guile) #:use-module (guix gexp) @@ -101,7 +100,7 @@ inside %DOCKER-OS." marionette)) (test-equal "Load docker image and run it" - '("hello world" "hi!") + '("hello world" "hi!" "JSON!") (marionette-eval `(begin (define slurp @@ -125,8 +124,15 @@ inside %DOCKER-OS." (response2 (slurp ;default entry point ,(string-append #$docker-cli "/bin/docker") "run" repository&tag - "-c" "(display \"hi!\")"))) - (list response1 response2))) + "-c" "(display \"hi!\")")) + + ;; Check whether (json) is in $GUILE_LOAD_PATH. + (response3 (slurp ;default entry point + environment + ,(string-append #$docker-cli "/bin/docker") + "run" repository&tag + "-c" "(use-modules (json)) + (display (json-string->scm (scm->json-string \"JSON!\")))"))) + (list response1 response2 response3))) marionette)) (test-end) @@ -144,7 +150,7 @@ inside %DOCKER-OS." (version "0") (source #f) (build-system trivial-build-system) - (arguments `(#:guile ,%bootstrap-guile + (arguments `(#:guile ,guile-2.2 #:builder (let ((out (assoc-ref %outputs "out"))) (mkdir out) @@ -158,7 +164,7 @@ standard output device and then enters a new line.") (home-page #f) (license license:public-domain))) (profile (profile-derivation (packages->manifest - (list %bootstrap-guile + (list guile-2.2 guile-json guest-script-package)) #:hooks '() #:locales? #f)) diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 9f6baa1a48..124d176181 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -661,7 +661,7 @@ export GUIX_BUILD_OPTIONS=--no-grafts ls -l /run/current-system/gc-roots parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 1M 3M \\ - mkpart primary ext2 3M 1.2G \\ + mkpart primary ext2 3M 1.4G \\ set 1 boot on \\ set 1 bios_grub on echo -n thepassphrase | \\ diff --git a/gnu/tests/singularity.scm b/gnu/tests/singularity.scm index 668043a0bc..2f3a6f289d 100644 --- a/gnu/tests/singularity.scm +++ b/gnu/tests/singularity.scm @@ -111,6 +111,21 @@ "run" #$image "-c" "(exit 42)")) marionette)) + ;; FIXME: Singularity 2.x doesn't directly honor + ;; /.singularity.d/env/*.sh. Instead, you have to load those files + ;; manually, which we don't do. Remove 'test-skip' call once we've + ;; switch to Singularity 3.x. + (test-skip 1) + (test-equal "singularity run, with environment" + 0 + (marionette-eval + ;; Check whether GUILE_LOAD_PATH is properly set, allowing us to + ;; find the (json) module. + `(status:exit-val + (system* #$(file-append singularity "/bin/singularity") + "--debug" "run" #$image "-c" "(use-modules (json))")) + marionette)) + (test-end) (exit (= (test-runner-fail-count (test-runner-current)) 0))))) @@ -122,7 +137,8 @@ (guile (set-guile-for-build (default-guile))) ;; 'singularity exec' insists on having /bin/sh in the image. (profile (profile-derivation (packages->manifest - (list bash-minimal guile-2.2)) + (list bash-minimal + guile-2.2 guile-json)) #:hooks '() #:locales? #f)) (tarball (squashfs-image "singularity-pack" profile |