guix/nar.scm \
guix/derivations.scm \
guix/grafts.scm \
+ guix/repl.scm \
guix/inferior.scm \
guix/describe.scm \
guix/channels.scm \
guix/scripts/weather.scm \
guix/scripts/container.scm \
guix/scripts/container/exec.scm \
+ guix/scripts/deploy.scm \
guix.scm \
$(GNU_SYSTEM_MODULES)
MODULES += \
guix/ssh.scm \
+ guix/remote.scm \
guix/scripts/copy.scm \
guix/store/ssh.scm
tests/cve-sample.xml \
build-aux/config.rpath \
bootstrap \
- release.nix \
+ doc/build.scm \
$(TESTS)
if !BUILD_DAEMON_OFFLOAD
--- /dev/null
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+
+;; This file contains machinery to build HTML and PDF copies of the manual
+;; that can be readily published on the web site. To do that, run:
+;;
+;; guix build -f build.scm
+;;
+;; The result is a directory hierarchy that can be used as the manual/
+;; sub-directory of the web site.
+
+(use-modules (guix)
+ (guix gexp)
+ (guix git)
+ (guix git-download)
+ (git)
+ (gnu packages base)
+ (gnu packages gawk)
+ (gnu packages gettext)
+ (gnu packages guile)
+ (gnu packages texinfo)
+ (gnu packages tex)
+ (srfi srfi-19)
+ (srfi srfi-71))
+
+(define file-append*
+ (@@ (guix self) file-append*))
+
+(define translated-texi-manuals
+ (@@ (guix self) translate-texi-manuals))
+
+(define info-manual
+ (@@ (guix self) info-manual))
+
+(define %languages
+ '("de" "en" "es" "fr" "ru" "zh_CN"))
+
+(define (texinfo-manual-images source)
+ "Return a directory containing all the images used by the user manual, taken
+from SOURCE, the root of the source tree."
+ (define graphviz
+ (module-ref (resolve-interface '(gnu packages graphviz))
+ 'graphviz))
+
+ (define images
+ (file-append* source "doc/images"))
+
+ (define build
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-26))
+
+ (define (dot->image dot-file format)
+ (invoke #+(file-append graphviz "/bin/dot")
+ "-T" format "-Gratio=.9" "-Gnodesep=.005"
+ "-Granksep=.00005" "-Nfontsize=9"
+ "-Nheight=.1" "-Nwidth=.1"
+ "-o" (string-append #$output "/"
+ (basename dot-file ".dot")
+ "." format)
+ dot-file))
+
+ ;; Build graphs.
+ (mkdir-p #$output)
+ (for-each (lambda (dot-file)
+ (for-each (cut dot->image dot-file <>)
+ '("png" "pdf")))
+ (find-files #$images "\\.dot$"))
+
+ ;; Copy other PNGs.
+ (for-each (lambda (png-file)
+ (install-file png-file #$output))
+ (find-files #$images "\\.png$")))))
+
+ (computed-file "texinfo-manual-images" build))
+
+(define* (texinfo-manual-source source #:key
+ (version "0.0")
+ (languages %languages)
+ (date 1))
+ "Gather all the source files of the Texinfo manuals from SOURCE--.texi file
+as well as images, OS examples, and translations."
+ (define documentation
+ (file-append* source "doc"))
+
+ (define examples
+ (file-append* source "gnu/system/examples"))
+
+ (define build
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-19))
+
+ (define (make-version-texi language)
+ ;; Create the 'version.texi' file for LANGUAGE.
+ (let ((file (if (string=? language "en")
+ "version.texi"
+ (string-append "version-" language ".texi"))))
+ (call-with-output-file (string-append #$output "/" file)
+ (lambda (port)
+ (let* ((version #$version)
+ (time (make-time time-utc 0 #$date))
+ (date (time-utc->date time)))
+ (format port "
+@set UPDATED ~a
+@set UPDATED-MONTH ~a
+@set EDITION ~a
+@set VERSION ~a\n"
+ (date->string date "~e ~B ~Y")
+ (date->string date "~B ~Y")
+ version version))))))
+
+ (install-file #$(file-append* documentation "/htmlxref.cnf")
+ #$output)
+
+ (for-each (lambda (texi)
+ (install-file texi #$output))
+ (append (find-files #$documentation "\\.(texi|scm)$")
+ (find-files #$(translated-texi-manuals source)
+ "\\.texi$")))
+
+ ;; Create 'version.texi'.
+ (for-each make-version-texi '#$languages)
+
+ ;; Copy configuration templates that the manual includes.
+ (for-each (lambda (template)
+ (copy-file template
+ (string-append
+ #$output "/os-config-"
+ (basename template ".tmpl")
+ ".texi")))
+ (find-files #$examples "\\.tmpl$"))
+
+ (symlink #$(texinfo-manual-images source)
+ (string-append #$output "/images")))))
+
+ (computed-file "texinfo-manual-source" build))
+
+(define %web-site-url
+ ;; URL of the web site home page.
+ (or (getenv "GUIX_WEB_SITE_URL")
+ "/software/guix/"))
+
+(define %makeinfo-html-options
+ ;; Options passed to 'makeinfo --html'.
+ '("--css-ref=https://www.gnu.org/software/gnulib/manual.css"))
+
+(define* (html-manual source #:key (languages %languages)
+ (version "0.0")
+ (manual "guix")
+ (date 1)
+ (options %makeinfo-html-options))
+ "Return the HTML manuals built from SOURCE for all LANGUAGES, with the given
+makeinfo OPTIONS."
+ (define manual-source
+ (texinfo-manual-source source
+ #:version version
+ #:languages languages
+ #:date date))
+
+ (define build
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (define (normalize language)
+ ;; Normalize LANGUAGE. For instance, "zh_CN" become "zh-cn".
+ (string-map (match-lambda
+ (#\_ #\-)
+ (chr chr))
+ (string-downcase language)))
+
+ ;; Install a UTF-8 locale so that 'makeinfo' is at ease.
+ (setenv "GUIX_LOCPATH"
+ #+(file-append glibc-utf8-locales "/lib/locale"))
+ (setenv "LC_ALL" "en_US.utf8")
+
+ (setvbuf (current-output-port) 'line)
+ (setvbuf (current-error-port) 'line)
+
+ (for-each (lambda (language)
+ (let ((opts `("--html"
+ "-c" ,(string-append "TOP_NODE_UP_URL=/manual/"
+ language)
+ #$@options
+ ,(if (string=? language "en")
+ (string-append #$manual-source "/"
+ #$manual ".texi")
+ (string-append #$manual-source "/"
+ #$manual "." language ".texi")))))
+ (format #t "building HTML manual for language '~a'...~%"
+ language)
+ (mkdir-p (string-append #$output "/"
+ (normalize language)))
+ (setenv "LANGUAGE" language)
+ (apply invoke #$(file-append texinfo "/bin/makeinfo")
+ "-o" (string-append #$output "/"
+ (normalize language)
+ "/html_node")
+ opts)
+ (apply invoke #$(file-append texinfo "/bin/makeinfo")
+ "--no-split"
+ "-o"
+ (string-append #$output "/"
+ (normalize language)
+ "/" #$manual
+ (if (string=? language "en")
+ ""
+ (string-append "." language))
+ ".html")
+ opts)))
+ '#$languages))))
+
+ (computed-file (string-append manual "-html-manual") build))
+
+(define* (pdf-manual source #:key (languages %languages)
+ (version "0.0")
+ (manual "guix")
+ (date 1)
+ (options '()))
+ "Return the HTML manuals built from SOURCE for all LANGUAGES, with the given
+makeinfo OPTIONS."
+ (define manual-source
+ (texinfo-manual-source source
+ #:version version
+ #:languages languages
+ #:date date))
+
+ ;; FIXME: This union works, except for the table of contents of non-English
+ ;; manuals, which contains escape sequences like "^^ca^^fe" instead of
+ ;; accented letters.
+ ;;
+ ;; (define texlive
+ ;; (texlive-union (list texlive-tex-texinfo
+ ;; texlive-generic-epsf
+ ;; texlive-fonts-ec)))
+
+ (define build
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-34)
+ (ice-9 match))
+
+ (define (normalize language) ;XXX: deduplicate
+ ;; Normalize LANGUAGE. For instance, "zh_CN" becomes "zh-cn".
+ (string-map (match-lambda
+ (#\_ #\-)
+ (chr chr))
+ (string-downcase language)))
+
+ ;; Install a UTF-8 locale so that 'makeinfo' is at ease.
+ (setenv "GUIX_LOCPATH"
+ #+(file-append glibc-utf8-locales "/lib/locale"))
+ (setenv "LC_ALL" "en_US.utf8")
+ (setenv "PATH"
+ (string-append #+(file-append texlive "/bin") ":"
+ #+(file-append texinfo "/bin") ":"
+
+ ;; Below are command-line tools needed by
+ ;; 'texi2dvi' and friends.
+ #+(file-append sed "/bin") ":"
+ #+(file-append grep "/bin") ":"
+ #+(file-append coreutils "/bin") ":"
+ #+(file-append gawk "/bin") ":"
+ #+(file-append tar "/bin") ":"
+ #+(file-append diffutils "/bin")))
+
+ (setvbuf (current-output-port) 'line)
+ (setvbuf (current-error-port) 'line)
+
+ (setenv "HOME" (getcwd)) ;for kpathsea/mktextfm
+
+ ;; 'SOURCE_DATE_EPOCH' is honored by pdftex.
+ (setenv "SOURCE_DATE_EPOCH" "1")
+
+ (for-each (lambda (language)
+ (let ((opts `("--pdf"
+ "-I" "."
+ #$@options
+ ,(if (string=? language "en")
+ (string-append #$manual-source "/"
+ #$manual ".texi")
+ (string-append #$manual-source "/"
+ #$manual "." language ".texi")))))
+ (format #t "building PDF manual for language '~a'...~%"
+ language)
+ (mkdir-p (string-append #$output "/"
+ (normalize language)))
+ (setenv "LANGUAGE" language)
+
+
+ ;; FIXME: Unfortunately building PDFs for non-Latin
+ ;; alphabets doesn't work:
+ ;; <https://lists.gnu.org/archive/html/help-texinfo/2012-01/msg00014.html>.
+ (guard (c ((invoke-error? c)
+ (format (current-error-port)
+ "~%~%Failed to produce \
+PDF for language '~a'!~%~%"
+ language)))
+ (apply invoke #$(file-append texinfo "/bin/makeinfo")
+ "--pdf" "-o"
+ (string-append #$output "/"
+ (normalize language)
+ "/" #$manual
+ (if (string=? language "en")
+ ""
+ (string-append "."
+ language))
+ ".pdf")
+ opts))))
+ '#$languages))))
+
+ (computed-file (string-append manual "-pdf-manual") build))
+
+(define (guix-manual-text-domain source languages)
+ "Return the PO files for LANGUAGES of the 'guix-manual' text domain taken
+from SOURCE."
+ (define po-directory
+ (file-append* source "/po/doc"))
+
+ (define build
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (mkdir-p #$output)
+ (for-each (lambda (language)
+ (define directory
+ (string-append #$output "/" language
+ "/LC_MESSAGES"))
+
+ (mkdir-p directory)
+ (invoke #+(file-append gnu-gettext "/bin/msgfmt")
+ "-c" "-o"
+ (string-append directory "/guix-manual.mo")
+ (string-append #$po-directory "/guix-manual."
+ language ".po")))
+ '#$(delete "en" languages)))))
+
+ (computed-file "guix-manual-po" build))
+
+(define* (html-manual-indexes source
+ #:key (languages %languages)
+ (version "0.0")
+ (manual "guix")
+ (date 1))
+ (define build
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match)
+ (ice-9 popen)
+ (sxml simple)
+ (srfi srfi-19))
+
+ (define (normalize language) ;XXX: deduplicate
+ ;; Normalize LANGUAGE. For instance, "zh_CN" become "zh-cn".
+ (string-map (match-lambda
+ (#\_ #\-)
+ (chr chr))
+ (string-downcase language)))
+
+ (define-syntax-rule (with-language language exp ...)
+ (let ((lang (getenv "LANGUAGE")))
+ (dynamic-wind
+ (lambda ()
+ (setenv "LANGUAGE" language)
+ (setlocale LC_MESSAGES))
+ (lambda () exp ...)
+ (lambda ()
+ (if lang
+ (setenv "LANGUAGE" lang)
+ (unsetenv "LANGUAGE"))
+ (setlocale LC_MESSAGES)))))
+
+ ;; (put 'with-language 'scheme-indent-function 1)
+ (define* (translate str language
+ #:key (domain "guix-manual"))
+ (define exp
+ `(begin
+ (bindtextdomain "guix-manual"
+ #+(guix-manual-text-domain
+ source
+ languages))
+ (write (gettext ,str "guix-manual"))))
+
+ (with-language language
+ ;; Since the 'gettext' function caches msgid translations,
+ ;; regardless of $LANGUAGE, we have to spawn a new process each
+ ;; time we want to translate to a different language. Bah!
+ (let* ((pipe (open-pipe* OPEN_READ
+ #+(file-append guile-2.2
+ "/bin/guile")
+ "-c" (object->string exp)))
+ (str (read pipe)))
+ (close-pipe pipe)
+ str)))
+
+ (define (seconds->string seconds language)
+ (let* ((time (make-time time-utc 0 seconds))
+ (date (time-utc->date time)))
+ (with-language language (date->string date "~e ~B ~Y"))))
+
+ (define (guix-url path)
+ (string-append #$%web-site-url path))
+
+ (define (sxml-index language)
+ (define title
+ (translate "GNU Guix Reference Manual" language))
+
+ ;; FIXME: Avoid duplicating styling info from guix-artwork.git.
+ `(html (@ (lang ,language))
+ (head
+ (title ,(string-append title " — GNU Guix"))
+ (meta (@ (charset "UTF-8")))
+ (meta (@ (name "viewport") (content "width=device-width, initial-scale=1.0")))
+ ;; Menu prefetch.
+ (link (@ (rel "prefetch") (href ,(guix-url "menu/index.html"))))
+ ;; Base CSS.
+ (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/elements.css"))))
+ (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/common.css"))))
+ (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/messages.css"))))
+ (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/navbar.css"))))
+ (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/breadcrumbs.css"))))
+ (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/buttons.css"))))
+ (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/footer.css"))))
+
+ (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/page.css"))))
+ (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/post.css")))))
+ (body
+ (header (@ (class "navbar"))
+ (h1 (a (@ (class "branding")
+ (href #$%web-site-url)))
+ (span (@ (class "a11y-offset"))
+ "Guix"))
+ (nav (@ (class "menu"))))
+ (nav (@ (class "breadcrumbs"))
+ (a (@ (class "crumb")
+ (href #$%web-site-url))
+ "Home"))
+ (main
+ (article
+ (@ (class "page centered-block limit-width"))
+ (h2 ,title)
+ (p (@ (class "post-metadata centered-text"))
+ #$version " — "
+ ,(seconds->string #$date language))
+
+ (div
+ (ul
+ (li (a (@ (href "html_node"))
+ "HTML, with one page per node"))
+ (li (a (@ (href
+ ,(string-append
+ #$manual
+ (if (string=? language
+ "en")
+ ""
+ (string-append "."
+ language))
+ ".html")))
+ "HTML, entirely on one page"))
+ ,@(if (member language '("ru" "zh_CN"))
+ '()
+ `((li (a (@ (href ,(string-append
+ #$manual
+ (if (string=? language "en")
+ ""
+ (string-append "."
+ language))
+ ".pdf"))))
+ "PDF")))))))
+ (footer))))
+
+ (define (write-index language file)
+ (call-with-output-file file
+ (lambda (port)
+ (display "<!DOCTYPE html>\n" port)
+ (sxml->xml (sxml-index language) port))))
+
+ (setenv "GUIX_LOCPATH"
+ #+(file-append glibc-utf8-locales "/lib/locale"))
+ (setenv "LC_ALL" "en_US.utf8")
+ (setlocale LC_ALL "en_US.utf8")
+
+ (bindtextdomain "guix-manual"
+ #+(guix-manual-text-domain source languages))
+
+ (for-each (lambda (language)
+ (define directory
+ (string-append #$output "/"
+ (normalize language)))
+
+ (mkdir-p directory)
+ (write-index language
+ (string-append directory
+ "/index.html")))
+ '#$languages))))
+
+ (computed-file "html-indexes" build))
+
+(define* (pdf+html-manual source
+ #:key (languages %languages)
+ (version "0.0")
+ (date (time-second (current-time time-utc)))
+ (manual "guix"))
+ "Return the union of the HTML and PDF manuals, as well as the indexes."
+ (directory-union (string-append manual "-manual")
+ (map (lambda (proc)
+ (proc source
+ #:date date
+ #:languages languages
+ #:version version
+ #:manual manual))
+ (list html-manual-indexes
+ html-manual pdf-manual))
+ #:copy? #t))
+
+(define (latest-commit+date directory)
+ "Return two values: the last commit ID (a hex string) for DIRECTORY, and its
+commit date (an integer)."
+ (let* ((repository (repository-open directory))
+ (head (repository-head repository))
+ (oid (reference-target head))
+ (commit (commit-lookup repository oid)))
+ ;; TODO: Use (git describe) when it's widely available.
+ (values (oid->string oid) (commit-time commit))))
+
+\f
+(let* ((root (canonicalize-path
+ (string-append (current-source-directory) "/..")))
+ (commit date (latest-commit+date root)))
+ (format (current-error-port)
+ "building manual from work tree around commit ~a, ~a~%"
+ commit
+ (let* ((time (make-time time-utc 0 date))
+ (date (time-utc->date time)))
+ (date->string date "~e ~B ~Y")))
+ (pdf+html-manual (local-file root "guix" #:recursive? #t
+ #:select? (git-predicate root))
+ #:version (or (getenv "GUIX_MANUAL_VERSION")
+ (string-take commit 7))
+ #:date date))
Copyright @copyright{} 2019 Josh Holland@*
Copyright @copyright{} 2019 Diego Nicola Barbato@*
Copyright @copyright{} 2019 Ivan Petkov@*
+Copyright @copyright{} 2019 Jakob L. Kreuze@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
* guix gc: (guix)Invoking guix gc. Reclaiming unused disk space.
* guix pull: (guix)Invoking guix pull. Update the list of available packages.
* guix system: (guix)Invoking guix system. Manage the operating system configuration.
+* guix deploy: (guix)Invoking guix deploy. Manage operating system configurations for remote hosts.
@end direntry
@dircategory Software development
* Initial RAM Disk:: Linux-Libre bootstrapping.
* Bootloader Configuration:: Configuring the boot loader.
* Invoking guix system:: Instantiating a system configuration.
+* Invoking guix deploy:: Deploying a system configuration to a remote host.
* Running Guix in a VM:: How to run Guix System in a virtual machine.
* Defining Services:: Adding new service definitions.
and each of the user fields, this is only one useful component of a
broader privacy/anonymity solution---not one in and of itself.
+@item --no-cwd
+For containers, the default behavior is to share the current working
+directory with the isolated container and immediately change to that
+directory within the container. If this is undesirable, @code{--no-cwd}
+will cause the current working directory to @emph{not} be automatically
+shared and will change to the user's home directory within the container
+instead. See also @code{--user}.
+
@item --expose=@var{source}[=@var{target}]
For containers, expose the file system @var{source} from the host system
as the read-only file system @var{target} within the container. If
* Initial RAM Disk:: Linux-Libre bootstrapping.
* Bootloader Configuration:: Configuring the boot loader.
* Invoking guix system:: Instantiating a system configuration.
+* Invoking guix deploy:: Deploying a system configuration to a remote host.
* Running Guix in a VM:: How to run Guix System in a virtual machine.
* Defining Services:: Adding new service definitions.
@end menu
@end table
+@node Invoking guix deploy
+@section Invoking @code{guix deploy}
+
+We've already seen @code{operating-system} declarations used to manage a
+machine's configuration locally. Suppose you need to configure multiple
+machines, though---perhaps you're managing a service on the web that's
+comprised of several servers. @command{guix deploy} enables you to use those
+same @code{operating-system} declarations to manage multiple remote hosts at
+once as a logical ``deployment''.
+
+@quotation Note
+The functionality described in this section is still under development
+and is subject to change. Get in touch with us on
+@email{guix-devel@@gnu.org}!
+@end quotation
+
+@example
+guix deploy @var{file}
+@end example
+
+Such an invocation will deploy the machines that the code within @var{file}
+evaluates to. As an example, @var{file} might contain a definition like this:
+
+@example
+;; This is a Guix deployment of a "bare bones" setup, with
+;; no X11 display server, to a machine with an SSH daemon
+;; listening on localhost:2222. A configuration such as this
+;; may be appropriate for virtual machine with ports
+;; forwarded to the host's loopback interface.
+
+(use-service-modules networking ssh)
+(use-package-modules bootloaders)
+
+(define %system
+ (operating-system
+ (host-name "gnu-deployed")
+ (timezone "Etc/UTC")
+ (bootloader (bootloader-configuration
+ (bootloader grub-bootloader)
+ (target "/dev/vda")
+ (terminal-outputs '(console))))
+ (file-systems (cons (file-system
+ (mount-point "/")
+ (device "/dev/vda1")
+ (type "ext4"))
+ %base-file-systems))
+ (services
+ (append (list (service dhcp-client-service-type)
+ (service openssh-service-type
+ (openssh-configuration
+ (permit-root-login #t)
+ (allow-empty-passwords? #t))))
+ %base-services))))
+
+(list (machine
+ (system %system)
+ (environment managed-host-environment-type)
+ (configuration (machine-ssh-configuration
+ (host-name "localhost")
+ (identity "./id_rsa")
+ (port 2222)))))
+@end example
+
+The file should evaluate to a list of @var{machine} objects. This example,
+upon being deployed, will create a new generation on the remote system
+realizing the @code{operating-system} declaration @var{%system}.
+@var{environment} and @var{configuration} specify how the machine should be
+provisioned---that is, how the computing resources should be created and
+managed. The above example does not create any resources, as a
+@code{'managed-host} is a machine that is already running the Guix system and
+available over the network. This is a particularly simple case; a more
+complex deployment may involve, for example, starting virtual machines through
+a Virtual Private Server (VPS) provider. In such a case, a different
+@var{environment} type would be used.
+
+@deftp {Data Type} machine
+This is the data type representing a single machine in a heterogeneous Guix
+deployment.
+
+@table @asis
+@item @code{system}
+The object of the operating system configuration to deploy.
+
+@item @code{environment}
+An @code{environment-type} describing how the machine should be provisioned.
+At the moment, the only supported value is
+@code{managed-host-environment-type}.
+
+@item @code{configuration} (default: @code{#f})
+An object describing the configuration for the machine's @code{environment}.
+If the @code{environment} has a default configuration, @code{#f} maybe used.
+If @code{#f} is used for an environment with no default configuration,
+however, an error will be thrown.
+@end table
+@end deftp
+
+@deftp {Data Type} machine-ssh-configuration
+This is the data type representing the SSH client parameters for a machine
+with an @code{environment} of @code{managed-host-environment-type}.
+
+@table @asis
+@item @code{host-name}
+@item @code{port} (default: @code{22})
+@item @code{user} (default: @code{"root"})
+@item @code{identity} (default: @code{#f})
+If specified, the path to the SSH private key to use to authenticate with the
+remote host.
+@end table
+@end deftp
+
@node Running Guix in a VM
@section Running Guix in a Virtual Machine
# Copyright © 2017 sharlatan <sharlatanus@gmail.com>
# Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
# Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
+# Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
#
# This file is part of GNU Guix.
#
chk_require()
{ # Check that every required command is available.
- declare -a cmds
declare -a warn
-
- cmds=(${1})
+ local c
_debug "--- [ $FUNCNAME ] ---"
- for c in ${cmds[@]}; do
+ for c in "$@"; do
command -v "$c" &>/dev/null || warn+=("$c")
done
return 1; }
_msg "${PAS}verification of required commands completed"
+}
+
+chk_gpg_keyring()
+{ # Check whether the Guix release signing public key is present.
+ _debug "--- [ $FUNCNAME ] ---"
- gpg --list-keys ${OPENPGP_SIGNING_KEY_ID} >/dev/null 2>&1 || (
+ # Without --dry-run this command will create a ~/.gnupg owned by root on
+ # systems where gpg has never been used, causing errors and confusion.
+ gpg --dry-run --list-keys ${OPENPGP_SIGNING_KEY_ID} >/dev/null 2>&1 || (
_err "${ERR}Missing OpenPGP public key. Fetch it with this command:"
echo " wget https://sv.gnu.org/people/viewgpg.php?user_id=15145 -qO - | gpg --import -"
exit 1
_msg "Starting installation ($(date))"
chk_term
- chk_require "${REQUIRE[*]}"
+ chk_require "${REQUIRE[@]}"
+ chk_gpg_keyring
chk_init_sys
chk_sys_arch
"/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))
(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)
%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 \
%D%/packages/wget.scm \
%D%/packages/wicd.scm \
%D%/packages/wine.scm \
+ %D%/packages/wireservice.scm \
%D%/packages/wm.scm \
%D%/packages/wordnet.scm \
%D%/packages/wv.scm \
%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 \
%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.
%D%/packages/patches/4store-unset-preprocessor-directive.patch \
%D%/packages/patches/a2ps-CVE-2001-1593.patch \
%D%/packages/patches/a2ps-CVE-2014-0466.patch \
+ %D%/packages/patches/a2ps-CVE-2015-8107.patch \
%D%/packages/patches/abiword-explictly-cast-bools.patch \
%D%/packages/patches/abiword-black-drawing-with-gtk322.patch \
%D%/packages/patches/adb-add-libraries.patch \
%D%/packages/patches/clementine-use-openssl.patch \
%D%/packages/patches/clisp-remove-failing-test.patch \
%D%/packages/patches/clucene-pkgconfig.patch \
- %D%/packages/patches/clx-remove-demo.patch \
%D%/packages/patches/coda-use-system-libs.patch \
%D%/packages/patches/combinatorial-blas-awpm.patch \
%D%/packages/patches/combinatorial-blas-io-fix.patch \
%D%/packages/patches/cpufrequtils-fix-aclocal.patch \
%D%/packages/patches/crawl-upgrade-saves.patch \
%D%/packages/patches/crda-optional-gcrypt.patch \
+ %D%/packages/patches/csvkit-fix-tests.patch \
%D%/packages/patches/clucene-contribs-lib.patch \
%D%/packages/patches/cube-nocheck.patch \
%D%/packages/patches/cursynth-wave-rand.patch \
- %D%/packages/patches/cvs-2017-12836.patch \
+ %D%/packages/patches/cvs-CVE-2017-12836.patch \
%D%/packages/patches/dbus-helper-search-path.patch \
%D%/packages/patches/dealii-mpi-deprecations.patch \
%D%/packages/patches/deja-dup-use-ref-keyword-for-iter.patch \
%D%/packages/patches/evilwm-lost-focus-bug.patch \
%D%/packages/patches/exiv2-CVE-2017-14860.patch \
%D%/packages/patches/exiv2-CVE-2017-14859-14862-14864.patch \
+ %D%/packages/patches/expat-CVE-2018-20843.patch \
%D%/packages/patches/extundelete-e2fsprogs-1.44.patch \
%D%/packages/patches/fastcap-mulGlobal.patch \
%D%/packages/patches/fastcap-mulSetup.patch \
%D%/packages/patches/gpsbabel-qstring.patch \
%D%/packages/patches/grep-timing-sensitive-test.patch \
%D%/packages/patches/groovy-add-exceptionutilsgenerator.patch \
- %D%/packages/patches/grub-binutils-compat.patch \
- %D%/packages/patches/grub-check-error-efibootmgr.patch \
%D%/packages/patches/grub-efi-fat-serial-number.patch \
%D%/packages/patches/gsl-test-i686.patch \
%D%/packages/patches/gspell-dash-test.patch \
%D%/packages/patches/libdrm-symbol-check.patch \
%D%/packages/patches/libexif-CVE-2016-6328.patch \
%D%/packages/patches/libexif-CVE-2017-7544.patch \
- %D%/packages/patches/libgpg-error-gawk-compat.patch \
+ %D%/packages/patches/libexif-CVE-2018-20030.patch \
%D%/packages/patches/libgit2-avoid-python.patch \
%D%/packages/patches/libgit2-mtime-0.patch \
%D%/packages/patches/libgnome-encoding.patch \
%D%/packages/patches/libgnomeui-utf8.patch \
+ %D%/packages/patches/libgpg-error-gawk-compat.patch \
%D%/packages/patches/libffi-3.2.1-complex-alpha.patch \
%D%/packages/patches/libjxr-fix-function-signature.patch \
%D%/packages/patches/libjxr-fix-typos.patch \
%D%/packages/patches/pixman-CVE-2016-5296.patch \
%D%/packages/patches/plink-1.07-unclobber-i.patch \
%D%/packages/patches/plink-endian-detection.patch \
+ %D%/packages/patches/plib-CVE-2011-4620.patch \
+ %D%/packages/patches/plib-CVE-2012-4552.patch \
%D%/packages/patches/plotutils-libpng-jmpbuf.patch \
%D%/packages/patches/podofo-cmake-3.12.patch \
%D%/packages/patches/portaudio-audacity-compat.patch \
%D%/packages/patches/python2-pygobject-2-gi-info-type-error-domain.patch \
%D%/packages/patches/python-pygpgme-fix-pinentry-tests.patch \
%D%/packages/patches/python-robotframework-honor-source-date-epoch.patch \
+ %D%/packages/patches/python-slugify-depend-on-unidecode.patch \
%D%/packages/patches/python2-subprocess32-disable-input-test.patch \
%D%/packages/patches/python-unittest2-python3-compat.patch \
%D%/packages/patches/python-unittest2-remove-argparse.patch \
--- /dev/null
+;;; 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:
+
+\f
+;;;
+;;; 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)))
+
+\f
+;;;
+;;; 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)))
--- /dev/null
+;;; 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:
+
+\f
+;;;
+;;; 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)))))
+
+\f
+;;;
+;;; 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)))
+
+\f
+;;;
+;;; 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)))
+
+\f
+;;;
+;;; 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))))))))
(define-public pies
(package
(name "pies")
- (version "1.3")
+ (version "1.4")
(source
(origin
(method url-fetch)
version ".tar.bz2"))
(sha256
(base32
- "12r7rjjyibjdj08dvwbp0iflfpzl4s0zhn6cr6zj3hwf9gbzgl1g"))))
+ "14jb4pa4zs26d5j2skxbaypnwhsx2lw8jgj1irrgs03c2dnf7gp6"))))
(build-system gnu-build-system)
(arguments
'(#:phases (modify-phases %standard-phases
;; Use the right shell when executing user-provided
;; shell commands.
(let ((bash (assoc-ref inputs "bash")))
- (substitute* "src/progman.c"
+ (substitute* '("src/progman.c" "src/comp.c")
(("\"/bin/sh\"")
(string-append "\"" bash "/bin/sh\"")))
#t))))))
(define-public acpica
(package
(name "acpica")
- (version "20190509")
+ (version "20190703")
(source (origin
(method url-fetch)
(uri (string-append
version ".tar.gz"))
(sha256
(base32
- "17cf5jhcy9wqla5c9s08khqg0pxhar2nmwdcja2jf2srl2a5y2w6"))))
+ "0kp3ian3lffx9709ajrr3bp6b9cb6c6v1crjziyr8j8pp639jlwz"))))
(build-system gnu-build-system)
(native-inputs `(("flex" ,flex)
("bison" ,bison)))
(define-public testdisk
(package
(name "testdisk")
- (version "7.0")
+ (version "7.1")
(source (origin
(method url-fetch)
- (uri (string-append "http://www.cgsecurity.org/testdisk-"
+ (uri (string-append "https://www.cgsecurity.org/testdisk-"
version ".tar.bz2"))
(sha256
(base32
- "0ba4wfz2qrf60vwvb1qsq9l6j0pgg81qgf7fh22siaz649mkpfq0"))))
+ "1zlh44w67py416hkvw6nrfmjickc2d43v51vcli5p374d5sw84ql"))))
(build-system gnu-build-system)
(inputs
`(("ntfs-3g" ,ntfs-3g)
("util-linux" ,util-linux)
("openssl" ,openssl)
- ;; FIXME: add reiserfs
+ ;; FIXME: add reiserfs.
("zlib" ,zlib)
("e2fsprogs" ,e2fsprogs)
("libjpeg" ,libjpeg)
(define-public sedsed
(package
(name "sedsed")
- (version "1.0")
+ (version "1.1")
(source
(origin
(method git-fetch)
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
- (base32 "0009lsjsxhqmgaklpwq15hhd94hpiy7r4va69yy0ig3mxi6zbg2z"))))
+ (base32 "05cl35mwljdb9ynbbsfa8zx6ig8r0xncbg2cir9vwn5manndjj18"))))
(build-system python-build-system)
(arguments
`(#:tests? #f ; no tests
- #:python ,python-2
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-sed-in
;; Just one file to copy around
(install-file "sedsed.py" bin)
#t)))
- (add-after 'install 'symlink
+ (add-after 'wrap 'symlink
;; Create 'sedsed' symlink to "sedsed.py".
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(sed (string-append bin "/sedsed"))
(sedpy (string-append bin "/sedsed.py")))
- (symlink sedpy sed)
+ (symlink sedpy sed)
#t))))))
- (home-page "http://aurelio.net/projects/sedsed")
+ (home-page "https://aurelio.net/projects/sedsed")
(synopsis "Sed sed scripts")
(description
- "@code{sedsed} can debug, indent, tokenize and HTMLize your sed(1) script.
+ "@code{sedsed} can debug, indent, tokenize and HTMLize your @command{sed}
+script.
-In debug mode it reads your script and add extra commands to it. When
+In debug mode, it reads your script and adds extra commands to it. When
executed you can see the data flow between the commands, revealing all the
-magic sed does on its internal buffers.
+magic sed performs on its internal buffers.
-In indent mode your script is reformatted with standard spacing.
+In indent mode, your script is reformatted with standard spacing.
-In tokenize mode you can see the elements of every command you use.
+In tokenize mode, you can see the elements of every command you use.
-In HTMLize mode your script is converted to a beautiful colored HTML file,
+In HTMLize mode, your script is converted to a beautiful colored HTML file,
with all the commands and parameters identified for your viewing pleasure.
With sedsed you can master any sed script. No more secrets, no more hidden
(license license:gpl2)
(home-page "https://pari.math.u-bordeaux.fr/")))
+(define fplll-4-cmh
+ (package
+ (inherit fplll)
+ (name "fplll")
+ (version "4.0.4")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append
+ "http://perso.ens-lyon.fr/damien.stehle/fplll/libfplll-"
+ version ".tar.gz"))
+ (sha256
+ (base32 "1cbiby7ykis4z84swclpysrljmqhfcllpkcbll1m08rzskgb1a6b"))))))
+
(define-public cmh
(package
(name "cmh")
("mpfr" ,mpfr)
("mpc" ,mpc)
("mpfrcx" ,mpfrcx)
- ("fplll" ,fplll)
+ ("fplll" ,fplll-4-cmh)
("pari-gp" ,pari-gp)))
(synopsis "Igusa class polynomial computations")
(description
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016, 2017, 2018 Roel Janssen <roel@gnu.org>
-;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2017, 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;
(define-public r-txdb-mmusculus-ucsc-mm10-knowngene
(package
(name "r-txdb-mmusculus-ucsc-mm10-knowngene")
- (version "3.4.4")
+ (version "3.4.7")
(source (origin
(method url-fetch)
;; We cannot use bioconductor-uri here because this tarball is
version ".tar.gz"))
(sha256
(base32
- "01lgxc1fx5nhlpbwjd5zqghkkbmh6axd98ikx4b0spv0jdg6gf39"))))
+ "04impkl8zh1gpwwrpbf19jqznsjrq2306yyhm6cmx6hr1401bd6b"))))
(properties
`((upstream-name . "TxDb.Mmusculus.UCSC.mm10.knownGene")))
(build-system r-build-system)
;; (LGPLv2.1+) and scripts in samples (which have GPL2 and GPL2+)
(license (list license:ruby license:lgpl2.1+ license:gpl2+ ))))
-(define-public r-biocinstaller
- (package
- (name "r-biocinstaller")
- (version "1.32.1")
- (source (origin
- (method url-fetch)
- (uri (bioconductor-uri "BiocInstaller" version))
- (sha256
- (base32
- "1s1f9qhyf3mc73ir25x2zlgi9hf45a37lg4z8fbva4i21hqisgsl"))))
- (properties
- `((upstream-name . "BiocInstaller")))
- (build-system r-build-system)
- (home-page "https://bioconductor.org/packages/BiocInstaller")
- (synopsis "Install Bioconductor packages")
- (description "This package is used to install and update R packages from
-Bioconductor, CRAN, and Github.")
- (license license:artistic2.0)))
-
(define-public r-biocviews
(package
(name "r-biocviews")
(define-public r-xbioc
(let ((revision "1")
- (commit "f798c187e376fd1ba27abd559f47bbae7e3e466b"))
+ (commit "6ff0670a37ab3036aaf1d94aa4b208310946b0b5"))
(package
(name "r-xbioc")
- (version (git-version "0.1.15" revision commit))
+ (version (git-version "0.1.16" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(file-name (git-file-name name version))
(sha256
(base32
- "03hffh2f6z71y6l6dqpa5cql3hdaw7zigdi8sm2dzgx379k9rgrr"))))
+ "0w8bsq5myiwkfhh83nm6is5ichiyvwa1axx2szvxnzq39x6knf66"))))
(build-system r-build-system)
(propagated-inputs
`(("r-annotationdbi" ,r-annotationdbi)
("r-assertthat" ,r-assertthat)
("r-biobase" ,r-biobase)
- ("r-biocinstaller" ,r-biocinstaller)
+ ("r-biocmanager" ,r-biocmanager)
("r-digest" ,r-digest)
("r-pkgmaker" ,r-pkgmaker)
("r-plyr" ,r-plyr)
;; <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)
(recursive? #t)))
(file-name (git-file-name name version))
(sha256
- (base32 "09j5gz57yr9i34a27vbl72i4g8syv2zzgmsfyjq02yshmnrvkjs6"))
+ (base32 "15ikl3d37y49pwd7vx36xksgsqajhf24q7qqsnpl15dqqyy5qgbc"))
(modules '((guix build utils)))
(snippet
'(begin
(define-public grub
(package
(name "grub")
- (version "2.02")
+ (version "2.04")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/grub/grub-" version ".tar.xz"))
(sha256
(base32
- "03vvdfhdmf16121v7xs8is2krwnv15wpkhkf16a4yf8nsfc3f2w1"))
- (patches (search-patches "grub-check-error-efibootmgr.patch"
- "grub-binutils-compat.patch"
- "grub-efi-fat-serial-number.patch"))))
+ "0zgp5m3hmc9jh8wpjx6czzkh5id2y8n1k823x2mjvm2sk6b28ag5"))
+ (patches (search-patches "grub-efi-fat-serial-number.patch"))))
(build-system gnu-build-system)
(arguments
- `(#:phases (modify-phases %standard-phases
+ `(#:configure-flags
+ ;; Counterintuitively, this *disables* a spurious Python dependency by
+ ;; calling the ‘true’ binary instead. Python is only needed during
+ ;; bootstrapping (for genptl.py), not when building from a release.
+ (list "PYTHON=true")
+ #:phases (modify-phases %standard-phases
(add-after 'unpack 'patch-stuff
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "grub-core/Makefile.in"
(substitute* "Makefile.in"
(("grub_cmd_date grub_cmd_set_date grub_cmd_sleep")
"grub_cmd_date grub_cmd_sleep"))
+ #t))
+ (add-before 'check 'disable-pixel-perfect-test
+ (lambda _
+ ;; This test compares many screenshots rendered with an
+ ;; older Unifont (9.0.06) than that packaged in Guix.
+ (substitute* "Makefile.in"
+ (("test_unset grub_func_test")
+ "test_unset"))
#t)))
;; Disable tests on ARM and AARCH64 platforms.
#:tests? ,(not (any (cute string-prefix? <> (or (%current-target-system)
;; for generating alternative keyboard layouts.
("console-setup" ,console-setup)
+ ;; Needed for ‘grub-mount’, the only reliable way to tell whether a given
+ ;; file system will be readable by GRUB without rebooting.
+ ("fuse" ,fuse)
+
("freetype" ,freetype)
;; ("libusb" ,libusb)
- ;; ("fuse" ,fuse)
("ncurses" ,ncurses)))
(native-inputs
`(("pkg-config" ,pkg-config)
("valgrind" ,valgrind)
("vulkan-headers" ,vulkan-headers)))
- ;; Building Chromium with a single core takes around 6 hours on an x86_64
- ;; system. Give some leeway for slower or busy machines.
- (properties '((timeout . 64800))) ;18 hours
+ ;; Building Chromium takes ... a very long time. On a single core, a busy
+ ;; mid-end x86 system may need more than 24 hours to complete the build.
+ (properties '((timeout . 144000))) ;40 hours
(home-page "https://github.com/Eloston/ungoogled-chromium")
(description
;;; Copyright © 2019 Jack Hill <jackhill@jackhill.us>
;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2019 Gábor Boskovits <boskovits@gmail.com>
+;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (gnu packages popt)
#:use-module (gnu packages python)
#:use-module (gnu packages python-crypto)
+ #:use-module (gnu packages python-web)
#:use-module (gnu packages python-xyz)
#:use-module (gnu packages rdf)
#:use-module (gnu packages readline)
(package
(inherit postgresql)
(name "postgresql")
- (version "9.6.13")
+ (version "9.6.14")
(source (origin
(method url-fetch)
(uri (string-append "https://ftp.postgresql.org/pub/source/v"
version "/postgresql-" version ".tar.bz2"))
(sha256
(base32
- "197964wb5pc5fx81a6mh9hlcrr9sgr3nqlpmljv6asi9aq0d5gpc"))))))
+ "08hsqczy1ixkjyf2vr3s9x69agfz9yr8lh31fir4z0dfr5jw421z"))))))
(define-public python-pymysql
(package
(define-public python2-pyarrow
(package-with-python2 python-pyarrow))
+
+(define-public python-crate
+ (package
+ (name "python-crate")
+ (version "0.23.0")
+ (source (origin
+ (method url-fetch)
+ (uri (pypi-uri "crate" version))
+ (sha256
+ (base32
+ "0s3s7yg4m2zflg9q96aibwb5hizsn10ql63fsj6h5z624qkavnlp"))))
+ (build-system python-build-system)
+ (propagated-inputs
+ `(("python-urllib3" ,python-urllib3)))
+ (home-page "https://github.com/crate/crate-python")
+ (synopsis "CrateDB Python client")
+ (description
+ "This package provides a Python client library for CrateDB.
+It implements the Python DB API 2.0 specification and includes support for
+SQLAlchemy.")
+ (license license:asl2.0)))
(define-public grammalecte
(package
(name "grammalecte")
- (version "1.1.1")
+ (version "1.2")
(source
(origin
(method url-fetch/zipbomb)
"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")
;;; Copyright © 2018 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2019 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
;;;
;;; This file is part of GNU Guix.
;;;
"0wy13i3i4x2bw1hf5m4fd0myh61f9bcrs035fdlf6gyc1jksrcp6"))))
(build-system gnu-build-system)
(arguments
- `(#:make-flags (list (string-append "PREFIX=" %output)
+ `(#:configure-flags (list "--enable-compat-symlinks")
+ #:make-flags (list (string-append "PREFIX=" %output)
"CC=gcc")))
(native-inputs
`(("xxd" ,xxd))) ; for tests
(define-public snap
(package
(name "snap")
- (version "5")
+ (version "5.0.1")
(source
(origin
(method git-fetch)
(file-name (git-file-name name version))
(sha256
(base32
- "0bh52n7nklaaq02qb56v7bvrslf047my6irl7g8h6xfjgw04yf20"))))
+ "0ic0xgal19yazbd1kffmbjhiicvvlw5clj48lj80mksa2lgvnzna"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils))
(define-public emacs-git-timemachine
(package
(name "emacs-git-timemachine")
- (version "4.5")
+ (version "4.10")
(source
(origin
- (method url-fetch)
- (uri (string-append "https://gitlab.com/pidu/git-timemachine"
- "/-/archive/" version
- "/git-timemachine-" version ".tar.gz"))
- (file-name (string-append name "-" version ".tar.gz"))
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://gitlab.com/pidu/git-timemachine.git")
+ (commit version)))
+ (file-name (git-file-name name version))
(sha256
(base32
- "0ii40qcincasg7s1yrvqcxkqcqzb4sfs7gcxscn6m4x4ans165zy"))))
+ "08zsn3lsnnf01wkv5ls38jga02s5dnf0j3gigy4qd6im3j3d04m1"))))
(build-system emacs-build-system)
+ (propagated-inputs
+ `(("emacs-transient" ,emacs-transient)))
(home-page "https://gitlab.com/pidu/git-timemachine")
(synopsis "Step through historic versions of Git-controlled files")
(description "This package enables you to step through historic versions
(define-public emacs-simple-httpd
(package
(name "emacs-simple-httpd")
- (version "1.4.6")
+ (version "1.5.1")
(source
(origin
(method git-fetch)
(commit version)))
(file-name (git-file-name name version))
(sha256
- (base32 "1qmkc0w28l53zzf5yd2grrk1sq222g5qnsm35ph25s1cfvc1qb2g"))))
+ (base32 "0dpn92rg813c4pq7a1vzj3znyxzp2lmvxqz6pzcqi0l2xn5r3wvb"))))
(build-system emacs-build-system)
- (home-page "https://github.com/skeeto/emacs-http-server")
+ (home-page "https://github.com/skeeto/emacs-web-server")
(synopsis "HTTP server in pure Emacs Lisp")
(description
"This package provides a simple HTTP server written in Emacs Lisp to
(define-public emacs-skewer-mode
(package
(name "emacs-skewer-mode")
- (version "1.6.2")
+ (version "1.8.0")
(source
(origin
(method git-fetch)
(commit version)))
(file-name (git-file-name name version))
(sha256
- (base32 "05jndz0c26q60s416vqgvr66axdmxb7qsr2g70fvl5iqavnayhpv"))))
+ (base32 "1ha7jl7776pk1bki5zj2q0jy66450mn8xr3aqjc0m9kj3gc9qxgw"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-simple-httpd" ,emacs-simple-httpd)
It is built on top of the custom theme support in Emacs 24 or later.")
(license license:gpl3+)))
+(define-public emacs-moe-theme-el
+ (let ((commit "6e086d855d6bb446bbd1090742815589a81a915f")
+ (version "1.0")
+ (revision "1"))
+ (package
+ (name "emacs-moe-theme-el")
+ (version (git-version version revision commit))
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/kuanyui/moe-theme.el")
+ (commit commit)))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32 "0xj4wfd7h4jqnr193pizm9frf6lmwjr0dsdv2l9mqh9k691z1dnc"))))
+ (build-system emacs-build-system)
+ (home-page "https://github.com/kuanyui/moe-theme.el")
+ (synopsis "Anime-inspired color themes")
+ (description
+ "This package provides vibrant color schemes with light and dark
+variants.")
+ (license license:gpl3+))))
+
(define-public emacs-solarized-theme
(package
(name "emacs-solarized-theme")
(define-public emacs-hydra
(package
(name "emacs-hydra")
- (version "0.14.0")
+ (version "0.15.0")
(source
(origin
(method git-fetch)
(file-name (git-file-name name version))
(sha256
(base32
- "0ln4z2796ycy33g5jcxkqvm7638qxy4sipsab7d2864hh700cikg"))))
+ "0fapvhmhgc9kppf3bvkgry0cd7gyilg7sfvlscfrfjxpx4xvwsfy"))))
(build-system emacs-build-system)
(home-page "https://github.com/abo-abo/hydra")
(synopsis "Make Emacs bindings that stick around")
(license license:gpl3+)))
(define-public emacs-zoutline
- (let ((commit "b3ee0f0e0b916838c2d2c249beba74ffdb8d5699")
- (revision "0"))
- (package
- (name "emacs-zoutline")
- (version (git-version "0.1" revision commit))
- (home-page "https://github.com/abo-abo/zoutline")
- (source (origin
- (method git-fetch)
- (uri (git-reference (url home-page) (commit commit)))
- (sha256
- (base32
- "0sd0017piw0dis6dhpq5dkqd3acisxqgipl7dj8gmc1vnswhdwr8"))
- (file-name (git-file-name name version))))
- (build-system emacs-build-system)
- (synopsis "Simple outline library")
- (description
- "This library provides helpers for outlines. Outlines allow users to
+ (package
+ (name "emacs-zoutline")
+ (version "0.2.0")
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/abo-abo/zoutline")
+ (commit version)))
+ (sha256
+ (base32
+ "1w0zh6vs7klgivq5r030a82mcfg1zwic4x3fimyiqyg5n8p67hyx"))
+ (file-name (git-file-name name version))))
+ (build-system emacs-build-system)
+ (home-page "https://github.com/abo-abo/zoutline")
+ (synopsis "Simple outline library")
+ (description
+ "This library provides helpers for outlines. Outlines allow users to
navigate code in a tree-like fashion.")
- (license license:gpl3+))))
+ (license license:gpl3+)))
(define-public emacs-lispy
(package
state and will work even without lispy being enabled.")
(license license:gpl3+))))
+(define-public emacs-lpy
+ (let ((commit "553d28f7b6523ae5d44d34852ab770b871b0b0ad")
+ (version "0.1.0")
+ (revision "1"))
+ (package
+ (name "emacs-lpy")
+ (version (git-version version revision commit))
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/abo-abo/lpy")
+ (commit commit)))
+ (sha256
+ (base32
+ "0kl9b3gga18cwv5cq4db8i6b7waj6mp3h2l7qjnp7wq6dpvwhn0i"))
+ (file-name (git-file-name name version))))
+ (propagated-inputs
+ `(("emacs-zoutline" ,emacs-zoutline)
+ ("emacs-lispy" ,emacs-lispy)))
+ (build-system emacs-build-system)
+ (home-page "https://github.com/abo-abo/lpy")
+ (synopsis "Modal editing for Python")
+ (description
+ "This package provides a minor mode for Python that binds useful
+commands to unprefixed keys, such as @code{j} or @code{e}, under certain
+circumstances, and leaves the keys untouched outside of those situations,
+allowing unprefixed keys to insert their respective characters as expected.")
+ (license license:gpl3+))))
+
(define-public emacs-clojure-mode
(package
(name "emacs-clojure-mode")
(license license:gpl3+))))
(define-public emacs-goto-chg
- (package
- (name "emacs-goto-chg")
- (version "1.6")
- (source
- (origin
- (method url-fetch)
- ;; There is no versioned source.
- (uri "https://www.emacswiki.org/emacs/download/goto-chg.el")
- (file-name (string-append "goto-chg-" version ".el"))
- (sha256
- (base32
- "078d6p4br5vips7b9x4v6cy0wxf6m5ij9gpqd4g33bryn22gnpij"))))
- (build-system emacs-build-system)
- ;; There is no other home page.
- (home-page "https://www.emacswiki.org/emacs/goto-chg.el")
- (synopsis "Go to the last change in the Emacs buffer")
- (description
- "This package provides @code{M-x goto-last-change} command that goes to
+ (let ((commit "1829a13026c597e358f716d2c7793202458120b5")
+ (version "1.7.3")
+ (revision "1"))
+ (package
+ (name "emacs-goto-chg")
+ (version (git-version version revision commit))
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/emacs-evil/goto-chg")
+ (commit commit)))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "1y603maw9xwdj3qiarmf1bp13461f9f5ackzicsbynl0i9la3qki"))))
+ (build-system emacs-build-system)
+ (propagated-inputs
+ `(("emacs-undo-tree" ,emacs-undo-tree)))
+ (home-page "https://github.com/emacs-evil/goto-chg")
+ (synopsis "Go to the last change in the Emacs buffer")
+ (description
+ "This package provides @code{M-x goto-last-change} command that goes to
the point of the most recent edit in the current Emacs buffer. When repeated,
go to the second most recent edit, etc. Negative argument, @kbd{C-u -}, is
used for reverse direction.")
- (license license:gpl2+)))
+ (license license:gpl2+))))
(define-public emacs-janpath-evil-numbers
(let ((commit "d988041c1fe6e941dc8d591390750b237f71f524")
(license license:gpl3+)))
(define-public emacs-restclient
- (let ((commit "07a3888bb36d0e29608142ebe743b4362b800f40")
- (revision "1")) ;Guix package revision,
+ (let ((commit "422ee8d8b077dffe65706a0f027ed700b84746bc")
+ (version "0")
+ (revision "2")) ;Guix package revision,
;upstream doesn't have official releases
(package
(name "emacs-restclient")
- (version (string-append revision "."
- (string-take commit 7)))
+ (version (git-version version revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(commit commit)))
(sha256
(base32
- "00lmjhb5im1kgrp54yipf1h9pshxzgjlg71yf2rq5n973gvb0w0q"))
+ "067nin7vxkdpffxa0q61ybv7szihhvpdinivmci9qkbb86rs9kkz"))
(file-name (git-file-name name version))))
(build-system emacs-build-system)
(propagated-inputs
(define-public emacs-polymode
(package
(name "emacs-polymode")
- (version "0.1.5")
+ (version "0.2")
(source (origin
(method git-fetch)
(uri (git-reference
- (url "https://github.com/vspinu/polymode.git")
+ (url "https://github.com/polymode/polymode.git")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
- "0wwphs54jx48a3ca6x1qaz56j3j9bg4mv8g2akkffrzbdcb8sbc7"))))
+ "04v0gnzfsjb50bgly6kvpryx8cyzwjaq2llw4qv9ijw1l6ixmq3b"))))
(build-system emacs-build-system)
- (arguments
- `(#:include (cons* "^modes/.*\\.el$" %default-include)
- #:phases
- (modify-phases %standard-phases
- (add-after 'set-emacs-load-path 'add-modes-subdir-to-load-path
- (lambda _
- (setenv "EMACSLOADPATH"
- (string-append (getenv "EMACSLOADPATH")
- ":" (getcwd) "/modes" ":")))))))
- (home-page "https://github.com/vspinu/polymode")
+ (home-page "https://github.com/polymode/polymode")
(synopsis "Framework for multiple Emacs modes based on indirect buffers")
- (description "Polymode is an Emacs package that offers generic support
-for multiple major modes inside a single Emacs buffer. It is lightweight,
-object oriented and highly extensible. Creating a new polymode typically
-takes only a few lines of code. Polymode also provides extensible facilities
-for external literate programming tools for exporting, weaving and tangling.")
+ (description
+ "Polymode is an Emacs package that offers generic support for multiple
+major modes inside a single Emacs buffer. It is lightweight, object oriented
+and highly extensible. Creating a new polymode typically takes only a few
+lines of code. Polymode also provides extensible facilities for external
+literate programming tools for exporting, weaving and tangling.")
(license license:gpl3+)))
(define-public emacs-polymode-ansible
"Edit YAML files for Ansible containing embedded Jinja2 templating.")
(license license:gpl3+))))
+(define-public emacs-polymode-org
+ (package
+ (name "emacs-polymode-org")
+ (version "0.2")
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/polymode/poly-org.git")
+ (commit (string-append "v" version))))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "04x6apjad4kg30456z1j4ipp64yjgkcaim6hqr6bb0rmrianqhck"))))
+ (build-system emacs-build-system)
+ (propagated-inputs
+ `(("emacs-polymode" ,emacs-polymode)))
+ (properties '((upstream-name . "poly-org")))
+ (home-page "https://github.com/polymode/poly-org")
+ (synopsis "Polymode definitions for Org mode buffers")
+ (description
+ "Provides definitions for @code{emacs-polymode} to support
+@code{emacs-org} buffers. Edit source blocks in an Org mode buffer using the
+native modes of the blocks' languages while remaining inside the primary Org
+buffer.")
+ (license license:gpl3+)))
+
(define-public eless
(package
(name "eless")
(license license:gpl3+))))
(define-public emacs-md4rd
- (let ((commit "c55512c2f7680db2a1e73db6bdf93adecaf40fec")
- (revision "1"))
- (package
- (name "emacs-md4rd")
- (version (string-append "0.0.2" "-" revision "."
- (string-take commit 7)))
- (source (origin
- (method git-fetch)
- (uri (git-reference
- (url "https://github.com/ahungry/md4rd.git")
- (commit commit)))
- (file-name (git-file-name name version))
- (sha256
- (base32
- "0mvv1mvsrpkrmikcpfqf2zbawnzgq33j6zjdrlv48mcw57xb2ak9"))))
- (propagated-inputs
- `(("emacs-hierarchy" ,emacs-hierarchy)
- ("emacs-request" ,emacs-request)
- ("emacs-dash" ,emacs-dash)
- ("emacs-s" ,emacs-s)
- ("emacs-tree-mode" ,emacs-tree-mode)))
- (build-system emacs-build-system)
- (home-page "https://github.com/ahungry/md4rd")
- (synopsis "Emacs Mode for Reddit")
- (description
- "This package allows to read Reddit from within Emacs interactively.")
- (license license:gpl3+))))
+ (package
+ (name "emacs-md4rd")
+ (version "0.3.1")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/ahungry/md4rd.git")
+ (commit version)))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "1n6g6k4adzkkn1g7z4j27s35xy12c1fg2r08gv345ddr3wplq4ri"))))
+ (propagated-inputs
+ `(("emacs-hierarchy" ,emacs-hierarchy)
+ ("emacs-request" ,emacs-request)
+ ("emacs-dash" ,emacs-dash)
+ ("emacs-s" ,emacs-s)
+ ("emacs-tree-mode" ,emacs-tree-mode)))
+ (build-system emacs-build-system)
+ (home-page "https://github.com/ahungry/md4rd")
+ (synopsis "Emacs Mode for Reddit")
+ (description
+ "This package allows to read Reddit from within Emacs interactively.")
+ (license license:gpl3+)))
(define-public emacs-pulseaudio-control
(let ((commit "7e1a87068379075a5e9ce36c64c686c03d20d379")
(license license:gpl3+)))
(define-public emacs-stumpwm-mode
- (let ((commit "8fbe071d2c6c040794060a354eb377218dc10b35")
- (revision "1"))
+ (let ((commit "5328f85fbf6a8b08c758c17b9435368bf7a68f39"))
(package
(name "emacs-stumpwm-mode")
- (version (string-append "0.0.1-" revision "."
- (string-take commit 7)))
+ (version (git-version "0.0.1" "1" commit))
(source (origin
(method git-fetch)
(uri (git-reference
(file-name (git-file-name name version))
(sha256
(base32
- "1dfwsvz1c8w6j4jp0kzaz78ml3f5dp0a5pvf090kwpbpg176r7iq"))))
+ "00kf4k8bqadi5s667wb96sn549v2kvw01zwszjrg7nhd805m1ng6"))))
(build-system emacs-build-system)
(arguments
`(#:phases
(define-public emacs-company-restclient
(package
(name "emacs-company-restclient")
- (version "0.1.0")
+ (version "0.3.0")
(source
(origin
(method git-fetch)
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
- (base32 "0i1fh5lvqwlgn3g3fzh0xacxyljx6gkryipn133vfkv4jbns51n4"))))
+ (base32 "0yp0hlrgcr6yy1xkjvfckys2k24x9xg7y6336ma61bdwn5lpv0x0"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-company" ,emacs-company)
(version "1.1")
(source
(origin
- (method url-fetch)
- (uri (string-append
- "https://gitlab.com/Ambrevar/emacs-fish-completion/repository/"
- "archive.tar.gz?ref="
- version))
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://gitlab.com/Ambrevar/emacs-fish-completion.git")
+ (commit version)))
+ (file-name (git-file-name name version))
(sha256
(base32
- "0bpvifv6c2a65nks6kvarw0hhm37fnyy74wikwf9qq1i20va0fpv"))))
+ "1pjqnbyjmj64q5nwq1mrdxcls4fp5y0b6zqs785i0s6wdvrm4021"))))
(build-system emacs-build-system)
(inputs `(("fish" ,fish)))
(arguments
(let ((fish (assoc-ref inputs "fish")))
;; Specify the absolute file names of the various
;; programs so that everything works out-of-the-box.
+ (make-file-writable "fish-completion.el")
(emacs-substitute-variables
"fish-completion.el"
("fish-completion-command"
(package
(name "emacs-disk-usage")
(version "1.3.3")
- (home-page "https://gitlab.com/Ambrevar/emacs-disk-usage")
(source
(origin
- (method url-fetch)
- (uri (string-append
- "https://elpa.gnu.org/packages/disk-usage-"
- version
- ".el"))
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://gitlab.com/Ambrevar/emacs-disk-usage.git")
+ (commit version)))
+ (file-name (git-file-name name version))
(sha256
(base32
- "0h1jwznd41gi0vg830ilfgm01q05zknikzahwasm9cizwm2wyizj"))))
+ "0hv2gsd8k5fbjgckgiyisq4rn1i7y4rchbjy8kmixjv6mx563bll"))))
(build-system emacs-build-system)
+ (home-page "https://gitlab.com/Ambrevar/emacs-disk-usage")
(synopsis "Sort and browse disk usage listings with Emacs")
(description "Disk Usage is a file system analyzer: it offers a tabulated
view of file listings sorted by size. Directory sizes are computed
"plib-" version ".tar.gz"))
(sha256
(base32
- "0cha71mflpa10vh2l7ipyqk67dq2y0k5xbafwdks03fwdyzj4ns8"))))
+ "0cha71mflpa10vh2l7ipyqk67dq2y0k5xbafwdks03fwdyzj4ns8"))
+ (patches (search-patches "plib-CVE-2011-4620.patch"
+ "plib-CVE-2012-4552.patch"))))
(build-system gnu-build-system)
(inputs
`(("mesa" ,mesa)
("cairo" ,cairo)
("gdk-pixbuf" ,gdk-pixbuf)
("glib" ,glib)
- ("gtk+" ,gtk+)
("json-glib" ,json-glib)
("libinput" ,libinput)
("libx11" ,libx11)
("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")
(define-public lollypop
(package
(name "lollypop")
- (version "0.9.521")
+ (version "1.1.3.1")
(source
(origin
(method url-fetch)
(uri (string-append "https://gitlab.gnome.org/World/lollypop/uploads/"
- "e4df2ed75c5ed71d64afcc668e579b2a/"
+ "5a7cd7c72b6d83ae08d0c54c4691f9df/"
name "-" version ".tar.xz"))
(sha256
(base32
- "0knsqh24siyw98vmiq6b1hzq4y4cazs9f1hq1js9c96hqqj9rvdx"))))
+ "1r5wn0bja9psz6nr1rcaysdkkwz84rbyzpdfw66cxa6wiy52pkjm"))))
(build-system meson-build-system)
(arguments
`(#:imported-modules ((guix build python-build-system)
("python" ,python)
("python-beautifulsoup4" ,python-beautifulsoup4)
("python-gst" ,python-gst)
+ ("python-pil" ,python-pillow)
("python-pycairo" ,python-pycairo)
("python-pygobject" ,python-pygobject)
("python-pylast" ,python-pylast)
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016, 2017, 2018, 2019 ng0 <ng0@n0.is>
-;;; Copyright © 2016, 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2016, 2017, 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;;
;;; This file is part of GNU Guix.
(define-public libmicrohttpd
(package
(name "libmicrohttpd")
- (version "0.9.64")
+ (version "0.9.65")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/libmicrohttpd/libmicrohttpd-"
version ".tar.gz"))
(sha256
(base32
- "03imzkd1hl2mkkpi84vg5xq9x6b58gwsv86ym85km0lhb7nxi4p7"))))
+ "1jdk6wigvnkh5bi9if4rik8i9sbvdql61lm8ipgpypyxqmcpjipj"))))
(build-system gnu-build-system)
(inputs
`(("curl" ,curl)
In contrast to GNU Pth is is based on the system's standard threads
implementation. This allows the use of libraries which are not
compatible to GNU Pth.")
- (license (list license:lgpl3+ license:gpl2+)))) ; dual license
+ (license (list license:lgpl3+ license:gpl2+)) ; dual license
+ (properties '((ftp-server . "ftp.gnupg.org")
+ (ftp-directory . "/gcrypt/npth")))))
(define-public gnupg
(package
(name "gnupg")
- (version "2.2.16")
+ (version "2.2.17")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnupg/gnupg/gnupg-" version
".tar.bz2"))
(sha256
(base32
- "1jqlzp9b3kpfp1dkjqskm67jjrhvf9nh3lzf45321p7m9d2qvgkc"))))
+ "056mgy09lvsi03531a437qj58la1j2x1y1scvfi53diris3658mg"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
programming task, it is suggested that all software should try to use GPGME
instead. This way bug fixes or improvements can be done at a central place
and every application benefits from this.")
- (license license:lgpl2.1+)))
+ (license license:lgpl2.1+)
+ (properties '((ftp-server . "ftp.gnupg.org")
+ (ftp-directory . "/gcrypt/gpgme")))))
(define-public qgpgme
(package
(define-public python-gnupg
(package
(name "python-gnupg")
- (version "0.4.3")
+ (version "0.4.4")
(source
(origin
(method url-fetch)
(uri (pypi-uri "python-gnupg" version))
(sha256
(base32
- "03dc8whhvk7ccspbk8vzfhkxli8cd9zfbss5p597g4jldgy8s59d"))))
+ "03pvjyp6q9pr8qa22i38az06ddzhvzy5kj192hxa3gbhnchg1nj5"))))
(build-system python-build-system)
(arguments
`(#:phases
(define-public gpa
(package
(name "gpa")
- (version "0.9.10")
+ (version "0.10.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnupg/gpa/"
name "-" version ".tar.bz2"))
(sha256
(base32
- "09xphbi2456qynwqq5n0yh0zdmdi2ggrj3wk4hsyh5lrzlvcrff3"))))
+ "1cbpc45f8qbdkd62p12s3q2rdq6fa5xdzwmcwd3xrj55bzkspnwm"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))
"GPA, the GNU Privacy Assistant, is a graphical user interface for
@uref{https://gnupg.org, GnuPG}. It can be used to encrypt, decrypt, and sign
files, to verify signatures, and to manage the private and public keys.")
- (license license:gpl3+)))
+ (license license:gpl3+)
+ (properties '((ftp-server . "ftp.gnupg.org")
+ (ftp-directory . "/gcrypt/gpa")))))
(define-public parcimonie
(package
#:system system
#:guile-for-build guile)))
-(define %icecat-version "60.7.2-guix1")
+(define %icecat-version "60.8.0-guix1")
;; 'icecat-source' is a "computed" origin that generates an IceCat tarball
;; from the corresponding upstream Firefox ESR tarball, using the 'makeicecat'
"firefox-" upstream-firefox-version ".source.tar.xz"))
(sha256
(base32
- "1hkaq8mavmn2wphfbrlq3v56jvmvfi2nyvrkjgr28rc01jkqx4ca"))))
+ "1gkz90clarbhgfxhq91s0is6lw6bfymyjb0xbyyswdg68kcqfcy1"))))
(upstream-icecat-base-version "60.7.0") ; maybe older than base-version
(upstream-icecat-gnu-version "1")
("mesa" ,mesa)
("mit-krb5" ,mit-krb5)
;; See <https://bugs.gnu.org/32833>
- ;; and related comments in the 'snippet' above.
+ ;; and related comments in the 'remove-bundled-libraries' phase.
;; UNBUNDLE-ME! ("nspr" ,nspr)
;; UNBUNDLE-ME! ("nss" ,nss)
("sqlite" ,sqlite)
"--with-system-icu"
;; See <https://bugs.gnu.org/32833>
- ;; and related comments in the 'snippet' above.
+ ;; and related comments in the
+ ;; 'remove-bundled-libraries' phase below.
;; UNBUNDLE-ME! "--with-system-nspr"
;; UNBUNDLE-ME! "--with-system-nss"
(define-public gama
(package
(name "gama")
- (version "2.03")
+ (version "2.06")
(source
(origin
(method url-fetch)
version ".tar.gz"))
(sha256
(base32
- "0d33yyasnx54c6i40rkr9by4qv92rqb8wkmp5r46nz7bbp9kpymv"))))
+ "06xp3kj099b6m2fsmgcbzgj7xk4j0drsps52m4fr8vc6fglsh44p"))))
(build-system gnu-build-system)
(arguments '(#:parallel-tests? #f)) ; race condition
(native-inputs
("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)
;;; 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>
;; <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")
;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
-;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;;
;;; This file is part of GNU Guix.
(define-public mujs
(package
(name "mujs")
- (version "1.0.5")
+ (version "1.0.6")
(source (origin
- (method git-fetch)
- (uri (git-reference
- (url "https://git.ghostscript.com/mujs.git")
- (commit version)))
- (file-name (string-append name "-" version "-checkout"))
+ (method url-fetch)
+ (uri (string-append "https://mujs.com/downloads/mujs-"
+ version ".tar.xz"))
(sha256
(base32
- "0pkv26jxwgv5ax0ylfmi4h96h79hj4gvr95218ns8wngnmgr1ny6"))))
+ "1q9w2dcspfp580pzx7sw7x9gbn8j0ak6dvj75wd1ml3f3q3i43df"))))
(build-system gnu-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(delete 'configure) ; no configure
(add-after 'install 'install-shared-library
- (lambda* (#:key outputs #:allow-other-keys)
- (let ((out (assoc-ref outputs "out")))
- (install-file "build/release/libmujs.so"
- (string-append out "/lib"))))))
+ (lambda* (#:key (make-flags '()) #:allow-other-keys)
+ (apply invoke "make" "install-shared" make-flags))))
#:make-flags (list (string-append "prefix=" (assoc-ref %outputs "out"))
(string-append "CC=gcc"))
#:tests? #f)) ; no tests
(inputs
`(("readline" ,readline)))
- (home-page "https://artifex.com/mujs/")
+ (home-page "https://mujs.com/")
(synopsis "JavaScript interpreter written in C")
(description "MuJS is a lightweight Javascript interpreter designed for
embedding in other software to extend them with scripting capabilities. MuJS
It has been modified to remove all non-free binary blobs.")
(license license:gpl2)))
-(define %linux-libre-version "5.1.16")
-(define %linux-libre-hash "055vs2g6z6wx34qvi0aw952x9q3drbj7z27s7g7pks6w730xkga8")
+(define %linux-libre-version "5.1.17")
+(define %linux-libre-hash "049mij4z1iilrggw6plfdpcj1lnc1vqz5z445ix9677cq1fmiwlh")
(define %linux-libre-5.1-patches
(list %boot-logo-patch
(make-linux-libre-headers %linux-libre-version
%linux-libre-hash))
-(define %linux-libre-4.19-version "4.19.57")
-(define %linux-libre-4.19-hash "0p9b27hfbzppxgad9q2g7nvfzv0phzdsk16sqy87q3dglc8wqrqq")
+(define %linux-libre-4.19-version "4.19.58")
+(define %linux-libre-4.19-hash "0i2mh0zk1h1niba1bpd49bn938sdn3qrwzkqpqzimxnj31xcjhyz")
(define %linux-libre-4.19-patches
(list %boot-logo-patch
(make-linux-libre-headers %linux-libre-4.19-version
%linux-libre-4.19-hash))
-(define %linux-libre-4.14-version "4.14.132")
-(define %linux-libre-4.14-hash "0mvp4izw21f8w5kkk8qm8m8b7qjxbp8hshgffdlh1aik41zvcnyq")
+(define %linux-libre-4.14-version "4.14.133")
+(define %linux-libre-4.14-hash "16ay2x0r5i96lg4rgcg151352igvwxa7wh98kwdsjbckiw7fhn08")
(define-public linux-libre-4.14
(make-linux-libre %linux-libre-4.14-version
%linux-libre-4.14-hash))
(define-public linux-libre-4.9
- (make-linux-libre "4.9.184"
- "0q3ggndwf0rwsb3xv33zl9awkd1803h2l9b4g6d6ps3f2sjxwxwa"
+ (make-linux-libre "4.9.185"
+ "1byz9cxvslm45nv01abhzvrm2isdskx5k11gi5rpa39r7lx6bmjp"
'("x86_64-linux" "i686-linux")
#:configuration-file kernel-config))
(define-public linux-libre-4.4
- (make-linux-libre "4.4.184"
- "05v295wk9fid17n5plkx6p9nwz6dvpcn2r7khwsq30sy3pg0vxv5"
+ (make-linux-libre "4.4.185"
+ "0df22wqj1nwqp60v8341qcmjhwmdr0hgfraishpc7hic8aqdr4p7"
'("x86_64-linux" "i686-linux")
#:configuration-file kernel-config
#:extra-options
(define-public iproute
(package
(name "iproute2")
- (version "5.1.0")
+ (version "5.2.0")
(source (origin
(method url-fetch)
(uri (string-append
version ".tar.xz"))
(sha256
(base32
- "1kvvrz5mlpjxqcm7vl6i8w6l1cb2amp6p5xyq006pgzafc49hnnw"))))
+ "1a2dywa2kam24951byv9pl32mb9z6klh7d4vp8fwfgrm4vn5vfd5"))))
(build-system gnu-build-system)
(arguments
`( ;; There is a test suite, but it wants network namespaces and sudo.
;;; Copyright © 2018 Benjamin Slade <slade@jnanam.net>
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
-;;; Copyright © 2018 Pierre Langlois <pierre.langlois@gmx.com>
+;;; Copyright © 2018
, 2019 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2019 Katherine Cox-Buday <cox.katherine.e@gmail.com>
;;; Copyright © 2019 Jesse Gildersleve <jessejohngildersleve@protonmail.com>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
(sbcl-package->cl-source-package sbcl-cl-unicode))
(define-public sbcl-clx
- (let ((revision "1")
- (commit "1c62774b03c1cf3fe6e5cb532df8b14b44c96b95"))
- (package
- (name "sbcl-clx")
- (version (string-append "0.0.0-" revision "." (string-take commit 7)))
- (source
- (origin
- (method git-fetch)
- (uri
- (git-reference
- (url "https://github.com/sharplispers/clx.git")
- (commit commit)))
- (sha256
- (base32 "0qffag03ns52kwq9xjns2qg1yr0bf3ba507iwq5cmx5xz0b0rmjm"))
- (file-name (string-append "clx-" version "-checkout"))
- (patches
- (list
- (search-patch "clx-remove-demo.patch")))
- (modules '((guix build utils)))
- (snippet
- '(begin
- ;; These removed files cause the compiled system to crash when
- ;; loading.
- (delete-file-recursively "demo")
- (delete-file "test/trapezoid.lisp")
- (substitute* "clx.asd"
- (("\\(:file \"trapezoid\"\\)") ""))
- #t))))
- (build-system asdf-build-system/sbcl)
- (home-page "http://www.cliki.net/portable-clx")
- (synopsis "X11 client library for Common Lisp")
- (description "CLX is an X11 client library for Common Lisp. The code was
+ (package
+ (name "sbcl-clx")
+ (version "0.7.5")
+ (source
+ (origin
+ (method git-fetch)
+ (uri
+ (git-reference
+ (url "https://github.com/sharplispers/clx.git")
+ (commit version)))
+ (sha256
+ (base32
+ "1vi67z9hpj5rr4xcmfbfwzmlcc0ah7hzhrmfid6lqdkva238v2wf"))
+ (file-name (string-append "clx-" version))))
+ (build-system asdf-build-system/sbcl)
+ (native-inputs
+ `(("fiasco" ,sbcl-fiasco)))
+ (home-page "http://www.cliki.net/portable-clx")
+ (synopsis "X11 client library for Common Lisp")
+ (description "CLX is an X11 client library for Common Lisp. The code was
originally taken from a CMUCL distribution, was modified somewhat in order to
make it compile and run under SBCL, then a selection of patches were added
from other CLXes around the net.")
- (license license:x11))))
+ (license license:x11)))
(define-public cl-clx
(sbcl-package->cl-source-package sbcl-clx))
`(("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
(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
;; 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"))
(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.")))
;;; Copyright © 2016, 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Roel Janssen <roel@gnu.org>
;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com>
-;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
(version (package-version llvm))
(source (origin
(method url-fetch)
- (uri (string-append "http://releases.llvm.org/"
+ (uri (string-append "https://releases.llvm.org/"
version "/openmp-" version
".src.tar.xz"))
(sha256
(base32
- "030dkg5cypd7j9hq0mcqb5gs31lxwmzfq52j81l7v9ldcy5bf5mz"))
+ "1mf9cpgvix34xlpv0inkgl3qmdvgvp96f7sksqizri0n5xfp1cgp"))
(file-name (string-append "libomp-" version ".tar.xz"))))
(build-system cmake-build-system)
;; XXX: Note this gets built with GCC because building with Clang itself
--- /dev/null
+;;; 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+)))
"--with-tls=gnutls")
#:phases
(modify-phases %standard-phases
- (add-after 'install 'install-msmtpq
+ (add-after 'install 'install-additional-files
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(doc (string-append out "/share/doc/msmtp"))
- (msmtpq (string-append "scripts/msmtpq")))
+ (msmtpq "scripts/msmtpq")
+ (vimfiles (string-append out "/share/vim/vimfiles/plugin")))
(install-file (string-append msmtpq "/msmtpq") bin)
(install-file (string-append msmtpq "/msmtp-queue") bin)
(install-file (string-append msmtpq "/README.msmtpq") doc)
+ (install-file "scripts/vim/msmtp.vim" vimfiles)
#t))))))
(synopsis
"Simple and easy to use SMTP client with decent sendmail compatibility")
(license gpl2+)))
(define-public mumi
- (let ((commit "ea5a738010148284aed211da953ad670003aefea")
- (revision "3"))
+ (let ((commit "ea0a28f8d5db5761765eb60043b8593901552e25")
+ (revision "4"))
(package
(name "mumi")
(version (git-version "0.0.0" revision commit))
(file-name (git-file-name name version))
(sha256
(base32
- "0ci5x8dqjmp74w33q2dbs5csxp4ilfmc1xxaa8q2jnh52d7597hl"))))
+ "0b6dmi41vhssyf983blgi8a2kj3zjccc9cz7b7kvwh781ldqcywh"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(define-public musescore
(package
(name "musescore")
- (version "3.2")
+ (version "3.2.3")
(source (origin
(method git-fetch)
(uri (git-reference
(file-name (git-file-name name version))
(sha256
(base32
- "0719p4hjlq7skga8q4hvnd5w33vhrd1a1aygvqm9pn4na02zazy6"))
+ "17wx1wl8ns2k31qvrr888dxnrsa13vazg04zh2sn2q4vzd869a7v"))
(modules '((guix build utils)))
(snippet
;; Un-bundle OpenSSL and remove unused libraries.
(define-public strongswan
(package
(name "strongswan")
- (version "5.6.3")
+ (version "5.8.0")
(source
(origin
(method url-fetch)
(uri (string-append "https://download.strongswan.org/strongswan-"
version ".tar.bz2"))
(sha256
- (base32 "095zg7h7qwsc456sqgwb1lhhk29ac3mk5z9gm6xja1pl061driy3"))))
+ (base32 "0cq9m86ydd2i0awxkv4a256f4926p2f9pzlisyskl9fngl6f3c8m"))))
(build-system gnu-build-system)
(arguments
`(#:phases
equipment (e.g. routers), computer equipment and even devices like UPSs.
Net-SNMP is a suite of applications used to implement SNMP v1, SNMP v2c and
SNMP v3 using both IPv4 and IPv6.")
+ ;; This only affects OpenBSD
+ ;; https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2015-8100
+ (properties `((lint-hidden-cve . ("CVE-2015-8100"))))
(license (list license:bsd-3
(license:non-copyleft
"http://www.net-snmp.org/about/license.html"
(define-public diffoscope
(package
(name "diffoscope")
- (version (git-version "115" "1" "7f3416ffd12572b42c814e43ac15cee44ef48155"))
+ (version "116")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://salsa.debian.org/reproducible-builds/diffoscope.git")
- (commit "7f3416ffd12572b42c814e43ac15cee44ef48155")))
+ (commit "116")))
(file-name (git-file-name name version))
(sha256
(base32
- "1pn2rwlz5shdx7s63798wx2v7029bl5if6dlq3i2r6zsnpp0laki"))))
+ "1anz2c112y0w21mh7xp6bs6z7v10dcy1i25nypkvqy3j929m0g28"))))
(build-system python-build-system)
(arguments
`(#:phases (modify-phases %standard-phases
--- /dev/null
+https://sources.debian.org/data/main/a/a2ps/1:4.14-2/debian/patches/fix-format-security.diff
+
+Index: b/lib/psgen.c
+===================================================================
+--- a/lib/psgen.c
++++ b/lib/psgen.c
+@@ -232,7 +232,7 @@
+ default:
+ *buf = '\0';
+ ps_escape_char (job, cp[i], buf);
+- output (jdiv, (char *) buf);
++ output (jdiv, "%s", (char *) buf);
+ break;
+ }
+ }
+Index: b/lib/output.c
+===================================================================
+--- a/lib/output.c
++++ b/lib/output.c
+@@ -525,7 +525,7 @@
+ expand_user_string (job, FIRST_FILE (job),
+ (const uchar *) "Expand: requirement",
+ (const uchar *) token));
+- output (dest, expansion);
++ output (dest, "%s", expansion);
+ continue;
+ }
+
+Index: b/lib/parseppd.y
+===================================================================
+--- a/lib/parseppd.y
++++ b/lib/parseppd.y
+@@ -154,7 +154,7 @@
+ void
+ yyerror (const char *msg)
+ {
+- error_at_line (1, 0, ppdfilename, ppdlineno, msg);
++ error_at_line (1, 0, ppdfilename, ppdlineno, "%s", msg);
+ }
+
+ /*
+Index: b/src/parsessh.y
+===================================================================
+--- a/src/parsessh.y
++++ b/src/parsessh.y
+@@ -740,7 +740,7 @@
+ void
+ yyerror (const char *msg)
+ {
+- error_at_line (1, 0, sshfilename, sshlineno, msg);
++ error_at_line (1, 0, sshfilename, sshlineno, "%s", msg);
+ }
+
+ /*
+Index: b/lib/parseppd.c
+===================================================================
+--- a/lib/parseppd.c
++++ b/lib/parseppd.c
+@@ -1707,7 +1707,7 @@
+ void
+ yyerror (const char *msg)
+ {
+- error_at_line (1, 0, ppdfilename, ppdlineno, msg);
++ error_at_line (1, 0, ppdfilename, ppdlineno, "%s", msg);
+ }
+
+ /*
+Index: b/src/parsessh.c
+===================================================================
+--- a/src/parsessh.c
++++ b/src/parsessh.c
+@@ -2639,7 +2639,7 @@
+ void
+ yyerror (const char *msg)
+ {
+- error_at_line (1, 0, sshfilename, sshlineno, msg);
++ error_at_line (1, 0, sshfilename, sshlineno, "%s", msg);
+ }
+
+ /*
+++ /dev/null
---- a/clx.asd 2016-02-16 00:06:48.161596976 -0500
-+++ b/clx.asd 2016-02-16 00:06:54.793774658 -0500
-@@ -79,24 +79,6 @@
- (:file "xtest")
- (:file "screensaver")
- (:file "xinerama")))
-- (:module demo
-- :default-component-class example-source-file
-- :components
-- ((:file "bezier")
-- ;; KLUDGE: this requires "bezier" for proper operation,
-- ;; but we don't declare that dependency here, because
-- ;; asdf doesn't load example files anyway.
-- (:file "beziertest")
-- (:file "clclock")
-- (:file "clipboard")
-- (:file "clx-demos")
-- (:file "gl-test")
-- ;; FIXME: compiling this generates 30-odd spurious code
-- ;; deletion notes. Find out why, and either fix or
-- ;; workaround the problem.
-- (:file "mandel")
-- (:file "menu")
-- (:file "zoid")))
- (:module test
- :default-component-class example-source-file
- :components
--- /dev/null
+diff --git a/tests/test_utilities/test_csvsql.py b/tests/test_utilities/test_csvsql.py
+index e6ec4af..4f47980 100644
+--- a/tests/test_utilities/test_csvsql.py
++++ b/tests/test_utilities/test_csvsql.py
+@@ -197,7 +197,7 @@ class TestCSVSQL(CSVKitTestCase, EmptyFileTests):
+ utility.run()
+ output = output_file.getvalue()
+ output_file.close()
+- self.assertEqual(output, 'a,b,c\n1,2,3\n0,5,6\n')
++ self.assertEqual(output, 'a,b,c\n1,2.0,3.0\n0,5.0,6.0\n')
+
+ def test_no_prefix_unique_constraint(self):
+ self.get_output(['--db', 'sqlite:///' + self.db_file, '--insert', 'examples/dummy.csv', '--unique-constraint', 'a'])
+diff --git a/tests/test_utilities/test_sql2csv.py b/tests/test_utilities/test_sql2csv.py
+index a0c3d3e..babcfd6 100644
+--- a/tests/test_utilities/test_sql2csv.py
++++ b/tests/test_utilities/test_sql2csv.py
+@@ -121,23 +121,23 @@ class TestSQL2CSV(CSVKitTestCase, EmptyFileTests):
+ input_file.close()
+
+ def test_unicode(self):
+- expected = self.csvsql('examples/test_utf8.csv')
++ self.csvsql('examples/test_utf8.csv')
+ csv = self.get_output(['--db', 'sqlite:///' + self.db_file, '--query', 'select * from foo'])
+- self.assertEqual(csv.strip(), expected)
++ self.assertEqual(csv.strip(), 'foo,bar,baz\n1.0,2.0,3\n4.0,5.0,ʤ')
+
+ def test_no_header_row(self):
+ self.csvsql('examples/dummy.csv')
+ csv = self.get_output(['--db', 'sqlite:///' + self.db_file, '--no-header-row', '--query', 'select * from foo'])
+
+ self.assertTrue('a,b,c' not in csv)
+- self.assertTrue('1,2,3' in csv)
++ self.assertTrue('1,2.0,3.0' in csv)
+
+ def test_linenumbers(self):
+ self.csvsql('examples/dummy.csv')
+ csv = self.get_output(['--db', 'sqlite:///' + self.db_file, '--linenumbers', '--query', 'select * from foo'])
+
+ self.assertTrue('line_number,a,b,c' in csv)
+- self.assertTrue('1,1,2,3' in csv)
++ self.assertTrue('1,1,2.0,3.0' in csv)
+
+ def test_wildcard_on_sqlite(self):
+ self.csvsql('examples/iris.csv')
--- /dev/null
+Fix extraction of namespace prefix from XML name.
+Fixes CVE-2018-20843
+
+This patch comes from upstream commit 11f8838bf99ea0a6f0b76f9760c43704d00c4ff6
+https://github.com/libexpat/libexpat/commit/11f8838bf99ea0a6f0b76f9760c43704d00c4ff6
+
+CVE is https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2018-20843
+
+diff --git a/expat/lib/xmlparse.c b/expat/lib/xmlparse.c
+index 30d55c5..737d7cd 100644
+--- a/lib/xmlparse.c
++++ b/lib/xmlparse.c
+@@ -6071,7 +6071,7 @@ setElementTypePrefix(XML_Parser parser, ELEMENT_TYPE *elementType)
+ else
+ poolDiscard(&dtd->pool);
+ elementType->prefix = prefix;
+-
++ break;
+ }
+ }
+ return 1;
+++ /dev/null
-Fix a relocation issue that shows up with recent binutils.
-
-Patch taken from upstream:
-https://git.sv.gnu.org/cgit/grub.git/commit/?id=842c390469e2c2e10b5aa36700324cd3bde25875
-
-diff --git a/grub-core/efiemu/i386/loadcore64.c b/grub-core/efiemu/i386/loadcore64.c
-index e49d0b6..18facf4 100644
---- a/grub-core/efiemu/i386/loadcore64.c
-+++ b/grub-core/efiemu/i386/loadcore64.c
-@@ -98,6 +98,7 @@ grub_arch_efiemu_relocate_symbols64 (grub_efiemu_segment_t segs,
- break;
-
- case R_X86_64_PC32:
-+ case R_X86_64_PLT32:
- err = grub_efiemu_write_value (addr,
- *addr32 + rel->r_addend
- + sym.off
-diff --git a/grub-core/kern/x86_64/dl.c b/grub-core/kern/x86_64/dl.c
-index 4406906..3a73e6e 100644
---- a/grub-core/kern/x86_64/dl.c
-+++ b/grub-core/kern/x86_64/dl.c
-@@ -70,6 +70,7 @@ grub_arch_dl_relocate_symbols (grub_dl_t mod, void *ehdr,
- break;
-
- case R_X86_64_PC32:
-+ case R_X86_64_PLT32:
- {
- grub_int64_t value;
- value = ((grub_int32_t) *addr32) + rel->r_addend + sym->st_value -
-diff --git a/util/grub-mkimagexx.c b/util/grub-mkimagexx.c
-index a2bb054..39d7efb 100644
---- a/util/grub-mkimagexx.c
-+++ b/util/grub-mkimagexx.c
-@@ -841,6 +841,7 @@ SUFFIX (relocate_addresses) (Elf_Ehdr *e, Elf_Shdr *sections,
- break;
-
- case R_X86_64_PC32:
-+ case R_X86_64_PLT32:
- {
- grub_uint32_t *t32 = (grub_uint32_t *) target;
- *t32 = grub_host_to_target64 (grub_target_to_host32 (*t32)
-diff --git a/util/grub-module-verifier.c b/util/grub-module-verifier.c
-index 9179285..a79271f 100644
---- a/util/grub-module-verifier.c
-+++ b/util/grub-module-verifier.c
-@@ -19,6 +19,7 @@ struct grub_module_verifier_arch archs[] = {
- -1
- }, (int[]){
- R_X86_64_PC32,
-+ R_X86_64_PLT32,
- -1
- }
- },
+++ /dev/null
-Without this patch, GRUB may proceed to wipe all firmware boot entries
-and report a successful installation, even if efibootmgr hit an error.
-
-Origin URL:
-https://git.sv.gnu.org/cgit/grub.git/commit/?id=6400613ad0b463abc93362086a491cd2a5e99b0d
-
-From 6400613ad0b463abc93362086a491cd2a5e99b0d Mon Sep 17 00:00:00 2001
-From: Steve McIntyre <steve@einval.com>
-Date: Wed, 31 Jan 2018 21:49:36 +0000
-Subject: Make grub-install check for errors from efibootmgr
-
-Code is currently ignoring errors from efibootmgr, giving users
-clearly bogus output like:
-
- Setting up grub-efi-amd64 (2.02~beta3-4) ...
- Installing for x86_64-efi platform.
- Could not delete variable: No space left on device
- Could not prepare Boot variable: No space left on device
- Installation finished. No error reported.
-
-and then potentially unbootable systems. If efibootmgr fails, grub-install
-should know that and report it!
-
-We've been using similar patch in Debian now for some time, with no ill effects.
-
-diff --git a/grub-core/osdep/unix/platform.c b/grub-core/osdep/unix/platform.c
-index a3fcfca..ca448bc 100644
---- a/grub-core/osdep/unix/platform.c
-+++ b/grub-core/osdep/unix/platform.c
-@@ -78,19 +78,20 @@ get_ofpathname (const char *dev)
- dev);
- }
-
--static void
-+static int
- grub_install_remove_efi_entries_by_distributor (const char *efi_distributor)
- {
- int fd;
- pid_t pid = grub_util_exec_pipe ((const char * []){ "efibootmgr", NULL }, &fd);
- char *line = NULL;
- size_t len = 0;
-+ int rc;
-
- if (!pid)
- {
- grub_util_warn (_("Unable to open stream from %s: %s"),
- "efibootmgr", strerror (errno));
-- return;
-+ return errno;
- }
-
- FILE *fp = fdopen (fd, "r");
-@@ -98,7 +99,7 @@ grub_install_remove_efi_entries_by_distributor (const char *efi_distributor)
- {
- grub_util_warn (_("Unable to open stream from %s: %s"),
- "efibootmgr", strerror (errno));
-- return;
-+ return errno;
- }
-
- line = xmalloc (80);
-@@ -119,23 +120,25 @@ grub_install_remove_efi_entries_by_distributor (const char *efi_distributor)
- bootnum = line + sizeof ("Boot") - 1;
- bootnum[4] = '\0';
- if (!verbosity)
-- grub_util_exec ((const char * []){ "efibootmgr", "-q",
-+ rc = grub_util_exec ((const char * []){ "efibootmgr", "-q",
- "-b", bootnum, "-B", NULL });
- else
-- grub_util_exec ((const char * []){ "efibootmgr",
-+ rc = grub_util_exec ((const char * []){ "efibootmgr",
- "-b", bootnum, "-B", NULL });
- }
-
- free (line);
-+ return rc;
- }
-
--void
-+int
- grub_install_register_efi (grub_device_t efidir_grub_dev,
- const char *efifile_path,
- const char *efi_distributor)
- {
- const char * efidir_disk;
- int efidir_part;
-+ int ret;
- efidir_disk = grub_util_biosdisk_get_osdev (efidir_grub_dev->disk);
- efidir_part = efidir_grub_dev->disk->partition ? efidir_grub_dev->disk->partition->number + 1 : 1;
-
-@@ -151,23 +154,26 @@ grub_install_register_efi (grub_device_t efidir_grub_dev,
- grub_util_exec ((const char * []){ "modprobe", "-q", "efivars", NULL });
- #endif
- /* Delete old entries from the same distributor. */
-- grub_install_remove_efi_entries_by_distributor (efi_distributor);
-+ ret = grub_install_remove_efi_entries_by_distributor (efi_distributor);
-+ if (ret)
-+ return ret;
-
- char *efidir_part_str = xasprintf ("%d", efidir_part);
-
- if (!verbosity)
-- grub_util_exec ((const char * []){ "efibootmgr", "-q",
-+ ret = grub_util_exec ((const char * []){ "efibootmgr", "-q",
- "-c", "-d", efidir_disk,
- "-p", efidir_part_str, "-w",
- "-L", efi_distributor, "-l",
- efifile_path, NULL });
- else
-- grub_util_exec ((const char * []){ "efibootmgr",
-+ ret = grub_util_exec ((const char * []){ "efibootmgr",
- "-c", "-d", efidir_disk,
- "-p", efidir_part_str, "-w",
- "-L", efi_distributor, "-l",
- efifile_path, NULL });
- free (efidir_part_str);
-+ return ret;
- }
-
- void
-diff --git a/include/grub/util/install.h b/include/grub/util/install.h
-index 5910b0c..0dba8b6 100644
---- a/include/grub/util/install.h
-+++ b/include/grub/util/install.h
-@@ -210,7 +210,7 @@ grub_install_create_envblk_file (const char *name);
- const char *
- grub_install_get_default_x86_platform (void);
-
--void
-+int
- grub_install_register_efi (grub_device_t efidir_grub_dev,
- const char *efifile_path,
- const char *efi_distributor);
-diff --git a/util/grub-install.c b/util/grub-install.c
-index 5e4cdfd..690f180 100644
---- a/util/grub-install.c
-+++ b/util/grub-install.c
-@@ -1848,9 +1848,13 @@ main (int argc, char *argv[])
- if (!removable && update_nvram)
- {
- /* Try to make this image bootable using the EFI Boot Manager, if available. */
-- grub_install_register_efi (efidir_grub_dev,
-- "\\System\\Library\\CoreServices",
-- efi_distributor);
-+ int ret;
-+ ret = grub_install_register_efi (efidir_grub_dev,
-+ "\\System\\Library\\CoreServices",
-+ efi_distributor);
-+ if (ret)
-+ grub_util_error (_("efibootmgr failed to register the boot entry: %s"),
-+ strerror (ret));
- }
-
- grub_device_close (ins_dev);
-@@ -1871,6 +1875,7 @@ main (int argc, char *argv[])
- {
- char * efifile_path;
- char * part;
-+ int ret;
-
- /* Try to make this image bootable using the EFI Boot Manager, if available. */
- if (!efi_distributor || efi_distributor[0] == '\0')
-@@ -1887,7 +1892,10 @@ main (int argc, char *argv[])
- efidir_grub_dev->disk->name,
- (part ? ",": ""), (part ? : ""));
- grub_free (part);
-- grub_install_register_efi (efidir_grub_dev,
-- efifile_path, efi_distributor);
-+ ret = grub_install_register_efi (efidir_grub_dev,
-+ efifile_path, efi_distributor);
-+ if (ret)
-+ grub_util_error (_("efibootmgr failed to register the boot entry: %s"),
-+ strerror (ret));
- }
- break;
-
-
-Below is a followup to the patch above: the uninitialized variable could lead
-‘grub-install’ to error out when it shouldn’t (seen on an AArch64 box where
-‘grub_install_remove_efi_entries_by_distributor’ didn't have any entry to
-remove):
-
- grub-install: error: efibootmgr failed to register the boot entry: Unknown error 65535.
-
-See <http://lists.gnu.org/archive/html/bug-grub/2018-10/msg00006.html>.
-
---- grub-2.02/grub-core/osdep/unix/platform.c 2018-10-17 22:21:53.015284846 +0200
-+++ grub-2.02/grub-core/osdep/unix/platform.c 2018-10-17 22:21:55.595271222 +0200
-@@ -85,7 +85,7 @@ grub_install_remove_efi_entries_by_distr
- pid_t pid = grub_util_exec_pipe ((const char * []){ "efibootmgr", NULL }, &fd);
- char *line = NULL;
- size_t len = 0;
-- int rc;
-+ int rc = 0;
-
- if (!pid)
- {
images (the 'efi.img' file) that are reproducible bit-for-bit.
Patch by Ludovic Courtès <ludo@gnu.org>.
+Mangled (for GRUB 2.04) by Tobias Geerinckx-Rice <me@tobias.gr>.
---- grub-2.02/util/grub-mkrescue.c 2019-04-20 19:15:26.180242812 +0200
-+++ grub-2.02/util/grub-mkrescue.c 2019-04-20 21:56:34.672370849 +0200
-@@ -788,8 +788,15 @@ main (int argc, char *argv[])
+--- grub-2.04/util/grub-mkrescue.c 2019-05-20 13:01:11.000000000 +0200
++++ grub-2.04/util/grub-mkrescue.c 2019-07-08 23:57:36.912104652 +0200
+@@ -809,8 +809,15 @@
+ free (efidir_efi_boot);
efiimgfat = grub_util_path_concat (2, iso9660_dir, "efi.img");
- int rv;
- rv = grub_util_exec ((const char * []) { "mformat", "-C", "-f", "2880", "-L", "16", "-i",
- efiimgfat, "::", NULL });
+
+ const char *fat_serial_number = getenv ("GRUB_FAT_SERIAL_NUMBER");
+ const char *mformat_args[] =
-+ { "mformat", "-C", "-f", "2880", "-L", "16",
-+ fat_serial_number != NULL ? "-N" : "-C",
-+ fat_serial_number != NULL ? fat_serial_number : "-C",
-+ "-i", efiimgfat, "::", NULL };
++ { "mformat", "-C", "-f", "2880", "-L", "16",
++ fat_serial_number != NULL ? "-N" : "-C",
++ fat_serial_number != NULL ? fat_serial_number : "-C",
++ "-i", efiimgfat, "::", NULL };
+
+ rv = grub_util_exec (mformat_args);
if (rv != 0)
--- /dev/null
+https://github.com/libexif/libexif/commit/6aa11df549114ebda520dde4cdaea2f9357b2c89.patch
+
+NEWS section was removed
+'12' -> '30' on line 79
+
+From 6aa11df549114ebda520dde4cdaea2f9357b2c89 Mon Sep 17 00:00:00 2001
+From: Dan Fandrich <dan@coneharvesters.com>
+Date: Fri, 12 Oct 2018 16:01:45 +0200
+Subject: [PATCH] Improve deep recursion detection in
+ exif_data_load_data_content.
+
+The existing detection was still vulnerable to pathological cases
+causing DoS by wasting CPU. The new algorithm takes the number of tags
+into account to make it harder to abuse by cases using shallow recursion
+but with a very large number of tags. This improves on commit 5d28011c
+which wasn't sufficient to counter this kind of case.
+
+The limitation in the previous fix was discovered by Laurent Delosieres,
+Secunia Research at Flexera (Secunia Advisory SA84652) and is assigned
+the identifier CVE-2018-20030.
+---
+ NEWS | 1 +
+ libexif/exif-data.c | 45 +++++++++++++++++++++++++++++++++++++--------
+ 2 files changed, 38 insertions(+), 8 deletions(-)
+
+diff --git a/libexif/exif-data.c b/libexif/exif-data.c
+index e35403d..a6f9c94 100644
+--- a/libexif/exif-data.c
++++ b/libexif/exif-data.c
+@@ -35,6 +35,7 @@
+ #include <libexif/olympus/exif-mnote-data-olympus.h>
+ #include <libexif/pentax/exif-mnote-data-pentax.h>
+
++#include <math.h>
+ #include <stdlib.h>
+ #include <stdio.h>
+ #include <string.h>
+@@ -350,6 +351,20 @@ if (data->ifd[(i)]->count) { \
+ break; \
+ }
+
++/*! Calculate the recursion cost added by one level of IFD loading.
++ *
++ * The work performed is related to the cost in the exponential relation
++ * work=1.1**cost
++ */
++static unsigned int
++level_cost(unsigned int n)
++{
++ static const double log_1_1 = 0.09531017980432493;
++
++ /* Adding 0.1 protects against the case where n==1 */
++ return ceil(log(n + 0.1)/log_1_1);
++}
++
+ /*! Load data for an IFD.
+ *
+ * \param[in,out] data #ExifData
+@@ -357,13 +372,13 @@ if (data->ifd[(i)]->count) { \
+ * \param[in] d pointer to buffer containing raw IFD data
+ * \param[in] ds size of raw data in buffer at \c d
+ * \param[in] offset offset into buffer at \c d at which IFD starts
+- * \param[in] recursion_depth number of times this function has been
+- * recursively called without returning
++ * \param[in] recursion_cost factor indicating how expensive this recursive
++ * call could be
+ */
+ static void
+ exif_data_load_data_content (ExifData *data, ExifIfd ifd,
+ const unsigned char *d,
+- unsigned int ds, unsigned int offset, unsigned int recursion_depth)
++ unsigned int ds, unsigned int offset, unsigned int recursion_cost)
+ {
+ ExifLong o, thumbnail_offset = 0, thumbnail_length = 0;
+ ExifShort n;
+@@ -378,9 +393,20 @@ exif_data_load_data_content (ExifData *data, ExifIfd ifd,
+ if ((((int)ifd) < 0) || ( ((int)ifd) >= EXIF_IFD_COUNT))
+ return;
+
+- if (recursion_depth > 30) {
++ if (recursion_cost > 170) {
++ /*
++ * recursion_cost is a logarithmic-scale indicator of how expensive this
++ * recursive call might end up being. It is an indicator of the depth of
++ * recursion as well as the potential for worst-case future recursive
++ * calls. Since it's difficult to tell ahead of time how often recursion
++ * will occur, this assumes the worst by assuming every tag could end up
++ * causing recursion.
++ * The value of 170 was chosen to limit typical EXIF structures to a
++ * recursive depth of about 6, but pathological ones (those with very
++ * many tags) to only 2.
++ */
+ exif_log (data->priv->log, EXIF_LOG_CODE_CORRUPT_DATA, "ExifData",
+- "Deep recursion detected!");
++ "Deep/expensive recursion detected!");
+ return;
+ }
+
+@@ -422,15 +448,18 @@ exif_data_load_data_content (ExifData *data, ExifIfd ifd,
+ switch (tag) {
+ case EXIF_TAG_EXIF_IFD_POINTER:
+ CHECK_REC (EXIF_IFD_EXIF);
+- exif_data_load_data_content (data, EXIF_IFD_EXIF, d, ds, o, recursion_depth + 1);
++ exif_data_load_data_content (data, EXIF_IFD_EXIF, d, ds, o,
++ recursion_cost + level_cost(n));
+ break;
+ case EXIF_TAG_GPS_INFO_IFD_POINTER:
+ CHECK_REC (EXIF_IFD_GPS);
+- exif_data_load_data_content (data, EXIF_IFD_GPS, d, ds, o, recursion_depth + 1);
++ exif_data_load_data_content (data, EXIF_IFD_GPS, d, ds, o,
++ recursion_cost + level_cost(n));
+ break;
+ case EXIF_TAG_INTEROPERABILITY_IFD_POINTER:
+ CHECK_REC (EXIF_IFD_INTEROPERABILITY);
+- exif_data_load_data_content (data, EXIF_IFD_INTEROPERABILITY, d, ds, o, recursion_depth + 1);
++ exif_data_load_data_content (data, EXIF_IFD_INTEROPERABILITY, d, ds, o,
++ recursion_cost + level_cost(n));
+ break;
+ case EXIF_TAG_JPEG_INTERCHANGE_FORMAT:
+ thumbnail_offset = o;
--- /dev/null
+https://sources.debian.org/data/main/p/plib/1.8.5-8/debian/patches/04_CVE-2011-4620.diff
+
+--- a/src/util/ulError.cxx
++++ b/src/util/ulError.cxx
+@@ -39,7 +39,7 @@
+ {
+ va_list argp;
+ va_start ( argp, fmt ) ;
+- vsprintf ( _ulErrorBuffer, fmt, argp ) ;
++ vsnprintf ( _ulErrorBuffer, sizeof(_ulErrorBuffer), fmt, argp ) ;
+ va_end ( argp ) ;
+
+ if ( _ulErrorCB )
--- /dev/null
+https://sources.debian.org/data/main/p/plib/1.8.5-8/debian/patches/05_CVE-2012-4552.diff
+
+diff -up plib-1.8.5/src/ssg/ssgParser.cxx~ plib-1.8.5/src/ssg/ssgParser.cxx
+--- plib-1.8.5/src/ssg/ssgParser.cxx~ 2008-03-11 03:06:23.000000000 +0100
++++ plib-1.8.5/src/ssg/ssgParser.cxx 2012-11-01 15:33:12.424483374 +0100
+@@ -57,18 +57,16 @@ void _ssgParser::error( const char *form
+ char msgbuff[ 255 ];
+ va_list argp;
+
+- char* msgptr = msgbuff;
+- if (linenum)
+- {
+- msgptr += sprintf ( msgptr,"%s, line %d: ",
+- path, linenum );
+- }
+-
+ va_start( argp, format );
+- vsprintf( msgptr, format, argp );
++ vsnprintf( msgbuff, sizeof(msgbuff), format, argp );
+ va_end( argp );
+
+- ulSetError ( UL_WARNING, "%s", msgbuff ) ;
++ if (linenum)
++ {
++ ulSetError ( UL_WARNING, "%s, line %d: %s", path, linenum, msgbuff ) ;
++ } else {
++ ulSetError ( UL_WARNING, "%s", msgbuff ) ;
++ }
+ }
+
+
+@@ -78,18 +76,16 @@ void _ssgParser::message( const char *fo
+ char msgbuff[ 255 ];
+ va_list argp;
+
+- char* msgptr = msgbuff;
+- if (linenum)
+- {
+- msgptr += sprintf ( msgptr,"%s, line %d: ",
+- path, linenum );
+- }
+-
+ va_start( argp, format );
+- vsprintf( msgptr, format, argp );
++ vsnprintf( msgbuff, sizeof(msgbuff), format, argp );
+ va_end( argp );
+
+- ulSetError ( UL_DEBUG, "%s", msgbuff ) ;
++ if (linenum)
++ {
++ ulSetError ( UL_DEBUG, "%s, line %d: %s", path, linenum, msgbuff ) ;
++ } else {
++ ulSetError ( UL_DEBUG, "%s", msgbuff ) ;
++ }
+ }
+
+ // Opens the file and does a few internal calculations based on the spec.
--- /dev/null
+diff --git a/setup.py b/setup.py
+index 4800173..6bdd77f 100755
+--- a/setup.py
++++ b/setup.py
+@@ -14,8 +14,7 @@ url = 'https://github.com/un33k/python-slugify'
+ author = 'Val Neekman'
+ author_email = 'info@neekware.com'
+ license = 'MIT'
+-install_requires = ['text-unidecode==1.2']
+-extras_require = {'unidecode': ['Unidecode==1.0.23']}
++install_requires = ['Unidecode']
+
+ classifiers = [
+ 'Development Status :: 5 - Production/Stable',
+@@ -67,7 +66,6 @@ setup(
+ author_email=author_email,
+ packages=find_packages(exclude=EXCLUDE_FROM_PACKAGES),
+ install_requires=install_requires,
+- extras_require=extras_require,
+ classifiers=classifiers,
+ entry_points={'console_scripts': ['slugify=slugify.slugify:main']},
+ )
(define-public patchwork
(package
(name "patchwork")
- (version "2.1.2")
+ (version "2.1.4")
(source (origin
(method git-fetch)
(uri (git-reference
(file-name (git-file-name name version))
(sha256
(base32
- "06ng5pv6744w98zkyfm0ldkmpdgnsql3gbbbh6awq61sr2ndr3qw"))))
+ "0zi1hcqb0pi2diyznbv0c1631qk4rx02zl8ghyrr59g3ljlyr18y"))))
(build-system python-build-system)
(arguments
`(;; TODO: Tests require a running database
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016 ng0 <ng0@n0.is>
-;;; Copyright © 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
(define-public mupdf
(package
(name "mupdf")
- (version "1.14.0")
+ (version "1.15.0")
(source
(origin
(method url-fetch)
name "-" version "-source.tar.xz"))
(sha256
(base32
- "1psnz02w5p7wc1s1ma7vvjmkjfy641xvsh9ykaqzkk84dflnjgk0"))
+ "0kmcz3ivxmqmks8vg50ri1zar18q5svk829z0g1kj08lgz7kcl2n"))
(modules '((guix build utils)))
(snippet
;; We keep lcms2 since it is different than our lcms.
(for-each
(lambda (dir)
(delete-file-recursively (string-append "thirdparty/" dir)))
- '("curl" "freeglut" "freetype" "harfbuzz" "jbig2dec"
+ '("freeglut" "freetype" "harfbuzz" "jbig2dec"
"libjpeg" "mujs" "openjpeg" "zlib"))
#t))))
(build-system gnu-build-system)
;;; 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>
+;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Roel Janssen <roel@gnu.org>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Leo Famulari <leo@famulari.name>
(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)))
(uri (string-append "mirror://sourceforge/libexif/libexif/"
version "/libexif-" version ".tar.bz2"))
(patches (search-patches "libexif-CVE-2016-6328.patch"
- "libexif-CVE-2017-7544.patch"))
+ "libexif-CVE-2017-7544.patch"
+ "libexif-CVE-2018-20030.patch"))
(sha256
(base32
"06nlsibr3ylfwp28w8f5466l6drgrnydgxrm4jmxzrmk5svaxk8n"))))
(inputs
`(("boost" ,boost)
("enblend-enfuse" ,enblend-enfuse)
- ("exiv2" ,exiv2)
+ ("exiv2" ,exiv2-0.26)
("fftw" ,fftw)
("flann" ,flann)
("freeglut" ,freeglut)
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2016, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
#t))
(patches (search-patches
"a2ps-CVE-2001-1593.patch"
- "a2ps-CVE-2014-0466.patch"))))
+ "a2ps-CVE-2014-0466.patch"
+ "a2ps-CVE-2015-8107.patch"))))
(build-system gnu-build-system)
(inputs
`(("psutils" ,psutils)
;;; 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.
;;;
(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)
#: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))
(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+))))
;;; Copyright © 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2019 Vagrant Cascadian <vagrant@debian.org>
;;; Copyright © 2019 Brendan Tildesley <mail@brendan.scot>
+;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
;;;
;;; This file is part of GNU Guix.
;;;
(propagated-inputs
`(("python-gevent" ,python2-gevent)
("python-tornado" ,python2-tornado)))))
+
+(define-public python-slugify
+ (package
+ (name "python-slugify")
+ (version "3.0.2")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (pypi-uri "python-slugify" version))
+ (sha256
+ (base32
+ "0n6pfmsq899c54plpvzi46l7zrpa3zfpm8im6h32czjw6kxky5jp"))
+ (patches
+ (search-patches "python-slugify-depend-on-unidecode.patch"))))
+ (native-inputs
+ `(("python-wheel" ,python-wheel)))
+ (propagated-inputs
+ `(("python-unidecode" ,python-unidecode)))
+ (arguments
+ `(#:phases
+ (modify-phases %standard-phases
+ (replace 'check
+ (lambda _
+ (invoke "python" "test.py"))))))
+ (build-system python-build-system)
+ (home-page "https://github.com/un33k/python-slugify")
+ (synopsis "Python Slugify application that handles Unicode")
+ (description "This package provides a @command{slufigy} command and
+library to create slugs from unicode strings while keeping it DRY.")
+ (license license:expat)))
;;; 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>
+;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
;;;
;;; This file is part of GNU Guix.
;;;
(define-public python-setuptools
(package
(name "python-setuptools")
- (version "40.8.0")
+ (version "41.0.1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "setuptools" version ".zip"))
(sha256
(base32
- "0k9hifpgahnw2a26w3cr346iy733k6d3nwh3f7g9m13y6f8fqkkf"))
+ "04sns22y2hhsrwfy1mha2lgslvpjsjsz8xws7h2rh5a7ylkd28m2"))
(modules '((guix build utils)))
(snippet
'(begin
(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
;; "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")
(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
(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")
(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")
transactions. Complete support for Berkeley DB Replication Manager.
Complete support for Berkeley DB Base Replication. Support for RPC.")
(license license:bsd-3)))
+
+(define-public python-dbfread
+ (package
+ (name "python-dbfread")
+ (version "2.0.7")
+ (source (origin
+ (method url-fetch)
+ (uri (pypi-uri "dbfread" version))
+ (sha256
+ (base32
+ "0gdpwdzf1fngsi6jrdyj4qdf6cr7gnnr3zp80dpkzbgz0spskj07"))))
+ (build-system python-build-system)
+ (native-inputs
+ `(("python-pytest" ,python-pytest)))
+ (home-page "https://dbfread.readthedocs.io")
+ (synopsis "Read DBF Files with Python")
+ (description
+ "This library reads DBF files and returns the data as native Python data
+types for further processing. It is primarily intended for batch jobs and
+one-off scripts.")
+ (license license:expat)))
(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")
;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
;;;
;;; This file is part of GNU Guix.
;;;
to a file.")
(license gpl3+)))
+(define-public python-pytimeparse
+ (package
+ (name "python-pytimeparse")
+ (version "1.1.8")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (pypi-uri "pytimeparse" version))
+ (sha256
+ (base32
+ "02kaambsgpjx3zi42j6l11rwms2p35b9hsk4f3kdf979gd3kcqg8"))))
+ (native-inputs
+ `(("python-nose" ,python-nose)))
+ (build-system python-build-system)
+ (home-page "https://github.com/wroberts/pytimeparse")
+ (synopsis "Time expression parser")
+ (description "This small Python module parses various kinds of time
+expressions.")
+ (license expat)))
+
(define-public python-pytzdata
(package
(name "python-pytzdata")
(uri (string-append
"https://ftp.gnu.org/non-gnu/cvs/source/feature/"
version "/cvs-" version ".tar.bz2"))
- (patches (search-patches "cvs-2017-12836.patch"))
+ (patches (search-patches "cvs-CVE-2017-12836.patch"))
(sha256
(base32
"0pjir8cwn0087mxszzbsi1gyfc6373vif96cw4q3m1x6p49kd1bq"))))
;; There are no tarball releases.
(define-public vim-airline-themes
- (let ((commit "6026eb78bf362cb3aa875aff8487f65728d0f7d8")
- (revision "1"))
+ (let ((commit "e6f233231b232b6027cde6aebeeb18d9138e5324")
+ (revision "2"))
(package
(name "vim-airline-themes")
- (version (string-append "0.0.0-" revision "." (string-take commit 7)))
+ (version (git-version "0.0.0" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/vim-airline/vim-airline-themes")
(commit commit)))
- (file-name (string-append name "-" version "-checkout"))
+ (file-name (git-file-name name version))
(sha256
(base32
- "13ijkavh1r0935cn2rjsfbdd1q3ka8bi26kw0bdkrqlrqxwvpss8"))))
+ "1sb7nb7j7bz0pv1c9bgdy0smhr0jk2b1vbdv9yzghg5lrknpsbr6"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f
;;; Copyright © 2019 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2019 Brendan Tildesley <mail@brendan.scot>
;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
+;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
;;;
(define-public perl-html-form
(package
(name "perl-html-form")
- (version "6.03")
+ (version "6.04")
(source
(origin
(method url-fetch)
- (uri (string-append "mirror://cpan/authors/id/G/GA/GAAS/"
+ (uri (string-append "mirror://cpan/authors/id/O/OA/OALDERS/"
"HTML-Form-" version ".tar.gz"))
(sha256
- (base32
- "0dpwr7yz6hjc3bcqgcbdzjjk9l58ycdjmbam9nfcmm85y2a1vh38"))))
+ (base32 "100090bdsr5kapv8h0wxzwlzfbfqn57rq9gzrvg9i6hvnsl5gmcw"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-html-parser" ,perl-html-parser)
(define-public python-internetarchive
(package
(name "python-internetarchive")
- (version "1.7.4")
+ (version "1.8.5")
(source
(origin
- (method url-fetch)
- (uri (string-append "https://github.com/jjjake/internetarchive/archive/"
- "v" version ".tar.gz"))
- (file-name (string-append name "-" version ".tar.gz"))
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/jjjake/internetarchive")
+ (commit (string-append "v" version))))
+ (file-name (git-file-name name version))
(sha256
(base32
- "0sdbb2ag6vmybi8zmbjszi492a587giaaqxyy1p6gy03cb8mc512"))))
+ "0ih7hplv92wbv6cmgc1gs0v35qkajwicalwcq8vcljw30plr24fp"))
+ (modules '((guix build utils)))
+ (snippet
+ '(begin
+ ;; Python 3.7 removed `_pattern_type'.
+ (for-each (lambda (file)
+ (chmod file #o644)
+ (substitute* file
+ (("^import re\n" line)
+ (string-append line "re._pattern_type = re.Pattern\n"))))
+ (find-files "." "\\.py$"))
+ #t))))
(build-system python-build-system)
(arguments
`(#:phases
HTTrack is fully configurable, and has an integrated help system.")
(license license:gpl3+)))
+
+(define-public anonip
+ (package
+ (name "anonip")
+ (version "1.0.0")
+ (source (origin
+ (method url-fetch)
+ (uri (pypi-uri "anonip" version))
+ (sha256
+ (base32
+ "0ckn9nnfhpdnz8b92q8pkysdqj6pdh71ckfqvfj0z01cq0hzbhd2"))))
+ (build-system python-build-system)
+ (home-page "https://github.com/DigitaleGesellschaft/Anonip")
+ (synopsis "Anonymize IP addresses in log files")
+ (description
+ "Anonip masks the last bits of IPv4 and IPv6 addresses in log files.
+That way most of the relevant information is preserved, while the IP address
+does not match a particular individuum anymore.
+
+Depending on your Web server, the log entries may be piped to Anonip directly
+or via a FIFO (named pipe). Thus the unmasked IP addresses will never be
+written to any file.
+
+It's also possible to rewrite existing log files.
+
+Anonip can also be uses as a Python module in your own Python application.")
+ (license license:bsd-3)))
(define-public wgetpaste
(package
(name "wgetpaste")
- (version "2.28")
+ (version "2.29")
(source
(origin
(method url-fetch)
version ".tar.bz2"))
(sha256
(base32
- "1hh9svyypqcvdg5mjxyyfzpdzhylhf7s7xq5dzglnm4injx3i3ak"))))
+ "1rp0wxr3zy7y2xp3azaadfghrx7g0m138f9qg6icjxkkz4vj9r22"))))
(build-system gnu-build-system)
(arguments
- '(#:modules ((guix build gnu-build-system)
+ `(#:modules ((guix build gnu-build-system)
(guix build utils)
(srfi srfi-1))
#:phases
;; https://gitweb.gentoo.org/repo/gentoo.git/tree/app-text/wgetpaste/files/wgetpaste-remove-dead.patch
(lambda _
(substitute* "wgetpaste"
- ((" poundpython\"") "\"")
- (("-poundpython") "-bpaste")) ; dpaste blocks tor users
+ (("-bpaste") "-dpaste")) ; dpaste blocks tor users
#t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
- (zsh (string-append out "/share/zsh/site-functions")))
+ (zsh (string-append out "/share/zsh/site-functions"))
+ (doc (string-append out "/share/doc/" ,name "-" ,version)))
(install-file "wgetpaste" bin)
(install-file "_wgetpaste" zsh)
+ (install-file "LICENSE" doc)
#t)))
(add-after 'install 'wrap-program
;; /bin/wgetpaste prides itself on relying only on the following
(define-public wine-staging-patchset-data
(package
(name "wine-staging-patchset-data")
- (version "4.11")
+ (version "4.12.1")
(source
(origin
(method git-fetch)
(file-name (git-file-name name version))
(sha256
(base32
- "0h8qldqr9w1kwn48qgg5m1cs2xqkv8xxg2c66cvfka91hy886jcf"))))
+ "1bvpvj6vcw2p6vcjm6mw5maarbs4lfw1ix3pj020w4n3kg4nmmc4"))))
(build-system trivial-build-system)
(native-inputs
`(("bash" ,bash)
(file-name (string-append name "-" version ".tar.xz"))
(sha256
(base32
- "1rmyfwlynzs2niz7l2lwjs2axm6in6gb43ldbzyzsflxsmk5fl9f"))))
+ "09yjfb2k14y11k19lm8dqmb8qwxyhh67d5q1gqv480y64mljvkx0"))))
(inputs `(("autoconf" ,autoconf) ; for autoreconf
("faudio" ,faudio)
("ffmpeg" ,ffmpeg)
--- /dev/null
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu packages wireservice)
+ #:use-module ((guix licenses) #:prefix license:)
+ #:use-module (guix build-system python)
+ #:use-module (guix download)
+ #:use-module (guix git-download)
+ #:use-module (guix packages)
+ #:use-module (gnu packages)
+ #:use-module (gnu packages check)
+ #:use-module (gnu packages databases)
+ #:use-module (gnu packages python-web)
+ #:use-module (gnu packages python-xyz)
+ #:use-module (gnu packages sphinx)
+ #:use-module (gnu packages time))
+
+;; Common package definition for packages from https://github.com/wireservice.
+(define-syntax-rule (wireservice-package extra-fields ...)
+ (package
+ (build-system python-build-system)
+ (arguments
+ `(#:phases
+ (modify-phases %standard-phases
+ (replace 'check
+ (lambda _
+ (invoke "nosetests" "tests")))
+ (add-after 'install 'install-docs
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (doc (string-append out "/share/doc/"
+ ,(package-name this-package)
+ "-"
+ ,(package-version this-package))))
+ (with-directory-excursion "docs"
+ (for-each
+ (lambda (target)
+ (invoke "make" target)
+ (copy-recursively (string-append "_build/" target)
+ (string-append doc "/" target)))
+ '("html" "dirhtml" "singlehtml" "text")))
+ #t))))))
+ (license license:expat)
+ extra-fields ...))
+
+(define-public python-leather
+ (wireservice-package
+ (name "python-leather")
+ (version "0.3.3")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/wireservice/leather.git")
+ (commit version)))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "1ck3dplni99sv4s117cbm07ydwwjsrxkhdy19rnk0iglia1d4s5i"))))
+ (native-inputs
+ `(("python-nose" ,python-nose)
+ ("python-sphinx" ,python-sphinx)
+ ("python-sphinx-rtd-theme" ,python-sphinx-rtd-theme)
+ ("python-csselect" ,python-cssselect)
+ ("python-lxml" ,python-lxml)))
+ (propagated-inputs
+ `(("python-six" ,python-six)))
+ (home-page "https://leather.rtfd.org")
+ (synopsis "Python charting for 80% of humans")
+ (description "Leather is a Python charting library for those who need
+charts now and don't care if they're perfect.")))
+
+(define-public python-agate
+ (wireservice-package
+ (name "python-agate")
+ (version "1.6.1")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/wireservice/agate.git")
+ (commit version)))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "077zj8xad8hsa3nqywvf7ircirmx3krxdipl8wr3dynv3l3khcpl"))))
+ (native-inputs
+ `(("python-nose" ,python-nose)
+ ("python-sphinx" ,python-sphinx)
+ ("python-sphinx-rtd-theme" ,python-sphinx-rtd-theme)
+ ("python-csselect" ,python-cssselect)
+ ("python-lxml" ,python-lxml)))
+ (propagated-inputs
+ `(("python-babel" ,python-babel)
+ ("python-isodate" ,python-isodate)
+ ("python-leather" ,python-leather)
+ ("python-parsedatetime" ,python-parsedatetime)
+ ("python-pytimeparse" ,python-pytimeparse)
+ ("python-six" ,python-six)
+ ("python-slugify" ,python-slugify)))
+ (home-page "https://agate.rtfd.org")
+ (synopsis "Data analysis library")
+ (description "Agate is a Python data analysis library. It is an
+alternative to numpy and pandas that solves real-world problems with readable
+code. Agate was previously known as journalism.")))
+
+(define-public python-agate-sql
+ (wireservice-package
+ (name "python-agate-sql")
+ (version "0.5.4")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/wireservice/agate-sql.git")
+ (commit version)))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "16q0b211n5b1qmhzkfl2jr56lda0rvyh5j1wzw26h2n4pm4wxlx2"))))
+ (native-inputs
+ `(("python-nose" ,python-nose)
+ ("python-sphinx" ,python-sphinx)
+ ("python-sphinx-rtd-theme" ,python-sphinx-rtd-theme)))
+ (propagated-inputs
+ `(("python-agate" ,python-agate)
+ ("python-crate" ,python-crate)
+ ("python-sqlalchemy" ,python-sqlalchemy)))
+ (home-page "https://agate-sql.rtfd.org")
+ (synopsis "SQL read/write support to agate")
+ (description "@code{agatesql} uses a monkey patching pattern to add SQL
+support to all @code{agate.Table} instances.")))
+
+(define-public python-agate-dbf
+ (wireservice-package
+ (name "python-agate-dbf")
+ (version "0.2.1")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/wireservice/agate-dbf.git")
+ (commit version)))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "1y49fi6pmm7gzhajvqmfpcca2sqnwj24fqnsvzwk7r1hg2iaa2gi"))))
+ (native-inputs
+ `(("python-nose" ,python-nose)
+ ("python-sphinx" ,python-sphinx)
+ ("python-sphinx-rtd-theme" ,python-sphinx-rtd-theme)))
+ (propagated-inputs
+ `(("python-agate" ,python-agate)
+ ("python-dbfread" ,python-dbfread)))
+ (home-page "https://agate-dbf.rtfd.org")
+ (synopsis "Add read support for dbf files to agate")
+ (description "@code{agatedbf} uses a monkey patching pattern to add read
+for dbf files support to all @code{agate.Table} instances.")))
+
+(define-public python-agate-excel
+ (wireservice-package
+ (name "python-agate-excel")
+ (version "0.2.3")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/wireservice/agate-excel.git")
+ (commit version)))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "1k5lv21k19s7kgbj5srd1xgrkqvxqqs49qwj33zncs9l7851afy7"))))
+ (native-inputs
+ `(("python-nose" ,python-nose)
+ ("python-sphinx" ,python-sphinx)
+ ("python-sphinx-rtd-theme" ,python-sphinx-rtd-theme)))
+ (propagated-inputs
+ `(("python-agate" ,python-agate)
+ ("python-openpyxl" ,python-openpyxl)
+ ("python-xlrd" ,python-xlrd)))
+ (home-page "https://agate-excel.rtfd.org")
+ (synopsis "Add read support for Excel files (xls and xlsx) to agate")
+ (description "@code{agateexcel} uses a monkey patching pattern to add read
+for xls and xlsx files support to all @code{agate.Table} instances.")))
+
+(define-public csvkit
+ (package
+ (name "csvkit")
+ (version "1.0.4")
+ (source (origin
+ (method url-fetch)
+ (uri (pypi-uri "csvkit" version))
+ (sha256
+ (base32
+ "1830lb95rh1iyi3drlwxzb6y3pqkii0qiyzd40c1kvhvaf1s6lqk"))
+ (patches (search-patches "csvkit-fix-tests.patch"))))
+ (build-system python-build-system)
+ (native-inputs
+ `(("python-psycopg2" ,python-psycopg2) ;; Used to test PostgreSQL support.
+ ("python-sphinx" ,python-sphinx)
+ ("python-sphinx-rtd-theme" ,python-sphinx-rtd-theme)))
+ (inputs
+ `(("python-agate-dbf" ,python-agate-dbf)
+ ("python-agate-excel" ,python-agate-excel)
+ ("python-agate-sql" ,python-agate-sql)
+ ("python-six" ,python-six)))
+ (arguments
+ `(#:phases
+ (modify-phases %standard-phases
+ (add-after 'install 'install-docs
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (man1 (string-append out "/share/man/man1")))
+ (with-directory-excursion "docs"
+ (invoke "make" "man")
+ (copy-recursively "_build/man" man1))
+ #t))))))
+ (home-page "https://csvkit.rtfd.org")
+ (synopsis "Command-line tools for working with CSV")
+ (description "csvkit is a suite of command-line tools for converting to
+and working with CSV. It provides the following commands:
+@itemize
+@item Input:
+ @itemize
+ @item @command{in2csv}: Convert various formats to CSV.
+ @item @command{sql2csv}: Execute SQL commands on a database and return the
+data as CSV.
+ @end itemize
+@item Processing:
+ @itemize
+ @item @command{csvclean}: Remove common syntax errors.
+ @item @command{csvcut}: Filter and truncate CSV files.
+ @item @command{csvgrep}: Filter tabular data to only those rows where
+certain columns contain a given value or match a regular expression.
+ @item @command{csvjoin}: Merges two or more CSV tables together using a
+method analogous to SQL JOIN operation.
+ @item @command{csvsort}: Sort CSV files.
+ @item @command{csvstack}: Stack up the rows from multiple CSV files,
+optionally adding a grouping value to each row.
+ @end itemize
+@item Output and analysis:
+ @itemize
+ @item @command{csvformat}: Convert a CSV file to a custom output format.
+ @item @command{csvjson}: Converts a CSV file into JSON or GeoJSON.
+ @item @command{csvlook}: Renders a CSV to the command line in a
+Markdown-compatible, fixed-width format.
+ @item @command{csvpy}: Loads a CSV file into a @code{agate.csv.Reader}
+object and then drops into a Python shell so the user can inspect the data
+however they see fit.
+ @item @command{csvsql}: Generate SQL statements for a CSV file or execute
+those statements directly on a database.
+ @item @command{csvstat}: Prints descriptive statistics for all columns in a
+CSV file.
+ @end itemize
+@end itemize")
+ (license license:expat)))
(license license:bsd-3)))
(define-public i3blocks
- (let ((commit "37f23805ff886639163fbef8aedba71c8071eff8")
- (revision "1"))
+ (let ((commit "ec050e79ad8489a6f8deb37d4c20ab10729c25c3")
+ (revision "2"))
(package
(name "i3blocks")
(version (string-append "1.4-" revision "."
(commit commit)))
(sha256
(base32
- "15rnrcajzyrmhlz1a21qqsjlj3dkib70806dlb386fliylc2kisb"))
+ "1fx4230lmqa5rpzph68dwnpcjfaaqv5gfkradcr85hd1z8d1qp1b"))
(file-name (git-file-name name version))))
(build-system gnu-build-system)
(arguments
(define-public xscreensaver
(package
(name "xscreensaver")
- (version "5.42")
+ (version "5.43")
(source
(origin
(method url-fetch)
(string-append "https://www.jwz.org/xscreensaver/xscreensaver-"
version ".tar.gz"))
(sha256
- (base32
- "1qfbsnj7201d03vf0b2lzxmlcq4kvkvzp48r5gcgsjr17c1sl7a4"))))
+ (base32 "1571pj1a9998sq14y9366s2rw9wd2kq3l3dvvsk610vyd0fki3qm"))))
(build-system gnu-build-system)
(arguments
- `(#:tests? #f ; no check target
+ `(#:tests? #f ; no check target
#:phases
(modify-phases %standard-phases
(add-before 'configure 'adjust-gtk-resource-paths
#t)))
#:configure-flags '("--with-pam" "--with-proc-interrupts"
"--without-readdisplay")
- ;; FIXME: Remove CFLAGS once our default compiler is GCC6 or later.
- #:make-flags (list "CFLAGS=-std=c99"
- (string-append "AD_DIR="
+ #:make-flags (list (string-append "AD_DIR="
(assoc-ref %outputs "out")
"/usr/lib/X11/app-defaults"))))
(native-inputs
;;; Copyright © 2017 Petter <petter@mykolab.ch>
;;; Copyright © 2017 Stefan Reichör <stefan@xsteve.at>
;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
+;;; Copyright © 2018 Jack Hill <jackhill@jackhill.us>
;;;
;;; This file is part of GNU Guix.
;;;
(package
(name "expat")
(version "2.2.7")
- (source (origin
- (method url-fetch)
- (uri (string-append "mirror://sourceforge/expat/expat/"
- version "/expat-" version ".tar.xz"))
- (sha256
- (base32
- "1y5yax6bq8p9xk49zqkd62pxk8bq266wrgbrqgaxp3wsrw5g9qrh"))))
+ (source (let ((dot->underscore (lambda (c) (if (char=? #\. c) #\_ c))))
+ (origin
+ (method url-fetch)
+ (uri (list (string-append "mirror://sourceforge/expat/expat/"
+ version "/expat-" version ".tar.xz")
+ (string-append
+ "https://github.com/libexpat/libexpat/releases/download/R_"
+ (string-map dot->underscore version)
+ "/expat-" version ".tar.xz")))
+ (sha256
+ (base32
+ "1y5yax6bq8p9xk49zqkd62pxk8bq266wrgbrqgaxp3wsrw5g9qrh")))))
(build-system gnu-build-system)
(home-page "https://libexpat.github.io/")
(synopsis "Stream-oriented XML parser library written in C")
things the parser might find in the XML document (like start tags).")
(license license:expat)))
+(define expat/fixed
+ (package
+ (inherit expat)
+ (source
+ (origin
+ (inherit (package-source expat))
+ (patches (search-patches "expat-CVE-2018-20843.patch"))))))
+
(define-public libebml
(package
(name "libebml")
(define-public perl-xml-compile
(package
(name "perl-xml-compile")
- (version "1.62")
+ (version "1.63")
(source (origin
(method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"XML-Compile-" version ".tar.gz"))
(sha256
(base32
- "0a75gr4qcjj8ybzljacbbkdxprbqpypz49bc0jb7cfamx1hp7p2w"))))
+ "0psr5pwsk2biz2bfkigmx04v2rfhs6ybwcfmcrrg7gvh9bpp222b"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-carp" ,perl-carp)
#: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)
marionette))
(test-equal "Load docker image and run it"
- '("hello world" "hi!")
+ '("hello world" "hi!" "JSON!")
(marionette-eval
`(begin
(define slurp
(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)
(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)
(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))
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 | \\
"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)))))
(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
(resolve-dependencies instances))
(define (instance->derivation instance)
- (mcached (if (eq? instance core-instance)
- (build-channel-instance instance)
- (mlet %store-monad ((core (instance->derivation core-instance))
- (deps (mapm %store-monad instance->derivation
- (edges instance))))
- (build-channel-instance instance core deps)))
- instance))
+ (mlet %store-monad ((system (current-system)))
+ (mcached (if (eq? instance core-instance)
+ (build-channel-instance instance)
+ (mlet %store-monad ((core (instance->derivation core-instance))
+ (deps (mapm %store-monad instance->derivation
+ (edges instance))))
+ (build-channel-instance instance core deps)))
+ instance
+ system)))
(unless core-instance
(let ((loc (and=> (any (compose channel-location channel-instance-channel)
(define (channel-instances->manifest instances)
"Return a profile manifest with entries for all of INSTANCES, a list of
channel instances."
- (define instance->entry
- (match-lambda
- ((instance drv)
- (let ((commit (channel-instance-commit instance))
- (channel (channel-instance-channel instance)))
- (with-monad %store-monad
- (return (manifest-entry
- (name (symbol->string (channel-name channel)))
- (version (string-take commit 7))
- (item (if (guix-channel? channel)
- (if (old-style-guix? drv)
- (whole-package-for-legacy
- (string-append name "-" version)
- drv)
- drv)
- drv))
- (properties
- `((source (repository
- (version 0)
- (url ,(channel-url channel))
- (branch ,(channel-branch channel))
- (commit ,commit))))))))))))
+ (define (instance->entry instance drv)
+ (let ((commit (channel-instance-commit instance))
+ (channel (channel-instance-channel instance)))
+ (manifest-entry
+ (name (symbol->string (channel-name channel)))
+ (version (string-take commit 7))
+ (item (if (guix-channel? channel)
+ (if (old-style-guix? drv)
+ (whole-package-for-legacy (string-append name "-" version)
+ drv)
+ drv)
+ drv))
+ (properties
+ `((source (repository
+ (version 0)
+ (url ,(channel-url channel))
+ (branch ,(channel-branch channel))
+ (commit ,commit))))))))
(mlet* %store-monad ((derivations (channel-instance-derivations instances))
- (entries (mapm %store-monad instance->entry
- (zip instances derivations))))
+ (entries -> (map instance->entry instances derivations)))
(return (manifest entries))))
(define (package-cache-file manifest)
(derivation-output-path (assoc-ref outputs sub-drv)))
sub-drvs))))
-(define* (substitution-oracle store drv
+(define* (substitution-oracle store inputs-or-drv
#:key (mode (build-mode normal)))
"Return a one-argument procedure that, when passed a store file name,
returns a 'substitutable?' if it's substitutable and #f otherwise.
-The returned procedure
-knows about all substitutes for all the derivations listed in DRV, *except*
-those that are already valid (that is, it won't bother checking whether an
-item is substitutable if it's already on disk); it also knows about their
-prerequisites, unless they are themselves substitutable.
+
+The returned procedure knows about all substitutes for all the derivation
+inputs or derivations listed in INPUTS-OR-DRV, *except* those that are already
+valid (that is, it won't bother checking whether an item is substitutable if
+it's already on disk); it also knows about their prerequisites, unless they
+are themselves substitutable.
Creating a single oracle (thus making a single 'substitutable-path-info' call) and
reusing it is much more efficient than calling 'has-substitutes?' or similar
repeatedly, because it avoids the costs associated with launching the
substituter many times."
- (define valid?
- (cut valid-path? store <>))
-
(define valid-input?
(cut valid-derivation-input? store <>))
- (define (dependencies drv)
- ;; Skip prerequisite sub-trees of DRV whose root is valid. This allows us
- ;; to ask the substituter for just as much as needed, instead of asking it
- ;; for the whole world, which can be significantly faster when substitute
- ;; info is not already in cache.
- ;; Also, skip derivations marked as non-substitutable.
- (append-map (lambda (input)
+ (define (closure inputs)
+ (let loop ((inputs inputs)
+ (closure '())
+ (visited (set)))
+ (match inputs
+ (()
+ (reverse closure))
+ ((input rest ...)
+ (let ((key (derivation-input-key input)))
+ (cond ((set-contains? visited key)
+ (loop rest closure visited))
+ ((valid-input? input)
+ (loop rest closure (set-insert key visited)))
+ (else
(let ((drv (derivation-input-derivation input)))
- (if (substitutable-derivation? drv)
- (derivation-input-output-paths input)
- '())))
- (derivation-prerequisites drv valid-input?)))
-
- (let* ((paths (delete-duplicates
- (concatenate
- (fold (lambda (drv result)
- (let ((self (match (derivation->output-paths drv)
- (((names . paths) ...)
- paths))))
- (cond ((eqv? mode (build-mode check))
- (cons (dependencies drv) result))
- ((not (substitutable-derivation? drv))
- (cons (dependencies drv) result))
- ((every valid? self)
- result)
- (else
- (cons* self (dependencies drv) result)))))
- '()
- drv))))
- (subst (fold (lambda (subst vhash)
- (vhash-cons (substitutable-path subst) subst
- vhash))
- vlist-null
- (substitutable-path-info store paths))))
+ (loop (append (derivation-inputs drv) rest)
+ (if (substitutable-derivation? drv)
+ (cons input closure)
+ closure)
+ (set-insert key visited))))))))))
+
+ (let* ((inputs (closure (map (match-lambda
+ ((? derivation-input? input)
+ input)
+ ((? derivation? drv)
+ (derivation-input drv)))
+ inputs-or-drv)))
+ (items (append-map derivation-input-output-paths inputs))
+ (subst (fold (lambda (subst vhash)
+ (vhash-cons (substitutable-path subst) subst
+ vhash))
+ vlist-null
+ (substitutable-path-info store items))))
(lambda (item)
(match (vhash-assoc item subst)
(#f #f)
((key . value) value)))))
+(define (dependencies-of-substitutables substitutables inputs)
+ "Return the subset of INPUTS whose output file names is among the references
+of SUBSTITUTABLES."
+ (let ((items (fold set-insert (set)
+ (append-map substitutable-references substitutables))))
+ (filter (lambda (input)
+ (any (cut set-contains? items <>)
+ (derivation-input-output-paths input)))
+ inputs)))
+
(define* (derivation-build-plan store inputs
#:key
(mode (build-mode normal))
(substitutable-info
(substitution-oracle
- store
- (map derivation-input-derivation
- inputs)
- #:mode mode)))
+ store inputs #:mode mode)))
"Given INPUTS, a list of derivation-inputs, return two values: the list of
derivation to build, and the list of substitutable items that, together,
allows INPUTS to be realized.
(()
(values build substitute))
((input rest ...)
- (let ((key (derivation-input-key input)))
+ (let ((key (derivation-input-key input))
+ (deps (derivation-inputs
+ (derivation-input-derivation input))))
(cond ((set-contains? visited key)
(loop rest build substitute visited))
((input-built? input)
((input-substitutable-info input)
=>
(lambda (substitutables)
- (loop rest build
+ (loop (append (dependencies-of-substitutables substitutables
+ deps)
+ rest)
+ build
(append substitutables substitute)
(set-insert key visited))))
(else
- (let ((deps (derivation-inputs
- (derivation-input-derivation input))))
- (loop (append deps rest)
- (cons (derivation-input-derivation input) build)
- substitute
- (set-insert key visited))))))))))
+ (loop (append deps rest)
+ (cons (derivation-input-derivation input) build)
+ substitute
+ (set-insert key visited)))))))))
(define-deprecated (derivation-prerequisites-to-build store drv #:rest rest)
derivation-build-plan
((= stat:type 'directory)
(append (scheme-files absolute)
result))
- (_ result)))))
+ (_ result)))
+ (else
+ result)))
(else
result))))))
'()
`((,(generate-tag path) . ((latest . ,id)))))
;; See https://github.com/opencontainers/image-spec/blob/master/config.md
-(define* (config layer time arch #:key entry-point)
+(define* (config layer time arch #:key entry-point (environment '()))
"Generate a minimal image configuration for the given LAYER file."
;; "architecture" must be values matching "platform.arch" in the
;; runtime-spec at
`((architecture . ,arch)
(comment . "Generated by GNU Guix")
(created . ,time)
- (config . ,(if entry-point
- `((entrypoint . ,entry-point))
- #nil))
+ (config . ,`((env . ,(map (match-lambda
+ ((name . value)
+ (string-append name "=" value)))
+ environment))
+ ,@(if entry-point
+ `((entrypoint . ,entry-point))
+ '())))
(container_config . #nil)
(os . "linux")
(rootfs . ((type . "layers")
(system (utsname:machine (uname)))
database
entry-point
+ (environment '())
compressor
(creation-time (current-time time-utc)))
"Write to IMAGE a Docker image archive containing the given PATHS. PREFIX
When ENTRY-POINT is true, it must be a list of strings; it is stored as the
entry point in the Docker image JSON structure.
+ENVIRONMENT must be a list of name/value pairs. It specifies the environment
+variables that must be defined in the resulting image.
+
SYMLINKS must be a list of (SOURCE -> TARGET) tuples describing symlinks to be
created in the image, where each TARGET is relative to PREFIX.
TRANSFORMATIONS must be a list of (OLD -> NEW) tuples describing how to
(lambda ()
(scm->json (config (string-append id "/layer.tar")
time arch
+ #:environment environment
#:entry-point entry-point))))
(with-output-to-file "manifest.json"
(lambda ()
gexp-input
gexp-input?
+ gexp-input-thing
+ gexp-input-output
+ gexp-input-native?
local-file
local-file?
load-path-expression
gexp-modules
+ lower-gexp
+ lowered-gexp?
+ lowered-gexp-sexp
+ lowered-gexp-inputs
+ lowered-gexp-guile
+ lowered-gexp-load-path
+ lowered-gexp-load-compiled-path
+
gexp->derivation
gexp->file
gexp->script
"Turn any package from INPUTS into a derivation for SYSTEM; return the
corresponding input list as a monadic value. When TARGET is true, use it as
the cross-compilation target triplet."
+ (define (store-item? obj)
+ (and (string? obj) (store-path? obj)))
+
(with-monad %store-monad
(mapm %store-monad
(match-lambda
(((? struct? thing) sub-drv ...)
(mlet %store-monad ((drv (lower-object
thing system #:target target)))
- (return `(,drv ,@sub-drv))))
+ (return (apply gexp-input drv sub-drv))))
+ (((? store-item? item))
+ (return (gexp-input item)))
(input
- (return input)))
+ (return (gexp-input input))))
inputs)))
(define* (lower-reference-graphs graphs #:key system target)
(mlet %store-monad ((inputs (lower-inputs inputs
#:system system
#:target target)))
- (return (map cons file-names inputs))))))
+ (return (map (lambda (file input)
+ (cons file (gexp-input->tuple input)))
+ file-names inputs))))))
(define* (lower-references lst #:key system target)
"Based on LST, a list of output names and packages, return a list of output
(lambda (system)
((force proc) system))))
+;; Representation of a gexp instantiated for a given target and system.
+(define-record-type <lowered-gexp>
+ (lowered-gexp sexp inputs guile load-path load-compiled-path)
+ lowered-gexp?
+ (sexp lowered-gexp-sexp) ;sexp
+ (inputs lowered-gexp-inputs) ;list of <gexp-input>
+ (guile lowered-gexp-guile) ;<derivation> | #f
+ (load-path lowered-gexp-load-path) ;list of store items
+ (load-compiled-path lowered-gexp-load-compiled-path)) ;list of store items
+
+(define* (lower-gexp exp
+ #:key
+ (module-path %load-path)
+ (system (%current-system))
+ (target 'current)
+ (graft? (%graft?))
+ (guile-for-build (%guile-for-build))
+ (effective-version "2.2")
+
+ deprecation-warnings)
+ "*Note: This API is subject to change; use at your own risk!*
+
+Lower EXP, a gexp, instantiating it for SYSTEM and TARGET. Return a
+<lowered-gexp> ready to be used.
+
+Lowered gexps are an intermediate representation that's useful for
+applications that deal with gexps outside in a way that is disconnected from
+derivations--e.g., code evaluated for its side effects."
+ (define %modules
+ (delete-duplicates (gexp-modules exp)))
+
+ (define (search-path modules extensions suffix)
+ (append (match modules
+ ((? derivation? drv)
+ (list (derivation->output-path drv)))
+ (#f
+ '())
+ ((? store-path? item)
+ (list item)))
+ (map (lambda (extension)
+ (string-append (match extension
+ ((? derivation? drv)
+ (derivation->output-path drv))
+ ((? store-path? item)
+ item))
+ suffix))
+ extensions)))
+
+ (mlet* %store-monad ( ;; The following binding forces '%current-system' and
+ ;; '%current-target-system' to be looked up at >>=
+ ;; time.
+ (graft? (set-grafting graft?))
+
+ (system -> (or system (%current-system)))
+ (target -> (if (eq? target 'current)
+ (%current-target-system)
+ target))
+ (guile (if guile-for-build
+ (return guile-for-build)
+ (default-guile-derivation system)))
+ (normals (lower-inputs (gexp-inputs exp)
+ #:system system
+ #:target target))
+ (natives (lower-inputs (gexp-native-inputs exp)
+ #:system system
+ #:target #f))
+ (inputs -> (append normals natives))
+ (sexp (gexp->sexp exp
+ #:system system
+ #:target target))
+ (extensions -> (gexp-extensions exp))
+ (exts (mapm %store-monad
+ (lambda (obj)
+ (lower-object obj system))
+ extensions))
+ (modules (if (pair? %modules)
+ (imported-modules %modules
+ #:system system
+ #:module-path module-path)
+ (return #f)))
+ (compiled (if (pair? %modules)
+ (compiled-modules %modules
+ #:system system
+ #:module-path module-path
+ #:extensions extensions
+ #:guile guile
+ #:deprecation-warnings
+ deprecation-warnings)
+ (return #f))))
+ (define load-path
+ (search-path modules exts
+ (string-append "/share/guile/site/" effective-version)))
+
+ (define load-compiled-path
+ (search-path compiled exts
+ (string-append "/lib/guile/" effective-version
+ "/site-ccache")))
+
+ (mbegin %store-monad
+ (set-grafting graft?) ;restore the initial setting
+ (return (lowered-gexp sexp
+ `(,@(if modules
+ (list (gexp-input modules))
+ '())
+ ,@(if compiled
+ (list (gexp-input compiled))
+ '())
+ ,@(map gexp-input exts)
+ ,@inputs)
+ guile
+ load-path
+ load-compiled-path)))))
+
+(define (gexp-input->tuple input)
+ "Given INPUT, a <gexp-input> record, return the corresponding input tuple
+suitable for the 'derivation' procedure."
+ (match (gexp-input-output input)
+ ("out" `(,(gexp-input-thing input)))
+ (output `(,(gexp-input-thing input)
+ ,(gexp-input-output input)))))
+
(define* (gexp->derivation name exp
#:key
system (target 'current)
compiling modules. It can be #f, #t, or 'detailed.
The other arguments are as for 'derivation'."
- (define %modules
- (delete-duplicates
- (append modules (gexp-modules exp))))
(define outputs (gexp-outputs exp))
+ (define requested-graft? graft?)
(define (graphs-file-names graphs)
;; Return a list of (FILE-NAME . STORE-PATH) pairs made from GRAPHS.
(cons file-name thing)))
graphs))
- (define (extension-flags extension)
- `("-L" ,(string-append (derivation->output-path extension)
- "/share/guile/site/" effective-version)
- "-C" ,(string-append (derivation->output-path extension)
- "/lib/guile/" effective-version "/site-ccache")))
+ (define (add-modules exp modules)
+ (if (null? modules)
+ exp
+ (make-gexp (gexp-references exp)
+ (append modules (gexp-self-modules exp))
+ (gexp-self-extensions exp)
+ (gexp-proc exp))))
(mlet* %store-monad ( ;; The following binding forces '%current-system' and
;; '%current-target-system' to be looked up at >>=
(target -> (if (eq? target 'current)
(%current-target-system)
target))
- (normals (lower-inputs (gexp-inputs exp)
- #:system system
- #:target target))
- (natives (lower-inputs (gexp-native-inputs exp)
- #:system system
- #:target #f))
- (inputs -> (append normals natives))
- (sexp (gexp->sexp exp
- #:system system
- #:target target))
- (builder (text-file script-name
- (object->string sexp)))
- (extensions -> (gexp-extensions exp))
- (exts (mapm %store-monad
- (lambda (obj)
- (lower-object obj system))
- extensions))
- (modules (if (pair? %modules)
- (imported-modules %modules
- #:system system
- #:module-path module-path
- #:guile guile-for-build)
- (return #f)))
- (compiled (if (pair? %modules)
- (compiled-modules %modules
- #:system system
- #:module-path module-path
- #:extensions extensions
- #:guile guile-for-build
- #:deprecation-warnings
- deprecation-warnings)
- (return #f)))
+ (exp -> (add-modules exp modules))
+ (lowered (lower-gexp exp
+ #:module-path module-path
+ #:system system
+ #:target target
+ #:graft? requested-graft?
+ #:guile-for-build
+ guile-for-build
+ #:effective-version
+ effective-version
+ #:deprecation-warnings
+ deprecation-warnings))
+
(graphs (if references-graphs
(lower-reference-graphs references-graphs
#:system system
#:system system
#:target target)
(return #f)))
- (guile (if guile-for-build
- (return guile-for-build)
- (default-guile-derivation system))))
+ (guile -> (lowered-gexp-guile lowered))
+ (builder (text-file script-name
+ (object->string
+ (lowered-gexp-sexp lowered)))))
(mbegin %store-monad
(set-grafting graft?) ;restore the initial setting
(raw-derivation name
(string-append (derivation->output-path guile)
"/bin/guile")
`("--no-auto-compile"
- ,@(if (pair? %modules)
- `("-L" ,(if (derivation? modules)
- (derivation->output-path modules)
- modules)
- "-C" ,(derivation->output-path compiled))
- '())
- ,@(append-map extension-flags exts)
+ ,@(append-map (lambda (directory)
+ `("-L" ,directory))
+ (lowered-gexp-load-path lowered))
+ ,@(append-map (lambda (directory)
+ `("-C" ,directory))
+ (lowered-gexp-load-compiled-path lowered))
,builder)
#:outputs outputs
#:env-vars env-vars
#:system system
#:inputs `((,guile)
(,builder)
- ,@(if modules
- `((,modules) (,compiled) ,@inputs)
- inputs)
- ,@(map list exts)
+ ,@(map gexp-input->tuple
+ (lowered-gexp-inputs lowered))
,@(match graphs
(((_ . inputs) ...) inputs)
(_ '())))
(define* (gexp-inputs exp #:key native?)
"Return the input list for EXP. When NATIVE? is true, return only native
references; otherwise, return only non-native references."
+ ;; TODO: Return <gexp-input> records instead of tuples.
(define (add-reference-inputs ref result)
(match ref
(($ <gexp-input> (? gexp? exp) _ #t)
inferior-eval
inferior-eval-with-store
inferior-object?
+ read-repl-response
inferior-packages
inferior-available-packages
(set-record-type-printer! <inferior-object> write-inferior-object)
-(define (read-inferior-response inferior)
+(define (read-repl-response port)
+ "Read a (guix repl) response from PORT and return it as a Scheme object."
(define sexp->object
(match-lambda
(('value value)
(('non-self-quoting address string)
(inferior-object address string))))
- (match (read (inferior-socket inferior))
+ (match (read port)
(('values objects ...)
(apply values (map sexp->object objects)))
(('exception key objects ...)
(apply throw key (map sexp->object objects)))))
+(define (read-inferior-response inferior)
+ (read-repl-response (inferior-socket inferior)))
+
(define (send-inferior-request exp inferior)
(write exp (inferior-socket inferior))
(newline (inferior-socket inferior)))
--- /dev/null
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix remote)
+ #:use-module (guix ssh)
+ #:use-module (guix gexp)
+ #:use-module (guix inferior)
+ #:use-module (guix store)
+ #:use-module (guix monads)
+ #:use-module (guix modules)
+ #:use-module (guix derivations)
+ #:use-module (ssh popen)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
+ #:export (remote-eval))
+
+;;; Commentary:
+;;;
+;;; Note: This API is experimental and subject to change!
+;;;
+;;; Evaluate a gexp on a remote machine, over SSH, ensuring that all the
+;;; elements the gexp refers to are deployed beforehand. This is useful for
+;;; expressions that have side effects; for pure expressions, you would rather
+;;; build a derivation remotely or offload it.
+;;;
+;;; Code:
+
+(define (remote-pipe-for-gexp lowered session)
+ "Return a remote pipe for the given SESSION to evaluate LOWERED."
+ (define shell-quote
+ (compose object->string object->string))
+
+ (apply open-remote-pipe* session OPEN_READ
+ (string-append (derivation->output-path
+ (lowered-gexp-guile lowered))
+ "/bin/guile")
+ "--no-auto-compile"
+ (append (append-map (lambda (directory)
+ `("-L" ,directory))
+ (lowered-gexp-load-path lowered))
+ (append-map (lambda (directory)
+ `("-C" ,directory))
+ (lowered-gexp-load-path lowered))
+ `("-c"
+ ,(shell-quote (lowered-gexp-sexp lowered))))))
+
+(define (%remote-eval lowered session)
+ "Evaluate LOWERED, a lowered gexp, in SESSION. This assumes that all the
+prerequisites of EXP are already available on the host at SESSION."
+ (let* ((pipe (remote-pipe-for-gexp lowered session))
+ (result (read-repl-response pipe)))
+ (close-port pipe)
+ result))
+
+(define (trampoline exp)
+ "Return a \"trampoline\" gexp that evaluates EXP and writes the evaluation
+result to the current output port using the (guix repl) protocol."
+ (define program
+ (scheme-file "remote-exp.scm" exp))
+
+ (with-imported-modules (source-module-closure '((guix repl)))
+ #~(begin
+ (use-modules (guix repl))
+ (send-repl-response '(primitive-load #$program)
+ (current-output-port))
+ (force-output))))
+
+(define* (remote-eval exp session
+ #:key
+ (build-locally? #t)
+ (module-path %load-path)
+ (socket-name "/var/guix/daemon-socket/socket"))
+ "Evaluate EXP, a gexp, on the host at SESSION, an SSH session. Ensure that
+all the elements EXP refers to are built and deployed to SESSION beforehand.
+When BUILD-LOCALLY? is true, said dependencies are built locally and sent to
+the remote store afterwards; otherwise, dependencies are built directly on the
+remote store."
+ (mlet %store-monad ((lowered (lower-gexp (trampoline exp)
+ #:module-path %load-path))
+ (remote -> (connect-to-remote-daemon session
+ socket-name)))
+ (define inputs
+ (cons (gexp-input (lowered-gexp-guile lowered))
+ (lowered-gexp-inputs lowered)))
+
+ (define to-build
+ (map (lambda (input)
+ (if (derivation? (gexp-input-thing input))
+ (cons (gexp-input-thing input)
+ (gexp-input-output input))
+ (gexp-input-thing input)))
+ inputs))
+
+ (if build-locally?
+ (let ((to-send (map (lambda (input)
+ (match (gexp-input-thing input)
+ ((? derivation? drv)
+ (derivation->output-path
+ drv (gexp-input-output input)))
+ ((? store-path? item)
+ item)))
+ inputs)))
+ (mbegin %store-monad
+ (built-derivations to-build)
+ ((store-lift send-files) to-send remote #:recursive? #t)
+ (return (close-connection remote))
+ (return (%remote-eval lowered session))))
+ (let ((to-send (map (lambda (input)
+ (match (gexp-input-thing input)
+ ((? derivation? drv)
+ (derivation-file-name drv))
+ ((? store-path? item)
+ item)))
+ inputs)))
+ (mbegin %store-monad
+ ((store-lift send-files) to-send remote #:recursive? #t)
+ (return (build-derivations remote to-build))
+ (return (close-connection remote))
+ (return (%remote-eval lowered session)))))))
--- /dev/null
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix repl)
+ #:use-module (rnrs bytevectors)
+ #:use-module (ice-9 match)
+ #:export (send-repl-response
+ machine-repl))
+
+;;; Commentary:
+;;;
+;;; This module implements the "machine-readable" REPL provided by
+;;; 'guix repl -t machine'. It's a lightweight module meant to be
+;;; embedded in any Guile process providing REPL functionality.
+;;;
+;;; Code:
+
+(define (self-quoting? x)
+ "Return #t if X is self-quoting."
+ (letrec-syntax ((one-of (syntax-rules ()
+ ((_) #f)
+ ((_ pred rest ...)
+ (or (pred x)
+ (one-of rest ...))))))
+ (one-of symbol? string? pair? null? vector?
+ bytevector? number? boolean?)))
+
+
+(define (send-repl-response exp output)
+ "Write the response corresponding to the evaluation of EXP to PORT, an
+output port."
+ (define (value->sexp value)
+ (if (self-quoting? value)
+ `(value ,value)
+ `(non-self-quoting ,(object-address value)
+ ,(object->string value))))
+
+ (catch #t
+ (lambda ()
+ (let ((results (call-with-values
+ (lambda ()
+ (primitive-eval exp))
+ list)))
+ (write `(values ,@(map value->sexp results))
+ output)
+ (newline output)
+ (force-output output)))
+ (lambda (key . args)
+ (write `(exception ,key ,@(map value->sexp args)))
+ (newline output)
+ (force-output output))))
+
+(define* (machine-repl #:optional
+ (input (current-input-port))
+ (output (current-output-port)))
+ "Run a machine-usable REPL over ports INPUT and OUTPUT.
+
+The protocol of this REPL is meant to be machine-readable and provides proper
+support to represent multiple-value returns, exceptions, objects that lack a
+read syntax, and so on. As such it is more convenient and robust than parsing
+Guile's REPL prompt."
+ (write `(repl-version 0 0) output)
+ (newline output)
+ (force-output output)
+
+ (let loop ()
+ (match (read input)
+ ((? eof-object?) #t)
+ (exp
+ (send-repl-response exp output)
+ (loop)))))
--- /dev/null
+;;; 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 (guix scripts deploy)
+ #:use-module (gnu machine)
+ #:use-module (guix scripts)
+ #:use-module (guix scripts build)
+ #:use-module (guix store)
+ #:use-module (guix ui)
+ #:use-module (ice-9 format)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-37)
+ #:export (guix-deploy))
+
+;;; Commentary:
+;;;
+;;; This program provides a command-line interface to (gnu machine), allowing
+;;; users to perform remote deployments through specification files.
+;;;
+;;; Code:
+
+\f
+
+(define (show-help)
+ (display (G_ "Usage: guix deploy [OPTION] FILE...
+Perform the deployment specified by FILE.\n"))
+ (show-build-options-help)
+ (newline)
+ (display (G_ "
+ -h, --help display this help and exit"))
+ (display (G_ "
+ -V, --version display version information and exit"))
+ (newline)
+ (show-bug-report-information))
+
+(define %options
+ (cons* (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ %standard-build-options))
+
+(define %default-options
+ '((system . ,(%current-system))
+ (substitutes? . #t)
+ (build-hook? . #t)
+ (graft? . #t)
+ (debug . 0)
+ (verbosity . 1)))
+
+(define (load-source-file file)
+ "Load FILE as a user module."
+ (let ((module (make-user-module '((gnu) (gnu machine) (gnu machine ssh)))))
+ (load* file module)))
+
+(define (guix-deploy . args)
+ (define (handle-argument arg result)
+ (alist-cons 'file arg result))
+ (let* ((opts (parse-command-line args %options (list %default-options)
+ #:argument-handler handle-argument))
+ (file (assq-ref opts 'file))
+ (machines (or (and file (load-source-file file)) '())))
+ (with-store store
+ (set-build-options-from-command-line store opts)
+ (for-each (lambda (machine)
+ (info (G_ "deploying to ~a...") (machine-display-name machine))
+ (run-with-store store (deploy-machine machine)))
+ machines))))
-u, --user=USER instead of copying the name and home of the current
user into an isolated container, use the name USER
with home directory /home/USER"))
+ (display (G_ "
+ --no-cwd do not share current working directory with an
+ isolated container"))
+
(display (G_ "
--share=SPEC for containers, share writable host file system
according to SPEC"))
(lambda (opt name arg result)
(alist-cons 'user arg
(alist-delete 'user result eq?))))
+ (option '("no-cwd") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'no-cwd? #t result)))
(option '("share") #t #f
(lambda (opt name arg result)
(alist-cons 'file-system-mapping
((_ . status) status)))))
(define* (launch-environment/container #:key command bash user user-mappings
- profile manifest link-profile? network?)
+ profile manifest link-profile? network?
+ map-cwd?)
"Run COMMAND within a container that features the software in PROFILE.
Environment variables are set according to the search paths of MANIFEST.
The global shell is BASH, a file name for a GNU Bash binary in the
;; /bin/sh, the current working directory, and possibly networking
;; configuration files within the container.
(mappings
- (override-user-mappings
- user home
- (append user-mappings
- ;; Current working directory.
- (list (file-system-mapping
- (source cwd)
- (target cwd)
- (writable? #t)))
- ;; When in Rome, do as Nix build.cc does: Automagically
- ;; map common network configuration files.
- (if network?
- %network-file-mappings
- '())
- ;; Mappings for the union closure of all inputs.
- (map (lambda (dir)
- (file-system-mapping
- (source dir)
- (target dir)
- (writable? #f)))
- reqs))))
+ (append
+ (override-user-mappings
+ user home
+ (append user-mappings
+ ;; Share current working directory, unless asked not to.
+ (if map-cwd?
+ (list (file-system-mapping
+ (source cwd)
+ (target cwd)
+ (writable? #t)))
+ '())))
+ ;; When in Rome, do as Nix build.cc does: Automagically
+ ;; map common network configuration files.
+ (if network?
+ %network-file-mappings
+ '())
+ ;; Mappings for the union closure of all inputs.
+ (map (lambda (dir)
+ (file-system-mapping
+ (source dir)
+ (target dir)
+ (writable? #f)))
+ reqs)))
(file-systems (append %container-file-systems
(map file-system-mapping->bind-mount
mappings))))
(write-group groups)
;; For convenience, start in the user's current working
- ;; directory rather than the root directory.
- (chdir (override-user-dir user home cwd))
+ ;; directory or, if unmapped, the home directory.
+ (chdir (if map-cwd?
+ (override-user-dir user home cwd)
+ home-dir))
(primitive-exit/status
;; A container's environment is already purified, so no need to
(container? (assoc-ref opts 'container?))
(link-prof? (assoc-ref opts 'link-profile?))
(network? (assoc-ref opts 'network?))
+ (no-cwd? (assoc-ref opts 'no-cwd?))
(user (assoc-ref opts 'user))
(bootstrap? (assoc-ref opts 'bootstrap?))
(system (assoc-ref opts 'system))
(leave (G_ "'--link-profile' cannot be used without '--container'~%")))
(when (and (not container?) user)
(leave (G_ "'--user' cannot be used without '--container'~%")))
+ (when (and (not container?) no-cwd?)
+ (leave (G_ "--no-cwd cannot be used without --container~%")))
+
(with-store store
(with-status-verbosity (assoc-ref opts 'verbosity)
#:profile profile
#:manifest manifest
#:link-profile? link-prof?
- #:network? network?)))
+ #:network? network?
+ #:map-cwd? (not no-cwd?))))
+
(else
(return
(exit/status
'()))))
(define (delete-old-generations store profile pattern)
- "Remove the generations of PROFILE that match PATTERN, a duration pattern.
-Do nothing if none matches."
+ "Remove the generations of PROFILE that match PATTERN, a duration pattern;
+do nothing if none matches. If PATTERN is #f, delete all generations but the
+current one."
(let* ((current (generation-number profile))
- (numbers (matching-generations pattern profile
- #:duration-relation >)))
+ (numbers (if (not pattern)
+ (profile-generations profile)
+ (matching-generations pattern profile
+ #:duration-relation >))))
;; Make sure we don't inadvertently remove the current generation.
(delete-generations store profile (delv current numbers))))
(when (and arg (not (string->duration arg)))
(leave (G_ "~s does not denote a duration~%")
arg))
- (alist-cons 'delete-generations (or arg "")
- result)))))
+ (alist-cons 'delete-generations arg result)))))
(option '("optimize") #f #f
(lambda (opt name arg result)
(alist-cons 'action 'optimize
(assert-no-extra-arguments)
(let ((min-freed (assoc-ref opts 'min-freed))
(free-space (assoc-ref opts 'free-space)))
- (match (assoc-ref opts 'delete-generations)
+ (match (assq 'delete-generations opts)
(#f #t)
- ((? string? pattern)
+ ((_ . pattern)
(delete-generations store pattern)))
(cond
(free-space
#:use-module (guix utils)
#:use-module (guix store)
#:use-module ((guix status) #:select (with-status-verbosity))
+ #:use-module ((guix self) #:select (make-config.scm))
#:use-module (guix grafts)
#:autoload (guix inferior) (inferior-package?)
#:use-module (guix monads)
build
#:references-graphs `(("profile" ,profile))))
+(define (singularity-environment-file profile)
+ "Return a shell script that defines the environment variables corresponding
+to the search paths of PROFILE."
+ (define build
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules `(((guix config) => ,(make-config.scm))
+ ,@(source-module-closure
+ `((guix profiles)
+ (guix search-paths))
+ #:select? not-config?))
+ #~(begin
+ (use-modules (guix profiles) (guix search-paths)
+ (ice-9 match))
+
+ (call-with-output-file #$output
+ (lambda (port)
+ (for-each (match-lambda
+ ((spec . value)
+ (format port "~a=~a~%export ~a~%"
+ (search-path-specification-variable spec)
+ value
+ (search-path-specification-variable spec))))
+ (profile-search-paths #$profile))))))))
+
+ (computed-file "singularity-environment.sh" build))
+
(define* (squashfs-image name profile
#:key target
(profile-name "guix-profile")
(file-append (store-database (list profile))
"/db/db.sqlite")))
+ (define environment
+ (singularity-environment-file profile))
+
(define build
(with-imported-modules (source-module-closure
'((guix build utils)
`(,@(map store-info-item
(call-with-input-file "profile"
read-reference-graph))
+ #$environment
,#$output
;; Do not perform duplicate checking because we
target)))))))
'#$symlinks)
+ "-p" "/.singularity.d d 555 0 0"
+
+ ;; Create the environment file.
+ "-p" "/.singularity.d/env d 555 0 0"
+ "-p" ,(string-append
+ "/.singularity.d/env/90-environment.sh s 777 0 0 "
+ (relative-file-name "/.singularity.d/env"
+ #$environment))
+
;; Create /.singularity.d/actions, and optionally the 'run'
;; script, used by 'singularity run'.
- "-p" "/.singularity.d d 555 0 0"
"-p" "/.singularity.d/actions d 555 0 0"
+
,@(if entry-point
`(;; This one if for Singularity 2.x.
"-p"
(define build
;; Guile-JSON and Guile-Gcrypt are required by (guix docker).
(with-extensions (list guile-json guile-gcrypt)
- (with-imported-modules (source-module-closure '((guix docker)
- (guix build store-copy))
- #:select? not-config?)
+ (with-imported-modules `(((guix config) => ,(make-config.scm))
+ ,@(source-module-closure
+ `((guix docker)
+ (guix build store-copy)
+ (guix profiles)
+ (guix search-paths))
+ #:select? not-config?))
#~(begin
- (use-modules (guix docker) (srfi srfi-19) (guix build store-copy))
+ (use-modules (guix docker) (guix build store-copy)
+ (guix profiles) (guix search-paths)
+ (srfi srfi-19) (ice-9 match))
+
+ (define environment
+ (map (match-lambda
+ ((spec . value)
+ (cons (search-path-specification-variable spec)
+ value)))
+ (profile-search-paths #$profile)))
(setenv "PATH" (string-append #$archiver "/bin"))
#$profile
#:database #+database
#:system (or #$target (utsname:machine (uname)))
+ #:environment environment
#:entry-point #$(and entry-point
#~(string-append #$profile "/"
#$entry-point))
(cond ((not (file-exists? profile)) ; XXX: race condition
(raise (condition (&profile-not-found-error
(profile profile)))))
- ((string-null? pattern)
+ ((not pattern)
(delete-generations store profile
(delv current (profile-generations profile))))
;; Do not delete the zeroth generation.
(let ((numbers (delv current numbers)))
(when (null-list? numbers)
(leave (G_ "no matching generation~%")))
- (delete-generations store profile numbers))))
- (else
- (leave (G_ "invalid syntax: ~a~%") pattern)))))
+ (delete-generations store profile numbers)))))))
(define* (build-and-use-profile store profile manifest
#:key
arg-handler)))
(option '(#\l "list-generations") #f #t
(lambda (opt name arg result arg-handler)
- (values (cons `(query list-generations ,(or arg ""))
+ (values (cons `(query list-generations ,arg)
result)
#f)))
(option '(#\d "delete-generations") #f #t
(lambda (opt name arg result arg-handler)
- (values (alist-cons 'delete-generations (or arg "")
+ (values (alist-cons 'delete-generations arg
result)
#f)))
(option '(#\S "switch-generation") #t #f
(cond ((not (file-exists? profile)) ; XXX: race condition
(raise (condition (&profile-not-found-error
(profile profile)))))
- ((string-null? pattern)
+ ((not pattern)
(match (profile-generations profile)
(()
#t)
(exit 1)
(begin
(list-generation display-profile-content (car numbers))
- (diff-profiles profile numbers)))))
- (else
- (leave (G_ "invalid syntax: ~a~%")
- pattern))))
+ (diff-profiles profile numbers)))))))
#t)
(('list-installed regexp)
(alist-cons 'channel-file arg result)))
(option '(#\l "list-generations") #f #t
(lambda (opt name arg result)
- (cons `(query list-generations ,(or arg ""))
+ (cons `(query list-generations ,arg)
result)))
(option '(#\N "news") #f #f
(lambda (opt name arg result)
(cond ((not (file-exists? profile)) ; XXX: race condition
(raise (condition (&profile-not-found-error
(profile profile)))))
- ((string-null? pattern)
+ ((not pattern)
(list-generations profile (profile-generations profile)))
((matching-generations pattern profile)
=>
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
(define-module (guix scripts repl)
#:use-module (guix ui)
#:use-module (guix scripts)
+ #:use-module (guix repl)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (gnu packages)
#:autoload (system repl repl) (start-repl)
#:autoload (system repl server)
(make-tcp-server-socket make-unix-domain-server-socket)
- #:export (machine-repl
- guix-repl))
+ #:export (guix-repl))
;;; Commentary:
;;;
(newline)
(show-bug-report-information))
-(define (self-quoting? x)
- "Return #t if X is self-quoting."
- (letrec-syntax ((one-of (syntax-rules ()
- ((_) #f)
- ((_ pred rest ...)
- (or (pred x)
- (one-of rest ...))))))
- (one-of symbol? string? pair? null? vector?
- bytevector? number? boolean?)))
-
(define user-module
;; Module where we execute user code.
(let ((module (resolve-module '(guix-user) #f #f #:ensure #t)))
(beautify-user-module! module)
module))
-(define* (machine-repl #:optional
- (input (current-input-port))
- (output (current-output-port)))
- "Run a machine-usable REPL over ports INPUT and OUTPUT.
-
-The protocol of this REPL is meant to be machine-readable and provides proper
-support to represent multiple-value returns, exceptions, objects that lack a
-read syntax, and so on. As such it is more convenient and robust than parsing
-Guile's REPL prompt."
- (define (value->sexp value)
- (if (self-quoting? value)
- `(value ,value)
- `(non-self-quoting ,(object-address value)
- ,(object->string value))))
-
- (write `(repl-version 0 0) output)
- (newline output)
- (force-output output)
-
- (let loop ()
- (match (read input)
- ((? eof-object?) #t)
- (exp
- (catch #t
- (lambda ()
- (let ((results (call-with-values
- (lambda ()
-
- (primitive-eval exp))
- list)))
- (write `(values ,@(map value->sexp results))
- output)
- (newline output)
- (force-output output)))
- (lambda (key . args)
- (write `(exception ,key ,@(map value->sexp args)))
- (newline output)
- (force-output output)))
- (loop)))))
-
(define (call-with-connection spec thunk)
"Dynamically-bind the current input and output ports according to SPEC and
call THUNK."
(cond ((not (file-exists? profile)) ; XXX: race condition
(raise (condition (&profile-not-found-error
(profile profile)))))
- ((string-null? pattern)
+ ((not pattern)
(for-each display-system-generation (profile-generations profile)))
((matching-generations pattern profile)
=>
(if (null-list? numbers)
(exit 1)
(leave-on-EPIPE
- (for-each display-system-generation numbers)))))
- (else
- (leave (G_ "invalid syntax: ~a~%") pattern))))
+ (for-each display-system-generation numbers)))))))
\f
;;;
;; an operating system configuration file.
((list-generations)
(let ((pattern (match args
- (() "")
+ (() #f)
((pattern) pattern)
(x (leave (G_ "wrong number of arguments~%"))))))
(list-generations pattern)))
;; operating system configuration file.
((delete-generations)
(let ((pattern (match args
- (() "")
+ (() #f)
((pattern) pattern)
(x (leave (G_ "wrong number of arguments~%"))))))
(with-store store
(gnu services)
,@(scheme-modules* source "gnu/bootloader")
,@(scheme-modules* source "gnu/system")
- ,@(scheme-modules* source "gnu/services"))
+ ,@(scheme-modules* source "gnu/services")
+ ,@(scheme-modules* source "gnu/machine"))
(list *core-package-modules* *package-modules*
*extra-modules* *core-modules*)
#:extensions dependencies
(define %compression
"zlib@openssh.com,zlib")
-(define* (open-ssh-session host #:key user port
+(define* (open-ssh-session host #:key user port identity
(compression %compression))
- "Open an SSH session for HOST and return it. When USER and PORT are #f, use
-default values or whatever '~/.ssh/config' specifies; otherwise use them.
-Throw an error on failure."
+ "Open an SSH session for HOST and return it. IDENTITY specifies the file
+name of a private key to use for authenticating with the host. When USER,
+PORT, or IDENTITY are #f, use default values or whatever '~/.ssh/config'
+specifies; otherwise use them. Throw an error on failure."
(let ((session (make-session #:user user
+ #:identity identity
#:host host
#:port port
#:timeout 10 ;seconds
(call-with-values (lambda ()
(run-with-state mval store))
(lambda (result new-store)
- ;; Copy the object cache from NEW-STORE so we don't fully discard the
- ;; state.
- (let ((cache (store-connection-object-cache new-store)))
- (set-store-connection-object-cache! store cache)
- result)))))
+ (when (and store new-store)
+ ;; Copy the object cache from NEW-STORE so we don't fully discard
+ ;; the state.
+ (let ((cache (store-connection-object-cache new-store)))
+ (set-store-connection-object-cache! store cache)))
+ result))))
\f
;;;
;; substituter many times. This makes a big difference, especially when
;; DRV is a long list as is the case with 'guix environment'.
(if use-substitutes?
- (substitution-oracle store (map derivation-input-derivation inputs)
- #:mode mode)
+ (substitution-oracle store inputs #:mode mode)
(const #f)))
(let*-values (((build download)
#:mode mode
#:substitutable-info
substitutable-info))
- ((download) ; add the references of DOWNLOAD
- (if use-substitutes?
- (delete-duplicates
- (append download
- (filter-map (lambda (item)
- (if (valid-path? store item)
- #f
- (substitutable-info item)))
- (append-map
- substitutable-references
- download))))
- download))
((graft hook build)
(match (fold (lambda (drv acc)
(let ((file (derivation-file-name drv)))
((string->duration str)
=>
filter-by-duration)
- (else #f)))
+ (else
+ (raise
+ (condition (&message
+ (message (format #f (G_ "invalid syntax: ~a~%")
+ str))))))))
(define (display-generation profile number)
"Display a one-line summary of generation NUMBER of PROFILE."
gnu/installer/timezone.scm
gnu/installer/user.scm
gnu/installer/utils.scm
+gnu/machine/ssh.scm
gnu/packages/bootstrap.scm
guix/build/utils.scm
guix/scripts.scm
guix/scripts/weather.scm
guix/scripts/describe.scm
guix/scripts/processes.scm
+guix/scripts/deploy.scm
guix/gnu-maintenance.scm
guix/scripts/container.scm
guix/scripts/container/exec.scm
+++ /dev/null
-/* GNU Guix --- Functional package management for GNU
- Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
-
- This file is part of GNU Guix.
-
- GNU Guix is free software; you can redistribute it and/or modify it
- under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 3 of the License, or (at
- your option) any later version.
-
- GNU Guix is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. */
-
-/* Release file to build Guix with Nix. Useful to bootstrap Guix on
- Guix-enabled Hydra instances. */
-
-let
- nixpkgs = <nixpkgs>;
-
- buildOutOfSourceTree = true;
- succeedOnFailure = true;
- keepBuildDirectory = true;
-
- # The Guile used to bootstrap the whole thing. It's normally
- # downloaded by the build system, but here we download it via a
- # fixed-output derivation and stuff it into the build tree.
- bootstrap_guile =
- let pkgs = import nixpkgs {}; in {
- i686 = pkgs.fetchurl {
- url = http://www.fdn.fr/~lcourtes/software/guix/packages/i686-linux/20121219/guile-2.0.7.tar.xz;
- sha256 = "45d1f9bfb9e4531a8f1c5a105f7ab094cd481b8a179ccc63cbabb73ce6b8437f";
- };
-
- x86_64 = pkgs.fetchurl {
- url = http://www.fdn.fr/~lcourtes/software/guix/packages/x86_64-linux/20121219/guile-2.0.7.tar.xz;
- sha256 = "953fbcc8db6e310626be79b67319cf4141dc23b296447952a99d95425b3a4dc1";
- };
- };
-
- jobs = {
- tarball =
- let pkgs = import nixpkgs {}; in
- pkgs.releaseTools.sourceTarball {
- name = "guix-tarball";
- src = <guix>;
- buildInputs = with pkgs; [ guile sqlite bzip2 git libgcrypt ];
- buildNativeInputs = with pkgs; [ texinfo gettext cvs pkgconfig ];
- preAutoconf = ''git config submodule.nix.url "${<nix>}"'';
- configureFlags =
- [ "--with-libgcrypt-prefix=${pkgs.libgcrypt}"
- "--localstatedir=/nix/var"
- ];
- };
-
- build =
- { system ? builtins.currentSystem }:
-
- let pkgs = import nixpkgs { inherit system; }; in
- pkgs.releaseTools.nixBuild {
- name = "guix";
- buildInputs = with pkgs; [ guile sqlite bzip2 libgcrypt ];
- buildNativeInputs = [ pkgs.pkgconfig ];
- src = jobs.tarball;
- configureFlags =
- [ "--with-libgcrypt-prefix=${pkgs.libgcrypt}"
- "--localstatedir=/nix/var"
- ];
-
- preBuild =
- # Use our pre-downloaded bootstrap tarballs instead of letting
- # the build system download it over and over again.
- '' mkdir -p distro/packages/bootstrap/{i686,x86_64}-linux
- cp -v "${bootstrap_guile.i686}" \
- distro/packages/bootstrap/i686-linux/guile-2.0.7.tar.xz
- cp -v "${bootstrap_guile.x86_64}" \
- distro/packages/bootstrap/x86_64-linux/guile-2.0.7.tar.xz
- '';
-
- inherit succeedOnFailure keepBuildDirectory
- buildOutOfSourceTree;
- };
-
-
- build_disable_daemon =
- { system ? builtins.currentSystem }:
-
- let
- pkgs = import nixpkgs { inherit system; };
- build = jobs.build { inherit system; };
- in
- pkgs.lib.overrideDerivation build ({ configureFlags, ... }: {
- configureFlags = configureFlags ++ [ "--disable-daemon" ];
- buildInputs = with pkgs; [ guile nixUnstable pkgconfig ];
-
- # Since we need to talk to a running daemon, we need to escape
- # the chroot.
- preConfigure = "export NIX_REMOTE=daemon";
- __noChroot = true;
- });
-
- # Jobs to test the distro.
- distro = {
- hello =
- { system ? builtins.currentSystem }:
-
- let
- pkgs = import nixpkgs { inherit system; };
- guix = jobs.build { inherit system; };
- in
- # XXX: We have no way to tell the Nix code to swallow the .drv
- # produced by `guix-build', so we have a pointless indirection
- # here. This could be worked around by generating Nix code
- # from the .drv, and importing that.
- pkgs.releaseTools.nixBuild {
- src = null;
- name = "guix-hello";
- phases = "buildPhase";
- buildPhase = "${guix}/bin/guix-build --no-substitutes hello | tee $out";
- __noChroot = true;
- };
- };
- };
-in
- jobs
(((= derivation-file-name build))
(string=? build (derivation-file-name drv)))))))))
+(test-assert "derivation-build-plan and substitutes, non-substitutable dep"
+ (with-store store
+ (let* ((drv1 (build-expression->derivation store "prereq-no-subst"
+ (random 1000)
+ #:substitutable? #f))
+ (drv2 (build-expression->derivation store "substitutable"
+ (random 1000)
+ #:inputs `(("dep" ,drv1)))))
+
+ ;; Make sure substitutes are usable.
+ (set-build-options store #:use-substitutes? #t
+ #:substitute-urls (%test-substitute-urls))
+
+ (with-derivation-narinfo drv2
+ (sha256 => (make-bytevector 32 0))
+ (references => (list (derivation->output-path drv1)))
+
+ (let-values (((build download)
+ (derivation-build-plan store
+ (list (derivation-input drv2)))))
+ ;; Although DRV2 is available as a substitute, we must build its
+ ;; dependency, DRV1, due to #:substitutable? #f.
+ (and (match download
+ (((= substitutable-path item))
+ (string=? item (derivation->output-path drv2))))
+ (match build
+ (((= derivation-file-name build))
+ (string=? build (derivation-file-name drv1))))))))))
+
(test-assert "derivation-build-plan and substitutes, local build"
(with-store store
(let* ((drv (build-expression->derivation store "prereq-subst-local"
(built-derivations (list drv))
(return (equal? '(42 84) (call-with-input-file out read))))))
+(test-assertm "lower-gexp"
+ (mlet* %store-monad
+ ((extension -> %extension-package)
+ (extension-drv (package->derivation %extension-package))
+ (coreutils-drv (package->derivation coreutils))
+ (exp -> (with-extensions (list extension)
+ (with-imported-modules `((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (hg2g))
+ #$coreutils:debug
+ mkdir-p
+ the-answer))))
+ (lexp (lower-gexp exp
+ #:effective-version "2.0")))
+ (define (matching-input drv output)
+ (lambda (input)
+ (and (eq? (gexp-input-thing input) drv)
+ (string=? (gexp-input-output input) output))))
+
+ (mbegin %store-monad
+ (return (and (find (matching-input extension-drv "out")
+ (lowered-gexp-inputs (pk 'lexp lexp)))
+ (find (matching-input coreutils-drv "debug")
+ (lowered-gexp-inputs lexp))
+ (member (string-append
+ (derivation->output-path extension-drv)
+ "/share/guile/site/2.0")
+ (lowered-gexp-load-path lexp))
+ (= 2 (length (lowered-gexp-load-path lexp)))
+ (member (string-append
+ (derivation->output-path extension-drv)
+ "/lib/guile/2.0/site-ccache")
+ (lowered-gexp-load-compiled-path lexp))
+ (= 2 (length (lowered-gexp-load-compiled-path lexp)))
+ (eq? (lowered-gexp-guile lexp) (%guile-for-build)))))))
+
(test-assertm "gexp->derivation #:references-graphs"
(mlet* %store-monad
((one (text-file "one" (random-text)))
guix environment --bootstrap --manifest=$tmpdir/manifest.scm --pure \
-- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile"'
+# if not sharing CWD, chdir home
+(
+ cd "$tmpdir" \
+ && guix environment --bootstrap --container --no-cwd --user=foo \
+ --ad-hoc guile-bootstrap --pure \
+ -- /bin/sh -c 'test $(pwd) == "/home/foo" -a ! -d '"$tmpdir"
+)
+
# Make sure '-r' works as expected.
rm -f "$gcroot"
expected="`guix environment --bootstrap --ad-hoc guile-bootstrap \
HCoop / jackhill / guix / guix.git / commitdiff