nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into core-updates 

Conflicts:
	gnu/local.mk
	gnu/packages/python-xyz.scm
	gnu/packages/xml.scm
	guix/gexp.scm
	po/guix/POTFILES.in
This commit is contained in:
Marius Bakke 2019-07-12 01:03:53 +02:00
parent 1c4b72cb34 5a836ce38c
commit fb9a23a3f3
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
95 changed files with 4029 additions and 1092 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Makefile.am
View File

@ -90,6 +90,7 @@ MODULES = \
guix/nar.scm \ guix/nar.scm \
guix/derivations.scm \ guix/derivations.scm \
guix/grafts.scm \ guix/grafts.scm \
guix/repl.scm \
guix/inferior.scm \ guix/inferior.scm \
guix/describe.scm \ guix/describe.scm \
guix/channels.scm \ guix/channels.scm \
@ -266,6 +267,7 @@ MODULES = \
guix/scripts/weather.scm \ guix/scripts/weather.scm \
guix/scripts/container.scm \ guix/scripts/container.scm \
guix/scripts/container/exec.scm \ guix/scripts/container/exec.scm \
guix/scripts/deploy.scm \
guix.scm \ guix.scm \
$(GNU_SYSTEM_MODULES) $(GNU_SYSTEM_MODULES)
@ -273,6 +275,7 @@ if HAVE_GUILE_SSH
MODULES += \ MODULES += \
guix/ssh.scm \ guix/ssh.scm \
guix/remote.scm \
guix/scripts/copy.scm \ guix/scripts/copy.scm \
guix/store/ssh.scm guix/store/ssh.scm
@ -541,7 +544,7 @@ EXTRA_DIST += \
tests/cve-sample.xml \ tests/cve-sample.xml \
build-aux/config.rpath \ build-aux/config.rpath \
bootstrap \ bootstrap \
release.nix \ doc/build.scm \
$(TESTS) $(TESTS)
if !BUILD_DAEMON_OFFLOAD if !BUILD_DAEMON_OFFLOAD

563
doc/build.scm Normal file
View File

@ -0,0 +1,563 @@
;;; 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))))
(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))

122
doc/guix.texi
View File

@ -65,6 +65,7 @@ Copyright @copyright{} 2018 Alex Vong@*
Copyright @copyright{} 2019 Josh Holland@* Copyright @copyright{} 2019 Josh Holland@*
Copyright @copyright{} 2019 Diego Nicola Barbato@* Copyright @copyright{} 2019 Diego Nicola Barbato@*
Copyright @copyright{} 2019 Ivan Petkov@* Copyright @copyright{} 2019 Ivan Petkov@*
Copyright @copyright{} 2019 Jakob L. Kreuze@*
Permission is granted to copy, distribute and/or modify this document Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or under the terms of the GNU Free Documentation License, Version 1.3 or
@ -81,6 +82,7 @@ Documentation License''.
* guix gc: (guix)Invoking guix gc. Reclaiming unused disk space. * guix gc: (guix)Invoking guix gc. Reclaiming unused disk space.
* guix pull: (guix)Invoking guix pull. Update the list of available packages. * guix pull: (guix)Invoking guix pull. Update the list of available packages.
* guix system: (guix)Invoking guix system. Manage the operating system configuration. * 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 @end direntry
@dircategory Software development @dircategory Software development
@ -269,6 +271,7 @@ System Configuration
* Initial RAM Disk:: Linux-Libre bootstrapping. * Initial RAM Disk:: Linux-Libre bootstrapping.
* Bootloader Configuration:: Configuring the boot loader. * Bootloader Configuration:: Configuring the boot loader.
* Invoking guix system:: Instantiating a system configuration. * 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. * Running Guix in a VM:: How to run Guix System in a virtual machine.
* Defining Services:: Adding new service definitions. * Defining Services:: Adding new service definitions.
@ -4654,6 +4657,14 @@ While this will limit the leaking of user identity through home paths
and each of the user fields, this is only one useful component of a and each of the user fields, this is only one useful component of a
broader privacy/anonymity solution---not one in and of itself. 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}] @item --expose=@var{source}[=@var{target}]
For containers, expose the file system @var{source} from the host system For containers, expose the file system @var{source} from the host system
as the read-only file system @var{target} within the container. If as the read-only file system @var{target} within the container. If
@ -10296,6 +10307,7 @@ instance to support new system services.
* Initial RAM Disk:: Linux-Libre bootstrapping. * Initial RAM Disk:: Linux-Libre bootstrapping.
* Bootloader Configuration:: Configuring the boot loader. * Bootloader Configuration:: Configuring the boot loader.
* Invoking guix system:: Instantiating a system configuration. * 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. * Running Guix in a VM:: How to run Guix System in a virtual machine.
* Defining Services:: Adding new service definitions. * Defining Services:: Adding new service definitions.
@end menu @end menu
@ -25392,6 +25404,116 @@ example graph.
@end table @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 @node Running Guix in a VM
@section Running Guix in a Virtual Machine @section Running Guix in a Virtual Machine

19
etc/guix-install.sh
View File

@ -3,6 +3,7 @@
# Copyright © 2017 sharlatan <sharlatanus@gmail.com> # Copyright © 2017 sharlatan <sharlatanus@gmail.com>
# Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> # Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
# Copyright © 2018 Efraim Flashner <efraim@flashner.co.il> # Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
# Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
# #
# This file is part of GNU Guix. # This file is part of GNU Guix.
# #
@ -85,14 +86,12 @@ _debug()
chk_require() chk_require()
{ # Check that every required command is available. { # Check that every required command is available.
declare -a cmds
declare -a warn declare -a warn
local c
cmds=(${1})
_debug "--- [ $FUNCNAME ] ---" _debug "--- [ $FUNCNAME ] ---"
for c in ${cmds[@]}; do for c in "$@"; do
command -v "$c" &>/dev/null || warn+=("$c") command -v "$c" &>/dev/null || warn+=("$c")
done done
@ -101,8 +100,15 @@ chk_require()
return 1; } return 1; }
_msg "${PAS}verification of required commands completed" _msg "${PAS}verification of required commands completed"
}
gpg --list-keys ${OPENPGP_SIGNING_KEY_ID} >/dev/null 2>&1 || ( chk_gpg_keyring()
{ # Check whether the Guix release signing public key is present.
_debug "--- [ $FUNCNAME ] ---"
# 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:" _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 -" echo " wget https://sv.gnu.org/people/viewgpg.php?user_id=15145 -qO - | gpg --import -"
exit 1 exit 1
@ -415,7 +421,8 @@ main()
_msg "Starting installation ($(date))" _msg "Starting installation ($(date))"
chk_term chk_term
chk_require "${REQUIRE[*]}" chk_require "${REQUIRE[@]}"
chk_gpg_keyring
chk_init_sys chk_init_sys
chk_sys_arch chk_sys_arch

7
gnu/build/linux-container.scm
View File

@ -130,9 +130,14 @@ for the process."
"/dev/random" "/dev/random"
"/dev/urandom" "/dev/urandom"
"/dev/tty" "/dev/tty"
"/dev/ptmx"
"/dev/fuse")) "/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 ;; Setup the container's /dev/console by bind mounting the pseudo-terminal
;; associated with standard input when there is one. ;; associated with standard input when there is one.
(let* ((in (current-input-port)) (let* ((in (current-input-port))

6
gnu/ci.scm
View File

@ -193,9 +193,11 @@ system.")
(define channel-build-system (define channel-build-system
;; Build system used to "convert" a channel instance to a package. ;; Build system used to "convert" a channel instance to a package.
(let* ((build (lambda* (store name inputs (let* ((build (lambda* (store name inputs
#:key instance #:allow-other-keys) #:key instance system
#:allow-other-keys)
(run-with-store store (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) (lower (lambda* (name #:key system instance #:allow-other-keys)
(bag (bag
(name name) (name name)

19
gnu/local.mk
View File

@ -299,6 +299,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/llvm.scm \ %D%/packages/llvm.scm \
%D%/packages/lout.scm \ %D%/packages/lout.scm \
%D%/packages/logging.scm \ %D%/packages/logging.scm \
%D%/packages/logo.scm \
%D%/packages/lolcode.scm \ %D%/packages/lolcode.scm \
%D%/packages/lsof.scm \ %D%/packages/lsof.scm \
%D%/packages/lua.scm \ %D%/packages/lua.scm \
@ -489,6 +490,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/wget.scm \ %D%/packages/wget.scm \
%D%/packages/wicd.scm \ %D%/packages/wicd.scm \
%D%/packages/wine.scm \ %D%/packages/wine.scm \
%D%/packages/wireservice.scm \
%D%/packages/wm.scm \ %D%/packages/wm.scm \
%D%/packages/wordnet.scm \ %D%/packages/wordnet.scm \
%D%/packages/wv.scm \ %D%/packages/wv.scm \
@ -564,6 +566,9 @@ GNU_SYSTEM_MODULES = \
%D%/system/uuid.scm \ %D%/system/uuid.scm \
%D%/system/vm.scm \ %D%/system/vm.scm \
\ \
%D%/machine.scm \
%D%/machine/ssh.scm \
\
%D%/build/accounts.scm \ %D%/build/accounts.scm \
%D%/build/activation.scm \ %D%/build/activation.scm \
%D%/build/bootloader.scm \ %D%/build/bootloader.scm \
@ -655,6 +660,7 @@ dist_patch_DATA = \
%D%/packages/patches/4store-unset-preprocessor-directive.patch \ %D%/packages/patches/4store-unset-preprocessor-directive.patch \
%D%/packages/patches/a2ps-CVE-2001-1593.patch \ %D%/packages/patches/a2ps-CVE-2001-1593.patch \
%D%/packages/patches/a2ps-CVE-2014-0466.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-explictly-cast-bools.patch \
%D%/packages/patches/abiword-black-drawing-with-gtk322.patch \ %D%/packages/patches/abiword-black-drawing-with-gtk322.patch \
%D%/packages/patches/adb-add-libraries.patch \ %D%/packages/patches/adb-add-libraries.patch \
@ -728,7 +734,6 @@ dist_patch_DATA = \
%D%/packages/patches/clementine-use-openssl.patch \ %D%/packages/patches/clementine-use-openssl.patch \
%D%/packages/patches/clisp-remove-failing-test.patch \ %D%/packages/patches/clisp-remove-failing-test.patch \
%D%/packages/patches/clucene-pkgconfig.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/coda-use-system-libs.patch \
%D%/packages/patches/combinatorial-blas-awpm.patch \ %D%/packages/patches/combinatorial-blas-awpm.patch \
%D%/packages/patches/combinatorial-blas-io-fix.patch \ %D%/packages/patches/combinatorial-blas-io-fix.patch \
@ -736,10 +741,11 @@ dist_patch_DATA = \
%D%/packages/patches/cpufrequtils-fix-aclocal.patch \ %D%/packages/patches/cpufrequtils-fix-aclocal.patch \
%D%/packages/patches/crawl-upgrade-saves.patch \ %D%/packages/patches/crawl-upgrade-saves.patch \
%D%/packages/patches/crda-optional-gcrypt.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/clucene-contribs-lib.patch \
%D%/packages/patches/cube-nocheck.patch \ %D%/packages/patches/cube-nocheck.patch \
%D%/packages/patches/cursynth-wave-rand.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/dbus-helper-search-path.patch \
%D%/packages/patches/dealii-mpi-deprecations.patch \ %D%/packages/patches/dealii-mpi-deprecations.patch \
%D%/packages/patches/deja-dup-use-ref-keyword-for-iter.patch \ %D%/packages/patches/deja-dup-use-ref-keyword-for-iter.patch \
@ -775,6 +781,7 @@ dist_patch_DATA = \
%D%/packages/patches/evilwm-lost-focus-bug.patch \ %D%/packages/patches/evilwm-lost-focus-bug.patch \
%D%/packages/patches/exiv2-CVE-2017-14860.patch \ %D%/packages/patches/exiv2-CVE-2017-14860.patch \
%D%/packages/patches/exiv2-CVE-2017-14859-14862-14864.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/extundelete-e2fsprogs-1.44.patch \
%D%/packages/patches/fastcap-mulGlobal.patch \ %D%/packages/patches/fastcap-mulGlobal.patch \
%D%/packages/patches/fastcap-mulSetup.patch \ %D%/packages/patches/fastcap-mulSetup.patch \
@ -893,8 +900,6 @@ dist_patch_DATA = \
%D%/packages/patches/gpsbabel-qstring.patch \ %D%/packages/patches/gpsbabel-qstring.patch \
%D%/packages/patches/grep-timing-sensitive-test.patch \ %D%/packages/patches/grep-timing-sensitive-test.patch \
%D%/packages/patches/groovy-add-exceptionutilsgenerator.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/grub-efi-fat-serial-number.patch \
%D%/packages/patches/gsl-test-i686.patch \ %D%/packages/patches/gsl-test-i686.patch \
%D%/packages/patches/gspell-dash-test.patch \ %D%/packages/patches/gspell-dash-test.patch \
@ -1003,11 +1008,12 @@ dist_patch_DATA = \
%D%/packages/patches/libdrm-symbol-check.patch \ %D%/packages/patches/libdrm-symbol-check.patch \
%D%/packages/patches/libexif-CVE-2016-6328.patch \ %D%/packages/patches/libexif-CVE-2016-6328.patch \
%D%/packages/patches/libexif-CVE-2017-7544.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-avoid-python.patch \
%D%/packages/patches/libgit2-mtime-0.patch \ %D%/packages/patches/libgit2-mtime-0.patch \
%D%/packages/patches/libgnome-encoding.patch \ %D%/packages/patches/libgnome-encoding.patch \
%D%/packages/patches/libgnomeui-utf8.patch \ %D%/packages/patches/libgnomeui-utf8.patch \
%D%/packages/patches/libgpg-error-gawk-compat.patch \
%D%/packages/patches/libffi-3.2.1-complex-alpha.patch \ %D%/packages/patches/libffi-3.2.1-complex-alpha.patch \
%D%/packages/patches/libjxr-fix-function-signature.patch \ %D%/packages/patches/libjxr-fix-function-signature.patch \
%D%/packages/patches/libjxr-fix-typos.patch \ %D%/packages/patches/libjxr-fix-typos.patch \
@ -1178,6 +1184,8 @@ dist_patch_DATA = \
%D%/packages/patches/pixman-CVE-2016-5296.patch \ %D%/packages/patches/pixman-CVE-2016-5296.patch \
%D%/packages/patches/plink-1.07-unclobber-i.patch \ %D%/packages/patches/plink-1.07-unclobber-i.patch \
%D%/packages/patches/plink-endian-detection.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/plotutils-libpng-jmpbuf.patch \
%D%/packages/patches/podofo-cmake-3.12.patch \ %D%/packages/patches/podofo-cmake-3.12.patch \
%D%/packages/patches/portaudio-audacity-compat.patch \ %D%/packages/patches/portaudio-audacity-compat.patch \
@ -1224,6 +1232,7 @@ dist_patch_DATA = \
%D%/packages/patches/python2-pygobject-2-gi-info-type-error-domain.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-pygpgme-fix-pinentry-tests.patch \
%D%/packages/patches/python-robotframework-honor-source-date-epoch.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/python2-subprocess32-disable-input-test.patch \
%D%/packages/patches/python-unittest2-python3-compat.patch \ %D%/packages/patches/python-unittest2-python3-compat.patch \
%D%/packages/patches/python-unittest2-remove-argparse.patch \ %D%/packages/patches/python-unittest2-remove-argparse.patch \

107
gnu/machine.scm Normal file
View File

@ -0,0 +1,107 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 David Thompson <davet@gnu.org>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu machine)
#:use-module (gnu system)
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix store)
#:use-module ((guix utils) #:select (source-properties->location))
#:export (environment-type
environment-type?
environment-type-name
environment-type-description
environment-type-location
machine
machine?
this-machine
machine-system
machine-environment
machine-configuration
machine-display-name
deploy-machine
machine-remote-eval))
;;; Commentary:
;;;
;;; This module provides the types used to declare individual machines in a
;;; heterogeneous Guix deployment. The interface allows users of specify system
;;; configurations and the means by which resources should be provisioned on a
;;; per-host basis.
;;;
;;; Code:
;;;
;;; Declarations for resources that can be provisioned.
;;;
(define-record-type* <environment-type> environment-type
make-environment-type
environment-type?
;; Interface to the environment type's deployment code. Each procedure
;; should take the same arguments as the top-level procedure of this file
;; that shares the same name. For example, 'machine-remote-eval' should be
;; of the form '(machine-remote-eval machine exp)'.
(machine-remote-eval environment-type-machine-remote-eval) ; procedure
(deploy-machine environment-type-deploy-machine) ; procedure
;; Metadata.
(name environment-type-name) ; symbol
(description environment-type-description ; string
(default #f))
(location environment-type-location ; <location>
(default (and=> (current-source-location)
source-properties->location))
(innate)))
;;;
;;; Declarations for machines in a deployment.
;;;
(define-record-type* <machine> machine
make-machine
machine?
this-machine
(system machine-system) ; <operating-system>
(environment machine-environment) ; symbol
(configuration machine-configuration ; configuration object
(default #f))) ; specific to environment
(define (machine-display-name machine)
"Return the host-name identifying MACHINE."
(operating-system-host-name (machine-system machine)))
(define (machine-remote-eval machine exp)
"Evaluate EXP, a gexp, on MACHINE. Ensure that all the elements EXP refers to
are built and deployed to MACHINE beforehand."
(let ((environment (machine-environment machine)))
((environment-type-machine-remote-eval environment) machine exp)))
(define (deploy-machine machine)
"Monadic procedure transferring the new system's OS closure to the remote
MACHINE, activating it on MACHINE and switching MACHINE to the new generation."
(let ((environment (machine-environment machine)))
((environment-type-deploy-machine environment) machine)))

369
gnu/machine/ssh.scm Normal file
View File

@ -0,0 +1,369 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu machine ssh)
#:use-module (gnu bootloader)
#:use-module (gnu machine)
#:autoload (gnu packages gnupg) (guile-gcrypt)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu system)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix i18n)
#:use-module (guix modules)
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix remote)
#:use-module (guix ssh)
#:use-module (guix store)
#:use-module (ice-9 match)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-35)
#:export (managed-host-environment-type
machine-ssh-configuration
machine-ssh-configuration?
machine-ssh-configuration
machine-ssh-configuration-host-name
machine-ssh-configuration-port
machine-ssh-configuration-user
machine-ssh-configuration-session))
;;; Commentary:
;;;
;;; This module implements remote evaluation and system deployment for
;;; machines that are accessable over SSH and have a known host-name. In the
;;; sense of the broader "machine" interface, we describe the environment for
;;; such machines as 'managed-host.
;;;
;;; Code:
;;;
;;; Parameters for the SSH client.
;;;
(define-record-type* <machine-ssh-configuration> machine-ssh-configuration
make-machine-ssh-configuration
machine-ssh-configuration?
this-machine-ssh-configuration
(host-name machine-ssh-configuration-host-name) ; string
(port machine-ssh-configuration-port ; integer
(default 22))
(user machine-ssh-configuration-user ; string
(default "root"))
(identity machine-ssh-configuration-identity ; path to a private key
(default #f))
(session machine-ssh-configuration-session ; session
(default #f)))
(define (machine-ssh-session machine)
"Return the SSH session that was given in MACHINE's configuration, or create
one from the configuration's parameters if one was not provided."
(maybe-raise-unsupported-configuration-error machine)
(let ((config (machine-configuration machine)))
(or (machine-ssh-configuration-session config)
(let ((host-name (machine-ssh-configuration-host-name config))
(user (machine-ssh-configuration-user config))
(port (machine-ssh-configuration-port config))
(identity (machine-ssh-configuration-identity config)))
(open-ssh-session host-name
#:user user
#:port port
#:identity identity)))))
;;;
;;; Remote evaluation.
;;;
(define (managed-host-remote-eval machine exp)
"Internal implementation of 'machine-remote-eval' for MACHINE instances with
an environment type of 'managed-host."
(maybe-raise-unsupported-configuration-error machine)
(remote-eval exp (machine-ssh-session machine)))
;;;
;;; System deployment.
;;;
(define (switch-to-system machine)
"Monadic procedure creating a new generation on MACHINE and execute the
activation script for the new system configuration."
(define (remote-exp drv script)
(with-extensions (list guile-gcrypt)
(with-imported-modules (source-module-closure '((guix config)
(guix profiles)
(guix utils)))
#~(begin
(use-modules (guix config)
(guix profiles)
(guix utils))
(define %system-profile
(string-append %state-directory "/profiles/system"))
(let* ((system #$drv)
(number (1+ (generation-number %system-profile)))
(generation (generation-file-name %system-profile number)))
(switch-symlinks generation system)
(switch-symlinks %system-profile generation)
;; The implementation of 'guix system reconfigure' saves the
;; load path and environment here. This is unnecessary here
;; because each invocation of 'remote-eval' runs in a distinct
;; Guile REPL.
(setenv "GUIX_NEW_SYSTEM" system)
;; The activation script may write to stdout, which confuses
;; 'remote-eval' when it attempts to read a result from the
;; remote REPL. We work around this by forcing the output to a
;; string.
(with-output-to-string
(lambda ()
(primitive-load #$script))))))))
(let* ((os (machine-system machine))
(script (operating-system-activation-script os)))
(mlet* %store-monad ((drv (operating-system-derivation os)))
(machine-remote-eval machine (remote-exp drv script)))))
;; XXX: Currently, this does NOT attempt to restart running services. This is
;; also the case with 'guix system reconfigure'.
;;
;; See <https://issues.guix.info/issue/33508>.
(define (upgrade-shepherd-services machine)
"Monadic procedure unloading and starting services on the remote as needed
to realize the MACHINE's system configuration."
(define target-services
;; Monadic expression evaluating to a list of (name output-path) pairs for
;; all of MACHINE's services.
(mapm %store-monad
(lambda (service)
(mlet %store-monad ((file ((compose lower-object
shepherd-service-file)
service)))
(return (list (shepherd-service-canonical-name service)
(derivation->output-path file)))))
(service-value
(fold-services (operating-system-services (machine-system machine))
#:target-type shepherd-root-service-type))))
(define (remote-exp target-services)
(with-imported-modules '((gnu services herd))
#~(begin
(use-modules (gnu services herd)
(srfi srfi-1))
(define running
(filter live-service-running (current-services)))
(define (essential? service)
;; Return #t if SERVICE is essential and should not be unloaded
;; under any circumstance.
(memq (first (live-service-provision service))
'(root shepherd)))
(define (obsolete? service)
;; Return #t if SERVICE can be safely unloaded.
(and (not (essential? service))
(every (lambda (requirements)
(not (memq (first (live-service-provision service))
requirements)))
(map live-service-requirement running))))
(define to-unload
(filter obsolete?
(remove (lambda (service)
(memq (first (live-service-provision service))
(map first '#$target-services)))
running)))
(define to-start
(remove (lambda (service-pair)
(memq (first service-pair)
(map (compose first live-service-provision)
running)))
'#$target-services))
;; Unload obsolete services.
(for-each (lambda (service)
(false-if-exception
(unload-service service)))
to-unload)
;; Load the service files for any new services and start them.
(load-services/safe (map second to-start))
(for-each start-service (map first to-start))
#t)))
(mlet %store-monad ((target-services target-services))
(machine-remote-eval machine (remote-exp target-services))))
(define (machine-boot-parameters machine)
"Monadic procedure returning a list of 'boot-parameters' for the generations
of MACHINE's system profile, ordered from most recent to oldest."
(define bootable-kernel-arguments
(@@ (gnu system) bootable-kernel-arguments))
(define remote-exp
(with-extensions (list guile-gcrypt)
(with-imported-modules (source-module-closure '((guix config)
(guix profiles)))
#~(begin
(use-modules (guix config)
(guix profiles)
(ice-9 textual-ports))
(define %system-profile
(string-append %state-directory "/profiles/system"))
(define (read-file path)
(call-with-input-file path
(lambda (port)
(get-string-all port))))
(map (lambda (generation)
(let* ((system-path (generation-file-name %system-profile
generation))
(boot-parameters-path (string-append system-path
"/parameters"))
(time (stat:mtime (lstat system-path))))
(list generation
system-path
time
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
(mlet* %store-monad ((generations (machine-remote-eval machine remote-exp)))
(return
(map (lambda (generation)
(match generation
((generation system-path time serialized-params)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
(root (boot-parameters-root-device params))
(label (boot-parameters-label params)))
(boot-parameters
(inherit params)
(label
(string-append label " (#"
(number->string generation) ", "
(let ((time (make-time time-utc 0 time)))
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M"))
")"))
(kernel-arguments
(append (bootable-kernel-arguments system-path root)
(boot-parameters-kernel-arguments params))))))))
generations))))
(define (install-bootloader machine)
"Create a bootloader entry for the new system generation on MACHINE, and
configure the bootloader to boot that generation by default."
(define bootloader-installer-script
(@@ (guix scripts system) bootloader-installer-script))
(define (remote-exp installer bootcfg bootcfg-file)
(with-extensions (list guile-gcrypt)
(with-imported-modules (source-module-closure '((gnu build install)
(guix store)
(guix utils)))
#~(begin
(use-modules (gnu build install)
(guix store)
(guix utils))
(let* ((gc-root (string-append "/" %gc-roots-directory "/bootcfg"))
(temp-gc-root (string-append gc-root ".new")))
(switch-symlinks temp-gc-root gc-root)
(unless (false-if-exception
(begin
;; The implementation of 'guix system reconfigure'
;; saves the load path here. This is unnecessary here
;; because each invocation of 'remote-eval' runs in a
;; distinct Guile REPL.
(install-boot-config #$bootcfg #$bootcfg-file "/")
;; The installation script may write to stdout, which
;; confuses 'remote-eval' when it attempts to read a
;; result from the remote REPL. We work around this
;; by forcing the output to a string.
(with-output-to-string
(lambda ()
(primitive-load #$installer)))))
(delete-file temp-gc-root)
(error "failed to install bootloader"))
(rename-file temp-gc-root gc-root)
#t)))))
(mlet* %store-monad ((boot-parameters (machine-boot-parameters machine)))
(let* ((os (machine-system machine))
(bootloader ((compose bootloader-configuration-bootloader
operating-system-bootloader)
os))
(bootloader-target (bootloader-configuration-target
(operating-system-bootloader os)))
(installer (bootloader-installer-script
(bootloader-installer bootloader)
(bootloader-package bootloader)
bootloader-target
"/"))
(menu-entries (map boot-parameters->menu-entry boot-parameters))
(bootcfg (operating-system-bootcfg os menu-entries))
(bootcfg-file (bootloader-configuration-file bootloader)))
(machine-remote-eval machine (remote-exp installer bootcfg bootcfg-file)))))
(define (deploy-managed-host machine)
"Internal implementation of 'deploy-machine' for MACHINE instances with an
environment type of 'managed-host."
(maybe-raise-unsupported-configuration-error machine)
(mbegin %store-monad
(switch-to-system machine)
(upgrade-shepherd-services machine)
(install-bootloader machine)))
;;;
;;; Environment type.
;;;
(define managed-host-environment-type
(environment-type
(machine-remote-eval managed-host-remote-eval)
(deploy-machine deploy-managed-host)
(name 'managed-host-environment-type)
(description "Provisioning for machines that are accessable over SSH
and have a known host-name. This entails little more than maintaining an SSH
connection to the host.")))
(define (maybe-raise-unsupported-configuration-error machine)
"Raise an error if MACHINE's configuration is not an instance of
<machine-ssh-configuration>."
(let ((config (machine-configuration machine))
(environment (environment-type-name (machine-environment machine))))
(unless (and config (machine-ssh-configuration? config))
(raise (condition
(&message
(message (format #f (G_ "unsupported machine configuration '~a'
for environment of type '~a'")
config
environment))))))))

42
gnu/packages/admin.scm
View File

@ -371,7 +371,7 @@ application (for console or X terminals) and requires ncurses.")
(define-public pies (define-public pies
(package (package
(name "pies") (name "pies")
(version "1.3") (version "1.4")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -379,7 +379,7 @@ application (for console or X terminals) and requires ncurses.")
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"12r7rjjyibjdj08dvwbp0iflfpzl4s0zhn6cr6zj3hwf9gbzgl1g")))) "14jb4pa4zs26d5j2skxbaypnwhsx2lw8jgj1irrgs03c2dnf7gp6"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:phases (modify-phases %standard-phases '(#:phases (modify-phases %standard-phases
@ -388,7 +388,7 @@ application (for console or X terminals) and requires ncurses.")
;; Use the right shell when executing user-provided ;; Use the right shell when executing user-provided
;; shell commands. ;; shell commands.
(let ((bash (assoc-ref inputs "bash"))) (let ((bash (assoc-ref inputs "bash")))
(substitute* "src/progman.c" (substitute* '("src/progman.c" "src/comp.c")
(("\"/bin/sh\"") (("\"/bin/sh\"")
(string-append "\"" bash "/bin/sh\""))) (string-append "\"" bash "/bin/sh\"")))
#t)))))) #t))))))
@ -1422,7 +1422,7 @@ module slots, and the list of I/O ports (e.g. serial, parallel, USB).")
(define-public acpica (define-public acpica
(package (package
(name "acpica") (name "acpica")
(version "20190509") (version "20190703")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -1430,7 +1430,7 @@ module slots, and the list of I/O ports (e.g. serial, parallel, USB).")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"17cf5jhcy9wqla5c9s08khqg0pxhar2nmwdcja2jf2srl2a5y2w6")))) "0kp3ian3lffx9709ajrr3bp6b9cb6c6v1crjziyr8j8pp639jlwz"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("flex" ,flex) (native-inputs `(("flex" ,flex)
("bison" ,bison))) ("bison" ,bison)))
@ -1517,20 +1517,20 @@ characters can be replaced as well, as can UTF-8 characters.")
(define-public testdisk (define-public testdisk
(package (package
(name "testdisk") (name "testdisk")
(version "7.0") (version "7.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://www.cgsecurity.org/testdisk-" (uri (string-append "https://www.cgsecurity.org/testdisk-"
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"0ba4wfz2qrf60vwvb1qsq9l6j0pgg81qgf7fh22siaz649mkpfq0")))) "1zlh44w67py416hkvw6nrfmjickc2d43v51vcli5p374d5sw84ql"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("ntfs-3g" ,ntfs-3g) `(("ntfs-3g" ,ntfs-3g)
("util-linux" ,util-linux) ("util-linux" ,util-linux)
("openssl" ,openssl) ("openssl" ,openssl)
;; FIXME: add reiserfs ;; FIXME: add reiserfs.
("zlib" ,zlib) ("zlib" ,zlib)
("e2fsprogs" ,e2fsprogs) ("e2fsprogs" ,e2fsprogs)
("libjpeg" ,libjpeg) ("libjpeg" ,libjpeg)
@ -2462,7 +2462,7 @@ in order to be able to find it.
(define-public sedsed (define-public sedsed
(package (package
(name "sedsed") (name "sedsed")
(version "1.0") (version "1.1")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -2471,11 +2471,10 @@ in order to be able to find it.
(commit (string-append "v" version)))) (commit (string-append "v" version))))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "0009lsjsxhqmgaklpwq15hhd94hpiy7r4va69yy0ig3mxi6zbg2z")))) (base32 "05cl35mwljdb9ynbbsfa8zx6ig8r0xncbg2cir9vwn5manndjj18"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:tests? #f ; no tests `(#:tests? #f ; no tests
#:python ,python-2
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'unpack 'patch-sed-in (add-after 'unpack 'patch-sed-in
@ -2492,29 +2491,30 @@ in order to be able to find it.
;; Just one file to copy around ;; Just one file to copy around
(install-file "sedsed.py" bin) (install-file "sedsed.py" bin)
#t))) #t)))
(add-after 'install 'symlink (add-after 'wrap 'symlink
;; Create 'sedsed' symlink to "sedsed.py". ;; Create 'sedsed' symlink to "sedsed.py".
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin")) (bin (string-append out "/bin"))
(sed (string-append bin "/sedsed")) (sed (string-append bin "/sedsed"))
(sedpy (string-append bin "/sedsed.py"))) (sedpy (string-append bin "/sedsed.py")))
(symlink sedpy sed) (symlink sedpy sed)
#t)))))) #t))))))
(home-page "http://aurelio.net/projects/sedsed") (home-page "https://aurelio.net/projects/sedsed")
(synopsis "Sed sed scripts") (synopsis "Sed sed scripts")
(description (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 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 all the commands and parameters identified for your viewing pleasure.
With sedsed you can master any sed script. No more secrets, no more hidden With sedsed you can master any sed script. No more secrets, no more hidden

16
gnu/packages/algebra.scm
View File

@ -298,6 +298,20 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
(license license:gpl2) (license license:gpl2)
(home-page "https://pari.math.u-bordeaux.fr/"))) (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 (define-public cmh
(package (package
(name "cmh") (name "cmh")
@ -316,7 +330,7 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
("mpfr" ,mpfr) ("mpfr" ,mpfr)
("mpc" ,mpc) ("mpc" ,mpc)
("mpfrcx" ,mpfrcx) ("mpfrcx" ,mpfrcx)
("fplll" ,fplll) ("fplll" ,fplll-4-cmh)
("pari-gp" ,pari-gp))) ("pari-gp" ,pari-gp)))
(synopsis "Igusa class polynomial computations") (synopsis "Igusa class polynomial computations")
(description (description

6
gnu/packages/bioconductor.scm
View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016, 2017, 2018 Roel Janssen <roel@gnu.org> ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -652,7 +652,7 @@ database is exposed as a @code{TxDb} object.")
(define-public r-txdb-mmusculus-ucsc-mm10-knowngene (define-public r-txdb-mmusculus-ucsc-mm10-knowngene
(package (package
(name "r-txdb-mmusculus-ucsc-mm10-knowngene") (name "r-txdb-mmusculus-ucsc-mm10-knowngene")
(version "3.4.4") (version "3.4.7")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
;; We cannot use bioconductor-uri here because this tarball is ;; We cannot use bioconductor-uri here because this tarball is
@ -663,7 +663,7 @@ database is exposed as a @code{TxDb} object.")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"01lgxc1fx5nhlpbwjd5zqghkkbmh6axd98ikx4b0spv0jdg6gf39")))) "04impkl8zh1gpwwrpbf19jqznsjrq2306yyhm6cmx6hr1401bd6b"))))
(properties (properties
`((upstream-name . "TxDb.Mmusculus.UCSC.mm10.knownGene"))) `((upstream-name . "TxDb.Mmusculus.UCSC.mm10.knownGene")))
(build-system r-build-system) (build-system r-build-system)

33
gnu/packages/bioinformatics.scm
View File

@ -7237,25 +7237,6 @@ BLAST, KEGG, GenBank, MEDLINE and GO.")
;; (LGPLv2.1+) and scripts in samples (which have GPL2 and GPL2+) ;; (LGPLv2.1+) and scripts in samples (which have GPL2 and GPL2+)
(license (list license:ruby license:lgpl2.1+ license: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 (define-public r-biocviews
(package (package
(name "r-biocviews") (name "r-biocviews")
@ -13622,10 +13603,10 @@ sequencing data.")
(define-public r-xbioc (define-public r-xbioc
(let ((revision "1") (let ((revision "1")
(commit "f798c187e376fd1ba27abd559f47bbae7e3e466b")) (commit "6ff0670a37ab3036aaf1d94aa4b208310946b0b5"))
(package (package
(name "r-xbioc") (name "r-xbioc")
(version (git-version "0.1.15" revision commit)) (version (git-version "0.1.16" revision commit))
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -13634,13 +13615,13 @@ sequencing data.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"03hffh2f6z71y6l6dqpa5cql3hdaw7zigdi8sm2dzgx379k9rgrr")))) "0w8bsq5myiwkfhh83nm6is5ichiyvwa1axx2szvxnzq39x6knf66"))))
(build-system r-build-system) (build-system r-build-system)
(propagated-inputs (propagated-inputs
`(("r-annotationdbi" ,r-annotationdbi) `(("r-annotationdbi" ,r-annotationdbi)
("r-assertthat" ,r-assertthat) ("r-assertthat" ,r-assertthat)
("r-biobase" ,r-biobase) ("r-biobase" ,r-biobase)
("r-biocinstaller" ,r-biocinstaller) ("r-biocmanager" ,r-biocmanager)
("r-digest" ,r-digest) ("r-digest" ,r-digest)
("r-pkgmaker" ,r-pkgmaker) ("r-pkgmaker" ,r-pkgmaker)
("r-plyr" ,r-plyr) ("r-plyr" ,r-plyr)
@ -14067,11 +14048,11 @@ choosing which reads pass the filter.")
;; <https://github.com/jts/nanopolish#installing-a-particular-release>. ;; <https://github.com/jts/nanopolish#installing-a-particular-release>.
;; Also, the differences between release and current version seem to be ;; Also, the differences between release and current version seem to be
;; significant. ;; significant.
(let ((commit "50e8b5cc62f9b46f5445f5c5e8c5ab7263ea6d9d") (let ((commit "6331dc4f15b9dfabb954ba3fae9d76b6c3ca6377")
(revision "1")) (revision "1"))
(package (package
(name "nanopolish") (name "nanopolish")
(version (git-version "0.10.2" revision commit)) (version (git-version "0.11.1" revision commit))
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -14081,7 +14062,7 @@ choosing which reads pass the filter.")
(recursive? #t))) (recursive? #t)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "09j5gz57yr9i34a27vbl72i4g8syv2zzgmsfyjq02yshmnrvkjs6")) (base32 "15ikl3d37y49pwd7vx36xksgsqajhf24q7qqsnpl15dqqyy5qgbc"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin

28
gnu/packages/bootloaders.scm
View File

@ -82,19 +82,22 @@
(define-public grub (define-public grub
(package (package
(name "grub") (name "grub")
(version "2.02") (version "2.04")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/grub/grub-" version ".tar.xz")) (uri (string-append "mirror://gnu/grub/grub-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"03vvdfhdmf16121v7xs8is2krwnv15wpkhkf16a4yf8nsfc3f2w1")) "0zgp5m3hmc9jh8wpjx6czzkh5id2y8n1k823x2mjvm2sk6b28ag5"))
(patches (search-patches "grub-check-error-efibootmgr.patch" (patches (search-patches "grub-efi-fat-serial-number.patch"))))
"grub-binutils-compat.patch"
"grub-efi-fat-serial-number.patch"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (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 (add-after 'unpack 'patch-stuff
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
(substitute* "grub-core/Makefile.in" (substitute* "grub-core/Makefile.in"
@ -127,6 +130,14 @@
(substitute* "Makefile.in" (substitute* "Makefile.in"
(("grub_cmd_date grub_cmd_set_date grub_cmd_sleep") (("grub_cmd_date grub_cmd_set_date grub_cmd_sleep")
"grub_cmd_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))) #t)))
;; Disable tests on ARM and AARCH64 platforms. ;; Disable tests on ARM and AARCH64 platforms.
#:tests? ,(not (any (cute string-prefix? <> (or (%current-target-system) #:tests? ,(not (any (cute string-prefix? <> (or (%current-target-system)
@ -147,9 +158,12 @@
;; for generating alternative keyboard layouts. ;; for generating alternative keyboard layouts.
("console-setup" ,console-setup) ("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) ("freetype" ,freetype)
;; ("libusb" ,libusb) ;; ("libusb" ,libusb)
;; ("fuse" ,fuse)
("ncurses" ,ncurses))) ("ncurses" ,ncurses)))
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config) `(("pkg-config" ,pkg-config)

6
gnu/packages/chromium.scm
View File

@ -756,9 +756,9 @@ from forcing GEXP-PROMISE."
("valgrind" ,valgrind) ("valgrind" ,valgrind)
("vulkan-headers" ,vulkan-headers))) ("vulkan-headers" ,vulkan-headers)))
;; Building Chromium with a single core takes around 6 hours on an x86_64 ;; Building Chromium takes ... a very long time. On a single core, a busy
;; system. Give some leeway for slower or busy machines. ;; mid-end x86 system may need more than 24 hours to complete the build.
(properties '((timeout . 64800))) ;18 hours (properties '((timeout . 144000))) ;40 hours
(home-page "https://github.com/Eloston/ungoogled-chromium") (home-page "https://github.com/Eloston/ungoogled-chromium")
(description (description

27
gnu/packages/databases.scm
View File

@ -36,6 +36,7 @@
;;; Copyright © 2019 Jack Hill <jackhill@jackhill.us> ;;; Copyright © 2019 Jack Hill <jackhill@jackhill.us>
;;; Copyright © 2019 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2019 Gábor Boskovits <boskovits@gmail.com> ;;; Copyright © 2019 Gábor Boskovits <boskovits@gmail.com>
;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -92,6 +93,7 @@
#:use-module (gnu packages popt) #:use-module (gnu packages popt)
#:use-module (gnu packages python) #:use-module (gnu packages python)
#:use-module (gnu packages python-crypto) #:use-module (gnu packages python-crypto)
#:use-module (gnu packages python-web)
#:use-module (gnu packages python-xyz) #:use-module (gnu packages python-xyz)
#:use-module (gnu packages rdf) #:use-module (gnu packages rdf)
#:use-module (gnu packages readline) #:use-module (gnu packages readline)
@ -864,14 +866,14 @@ pictures, sounds, or video.")
(package (package
(inherit postgresql) (inherit postgresql)
(name "postgresql") (name "postgresql")
(version "9.6.13") (version "9.6.14")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://ftp.postgresql.org/pub/source/v" (uri (string-append "https://ftp.postgresql.org/pub/source/v"
version "/postgresql-" version ".tar.bz2")) version "/postgresql-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"197964wb5pc5fx81a6mh9hlcrr9sgr3nqlpmljv6asi9aq0d5gpc")))))) "08hsqczy1ixkjyf2vr3s9x69agfz9yr8lh31fir4z0dfr5jw421z"))))))
(define-public python-pymysql (define-public python-pymysql
(package (package
@ -3080,3 +3082,24 @@ NumPy, and other traditional Python scientific computing packages.")
(define-public python2-pyarrow (define-public python2-pyarrow
(package-with-python2 python-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)))

4
gnu/packages/dictionaries.scm
View File

@ -218,7 +218,7 @@ It comes with a German-English dictionary with approximately 270,000 entries.")
(define-public grammalecte (define-public grammalecte
(package (package
(name "grammalecte") (name "grammalecte")
(version "1.1.1") (version "1.2")
(source (source
(origin (origin
(method url-fetch/zipbomb) (method url-fetch/zipbomb)
@ -226,7 +226,7 @@ It comes with a German-English dictionary with approximately 270,000 entries.")
"Grammalecte-fr-v" version ".zip")) "Grammalecte-fr-v" version ".zip"))
(sha256 (sha256
(base32 (base32
"1al4c3976wgxijxghxqb1banarj82hwad51kln87xj2r5kwcfm05")))) "0dwizai6w9yn617y7cnqdiwv77vn22p18s9sypypbl1bl695cnma"))))
(build-system python-build-system) (build-system python-build-system)
(home-page "https://grammalecte.net") (home-page "https://grammalecte.net")
(synopsis "French spelling and grammar checker") (synopsis "French spelling and grammar checker")

4
gnu/packages/disk.scm
View File

@ -14,6 +14,7 @@
;;; Copyright © 2018 Rutger Helling <rhelling@mykolab.com> ;;; Copyright © 2018 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz> ;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2019 Leo Famulari <leo@famulari.name> ;;; Copyright © 2019 Leo Famulari <leo@famulari.name>
;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -236,7 +237,8 @@ to recover data more efficiently by only reading the necessary blocks.")
"0wy13i3i4x2bw1hf5m4fd0myh61f9bcrs035fdlf6gyc1jksrcp6")))) "0wy13i3i4x2bw1hf5m4fd0myh61f9bcrs035fdlf6gyc1jksrcp6"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:make-flags (list (string-append "PREFIX=" %output) `(#:configure-flags (list "--enable-compat-symlinks")
#:make-flags (list (string-append "PREFIX=" %output)
"CC=gcc"))) "CC=gcc")))
(native-inputs (native-inputs
`(("xxd" ,xxd))) ; for tests `(("xxd" ,xxd))) ; for tests

4
gnu/packages/education.scm
View File

@ -250,7 +250,7 @@ easy.")
(define-public snap (define-public snap
(package (package
(name "snap") (name "snap")
(version "5") (version "5.0.1")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -260,7 +260,7 @@ easy.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0bh52n7nklaaq02qb56v7bvrslf047my6irl7g8h6xfjgw04yf20")))) "0ic0xgal19yazbd1kffmbjhiicvvlw5clj48lj80mksa2lgvnzna"))))
(build-system trivial-build-system) (build-system trivial-build-system)
(arguments (arguments
`(#:modules ((guix build utils)) `(#:modules ((guix build utils))

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

@ -2225,18 +2225,20 @@ display and behaviour is easily customisable.")
(define-public emacs-git-timemachine (define-public emacs-git-timemachine
(package (package
(name "emacs-git-timemachine") (name "emacs-git-timemachine")
(version "4.5") (version "4.10")
(source (source
(origin (origin
(method url-fetch) (method git-fetch)
(uri (string-append "https://gitlab.com/pidu/git-timemachine" (uri (git-reference
"/-/archive/" version (url "https://gitlab.com/pidu/git-timemachine.git")
"/git-timemachine-" version ".tar.gz")) (commit version)))
(file-name (string-append name "-" version ".tar.gz")) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0ii40qcincasg7s1yrvqcxkqcqzb4sfs7gcxscn6m4x4ans165zy")))) "08zsn3lsnnf01wkv5ls38jga02s5dnf0j3gigy4qd6im3j3d04m1"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(propagated-inputs
`(("emacs-transient" ,emacs-transient)))
(home-page "https://gitlab.com/pidu/git-timemachine") (home-page "https://gitlab.com/pidu/git-timemachine")
(synopsis "Step through historic versions of Git-controlled files") (synopsis "Step through historic versions of Git-controlled files")
(description "This package enables you to step through historic versions (description "This package enables you to step through historic versions
@ -2575,7 +2577,7 @@ as horizontal rules.")
(define-public emacs-simple-httpd (define-public emacs-simple-httpd
(package (package
(name "emacs-simple-httpd") (name "emacs-simple-httpd")
(version "1.4.6") (version "1.5.1")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -2584,9 +2586,9 @@ as horizontal rules.")
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "1qmkc0w28l53zzf5yd2grrk1sq222g5qnsm35ph25s1cfvc1qb2g")))) (base32 "0dpn92rg813c4pq7a1vzj3znyxzp2lmvxqz6pzcqi0l2xn5r3wvb"))))
(build-system emacs-build-system) (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") (synopsis "HTTP server in pure Emacs Lisp")
(description (description
"This package provides a simple HTTP server written in Emacs Lisp to "This package provides a simple HTTP server written in Emacs Lisp to
@ -2596,7 +2598,7 @@ serve files and directory listings.")
(define-public emacs-skewer-mode (define-public emacs-skewer-mode
(package (package
(name "emacs-skewer-mode") (name "emacs-skewer-mode")
(version "1.6.2") (version "1.8.0")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -2605,7 +2607,7 @@ serve files and directory listings.")
(commit version))) (commit version)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "05jndz0c26q60s416vqgvr66axdmxb7qsr2g70fvl5iqavnayhpv")))) (base32 "1ha7jl7776pk1bki5zj2q0jy66450mn8xr3aqjc0m9kj3gc9qxgw"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(propagated-inputs (propagated-inputs
`(("emacs-simple-httpd" ,emacs-simple-httpd) `(("emacs-simple-httpd" ,emacs-simple-httpd)
@ -4075,6 +4077,30 @@ organizer.")
It is built on top of the custom theme support in Emacs 24 or later.") It is built on top of the custom theme support in Emacs 24 or later.")
(license license:gpl3+))) (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 (define-public emacs-solarized-theme
(package (package
(name "emacs-solarized-theme") (name "emacs-solarized-theme")
@ -4523,7 +4549,7 @@ fully-functional one.")
(define-public emacs-hydra (define-public emacs-hydra
(package (package
(name "emacs-hydra") (name "emacs-hydra")
(version "0.14.0") (version "0.15.0")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -4533,7 +4559,7 @@ fully-functional one.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0ln4z2796ycy33g5jcxkqvm7638qxy4sipsab7d2864hh700cikg")))) "0fapvhmhgc9kppf3bvkgry0cd7gyilg7sfvlscfrfjxpx4xvwsfy"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "https://github.com/abo-abo/hydra") (home-page "https://github.com/abo-abo/hydra")
(synopsis "Make Emacs bindings that stick around") (synopsis "Make Emacs bindings that stick around")
@ -4757,25 +4783,26 @@ a temporary @code{keep-lines} or @code{occur}.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-zoutline (define-public emacs-zoutline
(let ((commit "b3ee0f0e0b916838c2d2c249beba74ffdb8d5699") (package
(revision "0")) (name "emacs-zoutline")
(package (version "0.2.0")
(name "emacs-zoutline") (source
(version (git-version "0.1" revision commit)) (origin
(home-page "https://github.com/abo-abo/zoutline") (method git-fetch)
(source (origin (uri (git-reference
(method git-fetch) (url "https://github.com/abo-abo/zoutline")
(uri (git-reference (url home-page) (commit commit))) (commit version)))
(sha256 (sha256
(base32 (base32
"0sd0017piw0dis6dhpq5dkqd3acisxqgipl7dj8gmc1vnswhdwr8")) "1w0zh6vs7klgivq5r030a82mcfg1zwic4x3fimyiqyg5n8p67hyx"))
(file-name (git-file-name name version)))) (file-name (git-file-name name version))))
(build-system emacs-build-system) (build-system emacs-build-system)
(synopsis "Simple outline library") (home-page "https://github.com/abo-abo/zoutline")
(description (synopsis "Simple outline library")
"This library provides helpers for outlines. Outlines allow users to (description
"This library provides helpers for outlines. Outlines allow users to
navigate code in a tree-like fashion.") navigate code in a tree-like fashion.")
(license license:gpl3+)))) (license license:gpl3+)))
(define-public emacs-lispy (define-public emacs-lispy
(package (package
@ -4835,6 +4862,36 @@ keybinding style. The provided commands allow for editing Lisp in normal
state and will work even without lispy being enabled.") state and will work even without lispy being enabled.")
(license license:gpl3+)))) (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 (define-public emacs-clojure-mode
(package (package
(name "emacs-clojure-mode") (name "emacs-clojure-mode")
@ -6103,28 +6160,33 @@ Emacs that Evil does not cover properly by default, such as @code{help-mode},
(license license:gpl3+)))) (license license:gpl3+))))
(define-public emacs-goto-chg (define-public emacs-goto-chg
(package (let ((commit "1829a13026c597e358f716d2c7793202458120b5")
(name "emacs-goto-chg") (version "1.7.3")
(version "1.6") (revision "1"))
(source (package
(origin (name "emacs-goto-chg")
(method url-fetch) (version (git-version version revision commit))
;; There is no versioned source. (source
(uri "https://www.emacswiki.org/emacs/download/goto-chg.el") (origin
(file-name (string-append "goto-chg-" version ".el")) (method git-fetch)
(sha256 (uri (git-reference
(base32 (url "https://github.com/emacs-evil/goto-chg")
"078d6p4br5vips7b9x4v6cy0wxf6m5ij9gpqd4g33bryn22gnpij")))) (commit commit)))
(build-system emacs-build-system) (file-name (git-file-name name version))
;; There is no other home page. (sha256
(home-page "https://www.emacswiki.org/emacs/goto-chg.el") (base32
(synopsis "Go to the last change in the Emacs buffer") "1y603maw9xwdj3qiarmf1bp13461f9f5ackzicsbynl0i9la3qki"))))
(description (build-system emacs-build-system)
"This package provides @code{M-x goto-last-change} command that goes to (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, 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 go to the second most recent edit, etc. Negative argument, @kbd{C-u -}, is
used for reverse direction.") used for reverse direction.")
(license license:gpl2+))) (license license:gpl2+))))
(define-public emacs-janpath-evil-numbers (define-public emacs-janpath-evil-numbers
(let ((commit "d988041c1fe6e941dc8d591390750b237f71f524") (let ((commit "d988041c1fe6e941dc8d591390750b237f71f524")
@ -8321,13 +8383,13 @@ highlighting.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-restclient (define-public emacs-restclient
(let ((commit "07a3888bb36d0e29608142ebe743b4362b800f40") (let ((commit "422ee8d8b077dffe65706a0f027ed700b84746bc")
(revision "1")) ;Guix package revision, (version "0")
(revision "2")) ;Guix package revision,
;upstream doesn't have official releases ;upstream doesn't have official releases
(package (package
(name "emacs-restclient") (name "emacs-restclient")
(version (string-append revision "." (version (git-version version revision commit))
(string-take commit 7)))
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -8335,7 +8397,7 @@ highlighting.")
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"00lmjhb5im1kgrp54yipf1h9pshxzgjlg71yf2rq5n973gvb0w0q")) "067nin7vxkdpffxa0q61ybv7szihhvpdinivmci9qkbb86rs9kkz"))
(file-name (git-file-name name version)))) (file-name (git-file-name name version))))
(build-system emacs-build-system) (build-system emacs-build-system)
(propagated-inputs (propagated-inputs
@ -9168,33 +9230,25 @@ contexts.
(define-public emacs-polymode (define-public emacs-polymode
(package (package
(name "emacs-polymode") (name "emacs-polymode")
(version "0.1.5") (version "0.2")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
(url "https://github.com/vspinu/polymode.git") (url "https://github.com/polymode/polymode.git")
(commit (string-append "v" version)))) (commit (string-append "v" version))))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0wwphs54jx48a3ca6x1qaz56j3j9bg4mv8g2akkffrzbdcb8sbc7")))) "04v0gnzfsjb50bgly6kvpryx8cyzwjaq2llw4qv9ijw1l6ixmq3b"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(arguments (home-page "https://github.com/polymode/polymode")
`(#: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")
(synopsis "Framework for multiple Emacs modes based on indirect buffers") (synopsis "Framework for multiple Emacs modes based on indirect buffers")
(description "Polymode is an Emacs package that offers generic support (description
for multiple major modes inside a single Emacs buffer. It is lightweight, "Polymode is an Emacs package that offers generic support for multiple
object oriented and highly extensible. Creating a new polymode typically major modes inside a single Emacs buffer. It is lightweight, object oriented
takes only a few lines of code. Polymode also provides extensible facilities and highly extensible. Creating a new polymode typically takes only a few
for external literate programming tools for exporting, weaving and tangling.") lines of code. Polymode also provides extensible facilities for external
literate programming tools for exporting, weaving and tangling.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-polymode-ansible (define-public emacs-polymode-ansible
@ -9226,6 +9280,33 @@ for external literate programming tools for exporting, weaving and tangling.")
"Edit YAML files for Ansible containing embedded Jinja2 templating.") "Edit YAML files for Ansible containing embedded Jinja2 templating.")
(license license:gpl3+)))) (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 (define-public eless
(package (package
(name "eless") (name "eless")
@ -10675,33 +10756,30 @@ navigate and display hierarchy structures.")
(license license:gpl3+)))) (license license:gpl3+))))
(define-public emacs-md4rd (define-public emacs-md4rd
(let ((commit "c55512c2f7680db2a1e73db6bdf93adecaf40fec") (package
(revision "1")) (name "emacs-md4rd")
(package (version "0.3.1")
(name "emacs-md4rd") (source (origin
(version (string-append "0.0.2" "-" revision "." (method git-fetch)
(string-take commit 7))) (uri (git-reference
(source (origin (url "https://github.com/ahungry/md4rd.git")
(method git-fetch) (commit version)))
(uri (git-reference (file-name (git-file-name name version))
(url "https://github.com/ahungry/md4rd.git") (sha256
(commit commit))) (base32
(file-name (git-file-name name version)) "1n6g6k4adzkkn1g7z4j27s35xy12c1fg2r08gv345ddr3wplq4ri"))))
(sha256 (propagated-inputs
(base32 `(("emacs-hierarchy" ,emacs-hierarchy)
"0mvv1mvsrpkrmikcpfqf2zbawnzgq33j6zjdrlv48mcw57xb2ak9")))) ("emacs-request" ,emacs-request)
(propagated-inputs ("emacs-dash" ,emacs-dash)
`(("emacs-hierarchy" ,emacs-hierarchy) ("emacs-s" ,emacs-s)
("emacs-request" ,emacs-request) ("emacs-tree-mode" ,emacs-tree-mode)))
("emacs-dash" ,emacs-dash) (build-system emacs-build-system)
("emacs-s" ,emacs-s) (home-page "https://github.com/ahungry/md4rd")
("emacs-tree-mode" ,emacs-tree-mode))) (synopsis "Emacs Mode for Reddit")
(build-system emacs-build-system) (description
(home-page "https://github.com/ahungry/md4rd") "This package allows to read Reddit from within Emacs interactively.")
(synopsis "Emacs Mode for Reddit") (license license:gpl3+)))
(description
"This package allows to read Reddit from within Emacs interactively.")
(license license:gpl3+))))
(define-public emacs-pulseaudio-control (define-public emacs-pulseaudio-control
(let ((commit "7e1a87068379075a5e9ce36c64c686c03d20d379") (let ((commit "7e1a87068379075a5e9ce36c64c686c03d20d379")
@ -12265,12 +12343,10 @@ bookmarks and history.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-stumpwm-mode (define-public emacs-stumpwm-mode
(let ((commit "8fbe071d2c6c040794060a354eb377218dc10b35") (let ((commit "5328f85fbf6a8b08c758c17b9435368bf7a68f39"))
(revision "1"))
(package (package
(name "emacs-stumpwm-mode") (name "emacs-stumpwm-mode")
(version (string-append "0.0.1-" revision "." (version (git-version "0.0.1" "1" commit))
(string-take commit 7)))
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -12279,7 +12355,7 @@ bookmarks and history.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"1dfwsvz1c8w6j4jp0kzaz78ml3f5dp0a5pvf090kwpbpg176r7iq")))) "00kf4k8bqadi5s667wb96sn549v2kvw01zwszjrg7nhd805m1ng6"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -12552,7 +12628,7 @@ the current upstream.")
(define-public emacs-company-restclient (define-public emacs-company-restclient
(package (package
(name "emacs-company-restclient") (name "emacs-company-restclient")
(version "0.1.0") (version "0.3.0")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -12561,7 +12637,7 @@ the current upstream.")
(commit (string-append "v" version)))) (commit (string-append "v" version))))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 "0i1fh5lvqwlgn3g3fzh0xacxyljx6gkryipn133vfkv4jbns51n4")))) (base32 "0yp0hlrgcr6yy1xkjvfckys2k24x9xg7y6336ma61bdwn5lpv0x0"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(propagated-inputs (propagated-inputs
`(("emacs-company" ,emacs-company) `(("emacs-company" ,emacs-company)
@ -13051,14 +13127,14 @@ cohesion with the Emacs Way.")
(version "1.1") (version "1.1")
(source (source
(origin (origin
(method url-fetch) (method git-fetch)
(uri (string-append (uri (git-reference
"https://gitlab.com/Ambrevar/emacs-fish-completion/repository/" (url "https://gitlab.com/Ambrevar/emacs-fish-completion.git")
"archive.tar.gz?ref=" (commit version)))
version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0bpvifv6c2a65nks6kvarw0hhm37fnyy74wikwf9qq1i20va0fpv")))) "1pjqnbyjmj64q5nwq1mrdxcls4fp5y0b6zqs785i0s6wdvrm4021"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(inputs `(("fish" ,fish))) (inputs `(("fish" ,fish)))
(arguments (arguments
@ -13069,6 +13145,7 @@ cohesion with the Emacs Way.")
(let ((fish (assoc-ref inputs "fish"))) (let ((fish (assoc-ref inputs "fish")))
;; Specify the absolute file names of the various ;; Specify the absolute file names of the various
;; programs so that everything works out-of-the-box. ;; programs so that everything works out-of-the-box.
(make-file-writable "fish-completion.el")
(emacs-substitute-variables (emacs-substitute-variables
"fish-completion.el" "fish-completion.el"
("fish-completion-command" ("fish-completion-command"
@ -14912,18 +14989,18 @@ opposed to character-based).")
(package (package
(name "emacs-disk-usage") (name "emacs-disk-usage")
(version "1.3.3") (version "1.3.3")
(home-page "https://gitlab.com/Ambrevar/emacs-disk-usage")
(source (source
(origin (origin
(method url-fetch) (method git-fetch)
(uri (string-append (uri (git-reference
"https://elpa.gnu.org/packages/disk-usage-" (url "https://gitlab.com/Ambrevar/emacs-disk-usage.git")
version (commit version)))
".el")) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0h1jwznd41gi0vg830ilfgm01q05zknikzahwasm9cizwm2wyizj")))) "0hv2gsd8k5fbjgckgiyisq4rn1i7y4rchbjy8kmixjv6mx563bll"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "https://gitlab.com/Ambrevar/emacs-disk-usage")
(synopsis "Sort and browse disk usage listings with Emacs") (synopsis "Sort and browse disk usage listings with Emacs")
(description "Disk Usage is a file system analyzer: it offers a tabulated (description "Disk Usage is a file system analyzer: it offers a tabulated
view of file listings sorted by size. Directory sizes are computed view of file listings sorted by size. Directory sizes are computed

4
gnu/packages/game-development.scm
View File

@ -1434,7 +1434,9 @@ joystick support.")))
"plib-" version ".tar.gz")) "plib-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0cha71mflpa10vh2l7ipyqk67dq2y0k5xbafwdks03fwdyzj4ns8")))) "0cha71mflpa10vh2l7ipyqk67dq2y0k5xbafwdks03fwdyzj4ns8"))
(patches (search-patches "plib-CVE-2011-4620.patch"
"plib-CVE-2012-4552.patch"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("mesa" ,mesa) `(("mesa" ,mesa)

10
gnu/packages/gnome.scm
View File

@ -5012,7 +5012,6 @@ to display dialog boxes from the commandline and shell scripts.")
("cairo" ,cairo) ("cairo" ,cairo)
("gdk-pixbuf" ,gdk-pixbuf) ("gdk-pixbuf" ,gdk-pixbuf)
("glib" ,glib) ("glib" ,glib)
("gtk+" ,gtk+)
("json-glib" ,json-glib) ("json-glib" ,json-glib)
("libinput" ,libinput) ("libinput" ,libinput)
("libx11" ,libx11) ("libx11" ,libx11)
@ -7206,7 +7205,7 @@ is suitable as a default application in a Desktop environment.")
("intltool" ,intltool) ("intltool" ,intltool)
("pkg-config" ,pkg-config))) ("pkg-config" ,pkg-config)))
(inputs (inputs
`(("gtksourceview" ,gtksourceview) `(("gtksourceview" ,gtksourceview-3)
("libsm" ,libsm))) ("libsm" ,libsm)))
(home-page "https://wiki.gnome.org/Apps/Xpad") (home-page "https://wiki.gnome.org/Apps/Xpad")
(synopsis "Virtual sticky note") (synopsis "Virtual sticky note")
@ -7572,16 +7571,16 @@ views can be printed as PDF or PostScript files, or exported to HTML.")
(define-public lollypop (define-public lollypop
(package (package
(name "lollypop") (name "lollypop")
(version "0.9.521") (version "1.1.3.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://gitlab.gnome.org/World/lollypop/uploads/" (uri (string-append "https://gitlab.gnome.org/World/lollypop/uploads/"
"e4df2ed75c5ed71d64afcc668e579b2a/" "5a7cd7c72b6d83ae08d0c54c4691f9df/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0knsqh24siyw98vmiq6b1hzq4y4cazs9f1hq1js9c96hqqj9rvdx")))) "1r5wn0bja9psz6nr1rcaysdkkwz84rbyzpdfw66cxa6wiy52pkjm"))))
(build-system meson-build-system) (build-system meson-build-system)
(arguments (arguments
`(#:imported-modules ((guix build python-build-system) `(#:imported-modules ((guix build python-build-system)
@ -7614,6 +7613,7 @@ views can be printed as PDF or PostScript files, or exported to HTML.")
("python" ,python) ("python" ,python)
("python-beautifulsoup4" ,python-beautifulsoup4) ("python-beautifulsoup4" ,python-beautifulsoup4)
("python-gst" ,python-gst) ("python-gst" ,python-gst)
("python-pil" ,python-pillow)
("python-pycairo" ,python-pycairo) ("python-pycairo" ,python-pycairo)
("python-pygobject" ,python-pygobject) ("python-pygobject" ,python-pygobject)
("python-pylast" ,python-pylast) ("python-pylast" ,python-pylast)

6
gnu/packages/gnunet.scm
View File

@ -6,7 +6,7 @@
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016, 2017, 2018, 2019 ng0 <ng0@n0.is> ;;; 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> ;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -146,14 +146,14 @@ tool to extract metadata from a file and print the results.")
(define-public libmicrohttpd (define-public libmicrohttpd
(package (package
(name "libmicrohttpd") (name "libmicrohttpd")
(version "0.9.64") (version "0.9.65")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/libmicrohttpd/libmicrohttpd-" (uri (string-append "mirror://gnu/libmicrohttpd/libmicrohttpd-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"03imzkd1hl2mkkpi84vg5xq9x6b58gwsv86ym85km0lhb7nxi4p7")))) "1jdk6wigvnkh5bi9if4rik8i9sbvdql61lm8ipgpypyxqmcpjipj"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("curl" ,curl) `(("curl" ,curl)

24
gnu/packages/gnupg.scm
View File

@ -227,19 +227,21 @@ threads implementation.
In contrast to GNU Pth is is based on the system's standard threads In contrast to GNU Pth is is based on the system's standard threads
implementation. This allows the use of libraries which are not implementation. This allows the use of libraries which are not
compatible to GNU Pth.") 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 (define-public gnupg
(package (package
(name "gnupg") (name "gnupg")
(version "2.2.16") (version "2.2.17")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnupg/gnupg/gnupg-" version (uri (string-append "mirror://gnupg/gnupg/gnupg-" version
".tar.bz2")) ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1jqlzp9b3kpfp1dkjqskm67jjrhvf9nh3lzf45321p7m9d2qvgkc")))) "056mgy09lvsi03531a437qj58la1j2x1y1scvfi53diris3658mg"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("pkg-config" ,pkg-config)))
@ -404,7 +406,9 @@ Because the direct use of GnuPG from an application can be a complicated
programming task, it is suggested that all software should try to use GPGME 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 instead. This way bug fixes or improvements can be done at a central place
and every application benefits from this.") 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 (define-public qgpgme
(package (package
@ -550,14 +554,14 @@ decrypt messages using the OpenPGP format by making use of GPGME.")
(define-public python-gnupg (define-public python-gnupg
(package (package
(name "python-gnupg") (name "python-gnupg")
(version "0.4.3") (version "0.4.4")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "python-gnupg" version)) (uri (pypi-uri "python-gnupg" version))
(sha256 (sha256
(base32 (base32
"03dc8whhvk7ccspbk8vzfhkxli8cd9zfbss5p597g4jldgy8s59d")))) "03pvjyp6q9pr8qa22i38az06ddzhvzy5kj192hxa3gbhnchg1nj5"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -915,14 +919,14 @@ them to transform your existing public key into a secret key.")
(define-public gpa (define-public gpa
(package (package
(name "gpa") (name "gpa")
(version "0.9.10") (version "0.10.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnupg/gpa/" (uri (string-append "mirror://gnupg/gpa/"
name "-" version ".tar.bz2")) name "-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"09xphbi2456qynwqq5n0yh0zdmdi2ggrj3wk4hsyh5lrzlvcrff3")))) "1cbpc45f8qbdkd62p12s3q2rdq6fa5xdzwmcwd3xrj55bzkspnwm"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("pkg-config" ,pkg-config)))
@ -938,7 +942,9 @@ them to transform your existing public key into a secret key.")
"GPA, the GNU Privacy Assistant, is a graphical user interface for "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 @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.") 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 (define-public parcimonie
(package (package

9
gnu/packages/gnuzilla.scm
View File

@ -426,7 +426,7 @@ from forcing GEXP-PROMISE."
#:system system #:system system
#:guile-for-build guile))) #: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 ;; 'icecat-source' is a "computed" origin that generates an IceCat tarball
;; from the corresponding upstream Firefox ESR tarball, using the 'makeicecat' ;; from the corresponding upstream Firefox ESR tarball, using the 'makeicecat'
@ -448,7 +448,7 @@ from forcing GEXP-PROMISE."
"firefox-" upstream-firefox-version ".source.tar.xz")) "firefox-" upstream-firefox-version ".source.tar.xz"))
(sha256 (sha256
(base32 (base32
"1hkaq8mavmn2wphfbrlq3v56jvmvfi2nyvrkjgr28rc01jkqx4ca")))) "1gkz90clarbhgfxhq91s0is6lw6bfymyjb0xbyyswdg68kcqfcy1"))))
(upstream-icecat-base-version "60.7.0") ; maybe older than base-version (upstream-icecat-base-version "60.7.0") ; maybe older than base-version
(upstream-icecat-gnu-version "1") (upstream-icecat-gnu-version "1")
@ -627,7 +627,7 @@ from forcing GEXP-PROMISE."
("mesa" ,mesa) ("mesa" ,mesa)
("mit-krb5" ,mit-krb5) ("mit-krb5" ,mit-krb5)
;; See <https://bugs.gnu.org/32833> ;; 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! ("nspr" ,nspr)
;; UNBUNDLE-ME! ("nss" ,nss) ;; UNBUNDLE-ME! ("nss" ,nss)
("sqlite" ,sqlite) ("sqlite" ,sqlite)
@ -720,7 +720,8 @@ from forcing GEXP-PROMISE."
"--with-system-icu" "--with-system-icu"
;; See <https://bugs.gnu.org/32833> ;; 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-nspr"
;; UNBUNDLE-ME! "--with-system-nss" ;; UNBUNDLE-ME! "--with-system-nss"

4
gnu/packages/gps.scm
View File

@ -147,7 +147,7 @@ between two other data points.")
(define-public gama (define-public gama
(package (package
(name "gama") (name "gama")
(version "2.03") (version "2.06")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -155,7 +155,7 @@ between two other data points.")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0d33yyasnx54c6i40rkr9by4qv92rqb8wkmp5r46nz7bbp9kpymv")))) "06xp3kj099b6m2fsmgcbzgj7xk4j0drsps52m4fr8vc6fglsh44p"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments '(#:parallel-tests? #f)) ; race condition (arguments '(#:parallel-tests? #f)) ; race condition
(native-inputs (native-inputs

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

@ -2348,7 +2348,7 @@ more expressive and flexible than the traditional @code{format} procedure.")
("perl" ,perl) ("perl" ,perl)
("pkg-config" ,pkg-config) ("pkg-config" ,pkg-config)
("texinfo" ,texinfo) ("texinfo" ,texinfo)
("texlive" ,texlive))) ("texlive" ,(texlive-union (list texlive-generic-epsf)))))
(propagated-inputs (propagated-inputs
`(("dbus-glib" ,dbus-glib) `(("dbus-glib" ,dbus-glib)
("guile" ,guile-2.2) ("guile" ,guile-2.2)

30
gnu/packages/image.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2013, 2015, 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> ;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
@ -1032,6 +1032,34 @@ and XMP metadata of images in various formats.")
;; <https://launchpad.net/ubuntu/precise/+source/exiv2/+copyright>. ;; <https://launchpad.net/ubuntu/precise/+source/exiv2/+copyright>.
(license license:gpl2+))) (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 (define-public devil
(package (package
(name "devil") (name "devil")

22
gnu/packages/javascript.scm
View File

@ -2,7 +2,7 @@
;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr> ;;; 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> ;;; Copyright © 2018 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -417,32 +417,28 @@ external server.")
(define-public mujs (define-public mujs
(package (package
(name "mujs") (name "mujs")
(version "1.0.5") (version "1.0.6")
(source (origin (source (origin
(method git-fetch) (method url-fetch)
(uri (git-reference (uri (string-append "https://mujs.com/downloads/mujs-"
(url "https://git.ghostscript.com/mujs.git") version ".tar.xz"))
(commit version)))
(file-name (string-append name "-" version "-checkout"))
(sha256 (sha256
(base32 (base32
"0pkv26jxwgv5ax0ylfmi4h96h79hj4gvr95218ns8wngnmgr1ny6")))) "1q9w2dcspfp580pzx7sw7x9gbn8j0ak6dvj75wd1ml3f3q3i43df"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:phases '(#:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(delete 'configure) ; no configure (delete 'configure) ; no configure
(add-after 'install 'install-shared-library (add-after 'install 'install-shared-library
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key (make-flags '()) #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))) (apply invoke "make" "install-shared" make-flags))))
(install-file "build/release/libmujs.so"
(string-append out "/lib"))))))
#:make-flags (list (string-append "prefix=" (assoc-ref %outputs "out")) #:make-flags (list (string-append "prefix=" (assoc-ref %outputs "out"))
(string-append "CC=gcc")) (string-append "CC=gcc"))
#:tests? #f)) ; no tests #:tests? #f)) ; no tests
(inputs (inputs
`(("readline" ,readline))) `(("readline" ,readline)))
(home-page "https://artifex.com/mujs/") (home-page "https://mujs.com/")
(synopsis "JavaScript interpreter written in C") (synopsis "JavaScript interpreter written in C")
(description "MuJS is a lightweight Javascript interpreter designed for (description "MuJS is a lightweight Javascript interpreter designed for
embedding in other software to extend them with scripting capabilities. MuJS embedding in other software to extend them with scripting capabilities. MuJS

24
gnu/packages/linux.scm
View File

@ -421,8 +421,8 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
It has been modified to remove all non-free binary blobs.") It has been modified to remove all non-free binary blobs.")
(license license:gpl2))) (license license:gpl2)))
(define %linux-libre-version "5.1.16") (define %linux-libre-version "5.1.17")
(define %linux-libre-hash "055vs2g6z6wx34qvi0aw952x9q3drbj7z27s7g7pks6w730xkga8") (define %linux-libre-hash "049mij4z1iilrggw6plfdpcj1lnc1vqz5z445ix9677cq1fmiwlh")
(define %linux-libre-5.1-patches (define %linux-libre-5.1-patches
(list %boot-logo-patch (list %boot-logo-patch
@ -439,8 +439,8 @@ It has been modified to remove all non-free binary blobs.")
(make-linux-libre-headers %linux-libre-version (make-linux-libre-headers %linux-libre-version
%linux-libre-hash)) %linux-libre-hash))
(define %linux-libre-4.19-version "4.19.57") (define %linux-libre-4.19-version "4.19.58")
(define %linux-libre-4.19-hash "0p9b27hfbzppxgad9q2g7nvfzv0phzdsk16sqy87q3dglc8wqrqq") (define %linux-libre-4.19-hash "0i2mh0zk1h1niba1bpd49bn938sdn3qrwzkqpqzimxnj31xcjhyz")
(define %linux-libre-4.19-patches (define %linux-libre-4.19-patches
(list %boot-logo-patch (list %boot-logo-patch
@ -457,8 +457,8 @@ It has been modified to remove all non-free binary blobs.")
(make-linux-libre-headers %linux-libre-4.19-version (make-linux-libre-headers %linux-libre-4.19-version
%linux-libre-4.19-hash)) %linux-libre-4.19-hash))
(define %linux-libre-4.14-version "4.14.132") (define %linux-libre-4.14-version "4.14.133")
(define %linux-libre-4.14-hash "0mvp4izw21f8w5kkk8qm8m8b7qjxbp8hshgffdlh1aik41zvcnyq") (define %linux-libre-4.14-hash "16ay2x0r5i96lg4rgcg151352igvwxa7wh98kwdsjbckiw7fhn08")
(define-public linux-libre-4.14 (define-public linux-libre-4.14
(make-linux-libre %linux-libre-4.14-version (make-linux-libre %linux-libre-4.14-version
@ -471,14 +471,14 @@ It has been modified to remove all non-free binary blobs.")
%linux-libre-4.14-hash)) %linux-libre-4.14-hash))
(define-public linux-libre-4.9 (define-public linux-libre-4.9
(make-linux-libre "4.9.184" (make-linux-libre "4.9.185"
"0q3ggndwf0rwsb3xv33zl9awkd1803h2l9b4g6d6ps3f2sjxwxwa" "1byz9cxvslm45nv01abhzvrm2isdskx5k11gi5rpa39r7lx6bmjp"
'("x86_64-linux" "i686-linux") '("x86_64-linux" "i686-linux")
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define-public linux-libre-4.4 (define-public linux-libre-4.4
(make-linux-libre "4.4.184" (make-linux-libre "4.4.185"
"05v295wk9fid17n5plkx6p9nwz6dvpcn2r7khwsq30sy3pg0vxv5" "0df22wqj1nwqp60v8341qcmjhwmdr0hgfraishpc7hic8aqdr4p7"
'("x86_64-linux" "i686-linux") '("x86_64-linux" "i686-linux")
#:configuration-file kernel-config #:configuration-file kernel-config
#:extra-options #:extra-options
@ -1402,7 +1402,7 @@ that the Ethernet protocol is much simpler than the IP protocol.")
(define-public iproute (define-public iproute
(package (package
(name "iproute2") (name "iproute2")
(version "5.1.0") (version "5.2.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -1410,7 +1410,7 @@ that the Ethernet protocol is much simpler than the IP protocol.")
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1kvvrz5mlpjxqcm7vl6i8w6l1cb2amp6p5xyq006pgzafc49hnnw")))) "1a2dywa2kam24951byv9pl32mb9z6klh7d4vp8fwfgrm4vn5vfd5"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`( ;; There is a test suite, but it wants network namespaces and sudo. `( ;; There is a test suite, but it wants network namespaces and sudo.

557
gnu/packages/lisp.scm
View File

@ -11,7 +11,7 @@
;;; Copyright © 2018 Benjamin Slade <slade@jnanam.net> ;;; Copyright © 2018 Benjamin Slade <slade@jnanam.net>
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com> ;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz> ;;; 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 Katherine Cox-Buday <cox.katherine.e@gmail.com>
;;; Copyright © 2019 Jesse Gildersleve <jessejohngildersleve@protonmail.com> ;;; Copyright © 2019 Jesse Gildersleve <jessejohngildersleve@protonmail.com>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net> ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
@ -930,42 +930,30 @@ ANSI-compliant Common Lisp implementations.")
(sbcl-package->cl-source-package sbcl-cl-unicode)) (sbcl-package->cl-source-package sbcl-cl-unicode))
(define-public sbcl-clx (define-public sbcl-clx
(let ((revision "1") (package
(commit "1c62774b03c1cf3fe6e5cb532df8b14b44c96b95")) (name "sbcl-clx")
(package (version "0.7.5")
(name "sbcl-clx") (source
(version (string-append "0.0.0-" revision "." (string-take commit 7))) (origin
(source (method git-fetch)
(origin (uri
(method git-fetch) (git-reference
(uri (url "https://github.com/sharplispers/clx.git")
(git-reference (commit version)))
(url "https://github.com/sharplispers/clx.git") (sha256
(commit commit))) (base32
(sha256 "1vi67z9hpj5rr4xcmfbfwzmlcc0ah7hzhrmfid6lqdkva238v2wf"))
(base32 "0qffag03ns52kwq9xjns2qg1yr0bf3ba507iwq5cmx5xz0b0rmjm")) (file-name (string-append "clx-" version))))
(file-name (string-append "clx-" version "-checkout")) (build-system asdf-build-system/sbcl)
(patches (native-inputs
(list `(("fiasco" ,sbcl-fiasco)))
(search-patch "clx-remove-demo.patch"))) (home-page "http://www.cliki.net/portable-clx")
(modules '((guix build utils))) (synopsis "X11 client library for Common Lisp")
(snippet (description "CLX is an X11 client library for Common Lisp. The code was
'(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
originally taken from a CMUCL distribution, was modified somewhat in order to 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 make it compile and run under SBCL, then a selection of patches were added
from other CLXes around the net.") from other CLXes around the net.")
(license license:x11)))) (license license:x11)))
(define-public cl-clx (define-public cl-clx
(sbcl-package->cl-source-package sbcl-clx)) (sbcl-package->cl-source-package sbcl-clx))
@ -5863,11 +5851,12 @@ and @code{kqueue(2)}), a pathname library and file-system utilities.")
`(("iolib.asdf" ,sbcl-iolib.asdf) `(("iolib.asdf" ,sbcl-iolib.asdf)
("iolib.conf" ,sbcl-iolib.conf) ("iolib.conf" ,sbcl-iolib.conf)
("iolib.grovel" ,sbcl-iolib.grovel) ("iolib.grovel" ,sbcl-iolib.grovel)
("iolib.base", sbcl-iolib.base) ("iolib.base" ,sbcl-iolib.base)
("bordeaux-threads", sbcl-bordeaux-threads) ("bordeaux-threads" ,sbcl-bordeaux-threads)
("idna", sbcl-idna) ("idna" ,sbcl-idna)
("swap-bytes", sbcl-swap-bytes) ("swap-bytes" ,sbcl-swap-bytes)
("libfixposix", libfixposix))) ("libfixposix" ,libfixposix)
("cffi" ,sbcl-cffi)))
(native-inputs (native-inputs
`(("fiveam" ,sbcl-fiveam))) `(("fiveam" ,sbcl-fiveam)))
(arguments (arguments
@ -5953,12 +5942,12 @@ floating point values to IEEE 754 binary representation.")
(name "sbcl-closure-common") (name "sbcl-closure-common")
(build-system asdf-build-system/sbcl) (build-system asdf-build-system/sbcl)
(version (git-version "20101006" revision commit)) (version (git-version "20101006" revision commit))
(home-page "https://github.com/sharplispers/closure-common") (home-page "https://common-lisp.net/project/cxml/")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
(url home-page) (url "https://github.com/sharplispers/closure-common")
(commit commit))) (commit commit)))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
@ -5973,6 +5962,111 @@ Closure is a reference to the web browser it was originally written for.")
;; TODO: License? ;; TODO: License?
(license #f)))) (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 (define-public sbcl-cl-reexport
(let ((commit "312f3661bbe187b5f28536cd7ec2956e91366c3b") (let ((commit "312f3661bbe187b5f28536cd7ec2956e91366c3b")
(revision "1")) (revision "1"))
@ -6092,3 +6186,384 @@ cookie headers, cookie creation, cookie jar creation and more.")
(description "Dexador is yet another HTTP client for Common Lisp with (description "Dexador is yet another HTTP client for Common Lisp with
neat APIs and connection-pooling. It is meant to supersede Drakma.") neat APIs and connection-pooling. It is meant to supersede Drakma.")
(license license:expat)))) (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.")))

6
gnu/packages/llvm.scm
View File

@ -6,7 +6,7 @@
;;; Copyright © 2016, 2018, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016, 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Roel Janssen <roel@gnu.org> ;;; Copyright © 2017 Roel Janssen <roel@gnu.org>
;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com> ;;; 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 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de> ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz> ;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
@ -332,12 +332,12 @@ requirements according to version 1.1 of the OpenCL specification.")
(version (package-version llvm)) (version (package-version llvm))
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://releases.llvm.org/" (uri (string-append "https://releases.llvm.org/"
version "/openmp-" version version "/openmp-" version
".src.tar.xz")) ".src.tar.xz"))
(sha256 (sha256
(base32 (base32
"030dkg5cypd7j9hq0mcqb5gs31lxwmzfq52j81l7v9ldcy5bf5mz")) "1mf9cpgvix34xlpv0inkgl3qmdvgvp96f7sksqizri0n5xfp1cgp"))
(file-name (string-append "libomp-" version ".tar.xz")))) (file-name (string-append "libomp-" version ".tar.xz"))))
(build-system cmake-build-system) (build-system cmake-build-system)
;; XXX: Note this gets built with GCC because building with Clang itself ;; XXX: Note this gets built with GCC because building with Clang itself

71
gnu/packages/logo.scm Normal file
View File

@ -0,0 +1,71 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages logo)
#:use-module (gnu packages qt)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix download)
#:use-module (guix packages)
#:use-module (guix build-system gnu))
(define-public qlogo
(package
(name "qlogo")
(version "0.92")
(source
(origin
(method url-fetch)
(uri (string-append "https://qlogo.org/assets/sources/QLogo-"
version ".tgz"))
(sha256
(base32
"0cpyj1ji6hjy7zzz05672f0j6fr0mwpc1y3sq36hhkv2fkpidw22"))))
(build-system gnu-build-system)
(inputs
`(("qtbase" ,qtbase)))
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
(substitute* "QLogo.pro"
(("target\\.path = /usr/bin")
(string-append "target.path = "
(assoc-ref outputs "out") "/bin")))
(invoke "qmake" "QLogo.pro")))
;; The check phase rebuilds the source for tests. So, it needs to be
;; run after the install phase has installed the outputs of the build
;; phase.
(delete 'check)
(add-after 'install 'check
(lambda _
;; Clean files created by the build phase.
(invoke "make" "clean")
;; QLogo tries to create its "dribble file" in the home
;; directory. So, set HOME.
(setenv "HOME" "/tmp")
;; Build and run tests.
(invoke "qmake" "TestQLogo.pro")
(invoke "make" "-j" (number->string (parallel-job-count)))
(invoke "./testqlogo"))))))
(home-page "https://qlogo.org")
(synopsis "Logo interpreter using Qt and OpenGL")
(description "QLogo is an interpreter for the Logo language written in C++
using Qt and OpenGL. Specifically, it mimics, as reasonably as possible, the
UCBLogo interpreter.")
(license license:gpl2+)))

12
gnu/packages/mail.scm
View File

@ -1173,15 +1173,17 @@ which can add many functionalities to the base client.")
"--with-tls=gnutls") "--with-tls=gnutls")
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'install 'install-msmtpq (add-after 'install 'install-additional-files
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin")) (bin (string-append out "/bin"))
(doc (string-append out "/share/doc/msmtp")) (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 "/msmtpq") bin)
(install-file (string-append msmtpq "/msmtp-queue") bin) (install-file (string-append msmtpq "/msmtp-queue") bin)
(install-file (string-append msmtpq "/README.msmtpq") doc) (install-file (string-append msmtpq "/README.msmtpq") doc)
(install-file "scripts/vim/msmtp.vim" vimfiles)
#t)))))) #t))))))
(synopsis (synopsis
"Simple and easy to use SMTP client with decent sendmail compatibility") "Simple and easy to use SMTP client with decent sendmail compatibility")
@ -2813,8 +2815,8 @@ replacement for the @code{urlview} program.")
(license gpl2+))) (license gpl2+)))
(define-public mumi (define-public mumi
(let ((commit "ea5a738010148284aed211da953ad670003aefea") (let ((commit "ea0a28f8d5db5761765eb60043b8593901552e25")
(revision "3")) (revision "4"))
(package (package
(name "mumi") (name "mumi")
(version (git-version "0.0.0" revision commit)) (version (git-version "0.0.0" revision commit))
@ -2826,7 +2828,7 @@ replacement for the @code{urlview} program.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0ci5x8dqjmp74w33q2dbs5csxp4ilfmc1xxaa8q2jnh52d7597hl")))) "0b6dmi41vhssyf983blgi8a2kj3zjccc9cz7b7kvwh781ldqcywh"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases

4
gnu/packages/music.scm
View File

@ -3739,7 +3739,7 @@ audio samples and various soft sythesizers. It can receive input from a MIDI ke
(define-public musescore (define-public musescore
(package (package
(name "musescore") (name "musescore")
(version "3.2") (version "3.2.3")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -3748,7 +3748,7 @@ audio samples and various soft sythesizers. It can receive input from a MIDI ke
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0719p4hjlq7skga8q4hvnd5w33vhrd1a1aygvqm9pn4na02zazy6")) "17wx1wl8ns2k31qvrr888dxnrsa13vazg04zh2sn2q4vzd869a7v"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
;; Un-bundle OpenSSL and remove unused libraries. ;; Un-bundle OpenSSL and remove unused libraries.

7
gnu/packages/networking.scm
View File

@ -1870,14 +1870,14 @@ displays the results in real time.")
(define-public strongswan (define-public strongswan
(package (package
(name "strongswan") (name "strongswan")
(version "5.6.3") (version "5.8.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://download.strongswan.org/strongswan-" (uri (string-append "https://download.strongswan.org/strongswan-"
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 "095zg7h7qwsc456sqgwb1lhhk29ac3mk5z9gm6xja1pl061driy3")))) (base32 "0cq9m86ydd2i0awxkv4a256f4926p2f9pzlisyskl9fngl6f3c8m"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -2210,6 +2210,9 @@ widely used protocol for monitoring the health and welfare of network
equipment (e.g. routers), computer equipment and even devices like UPSs. 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 Net-SNMP is a suite of applications used to implement SNMP v1, SNMP v2c and
SNMP v3 using both IPv4 and IPv6.") 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 (list license:bsd-3
(license:non-copyleft (license:non-copyleft
"http://www.net-snmp.org/about/license.html" "http://www.net-snmp.org/about/license.html"

6
gnu/packages/package-management.scm
View File

@ -563,16 +563,16 @@ transactions from C or Python.")
(define-public diffoscope (define-public diffoscope
(package (package
(name "diffoscope") (name "diffoscope")
(version (git-version "115" "1" "7f3416ffd12572b42c814e43ac15cee44ef48155")) (version "116")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
(url "https://salsa.debian.org/reproducible-builds/diffoscope.git") (url "https://salsa.debian.org/reproducible-builds/diffoscope.git")
(commit "7f3416ffd12572b42c814e43ac15cee44ef48155"))) (commit "116")))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"1pn2rwlz5shdx7s63798wx2v7029bl5if6dlq3i2r6zsnpp0laki")))) "1anz2c112y0w21mh7xp6bs6z7v10dcy1i25nypkvqy3j929m0g28"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:phases (modify-phases %standard-phases `(#:phases (modify-phases %standard-phases

80
gnu/packages/patches/a2ps-CVE-2015-8107.patch Normal file
View File

@ -0,0 +1,80 @@
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);
}
/*

27
gnu/packages/patches/clx-remove-demo.patch
View File

@ -1,27 +0,0 @@
--- 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

45
gnu/packages/patches/csvkit-fix-tests.patch Normal file
View File

@ -0,0 +1,45 @@
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')

0
gnu/packages/patches/cvs-2017-12836.patch → gnu/packages/patches/cvs-CVE-2017-12836.patch
View File

21
gnu/packages/patches/expat-CVE-2018-20843.patch Normal file
View File

@ -0,0 +1,21 @@
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;

53
gnu/packages/patches/grub-binutils-compat.patch
View File

@ -1,53 +0,0 @@
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
}
},

197
gnu/packages/patches/grub-check-error-efibootmgr.patch
View File

@ -1,197 +0,0 @@
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)
{

17
gnu/packages/patches/grub-efi-fat-serial-number.patch
View File

@ -4,22 +4,23 @@ serial number (instead of the randomly chosen one) to create EFI
images (the 'efi.img' file) that are reproducible bit-for-bit. images (the 'efi.img' file) that are reproducible bit-for-bit.
Patch by Ludovic Courtès <ludo@gnu.org>. 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.04/util/grub-mkrescue.c 2019-05-20 13:01:11.000000000 +0200
+++ grub-2.02/util/grub-mkrescue.c 2019-04-20 21:56:34.672370849 +0200 +++ grub-2.04/util/grub-mkrescue.c 2019-07-08 23:57:36.912104652 +0200
@@ -788,8 +788,15 @@ main (int argc, char *argv[]) @@ -809,8 +809,15 @@
free (efidir_efi_boot);
efiimgfat = grub_util_path_concat (2, iso9660_dir, "efi.img"); 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", - rv = grub_util_exec ((const char * []) { "mformat", "-C", "-f", "2880", "-L", "16", "-i",
- efiimgfat, "::", NULL }); - efiimgfat, "::", NULL });
+ +
+ const char *fat_serial_number = getenv ("GRUB_FAT_SERIAL_NUMBER"); + const char *fat_serial_number = getenv ("GRUB_FAT_SERIAL_NUMBER");
+ const char *mformat_args[] = + const char *mformat_args[] =
+ { "mformat", "-C", "-f", "2880", "-L", "16", + { "mformat", "-C", "-f", "2880", "-L", "16",
+ fat_serial_number != NULL ? "-N" : "-C", + fat_serial_number != NULL ? "-N" : "-C",
+ fat_serial_number != NULL ? fat_serial_number : "-C", + fat_serial_number != NULL ? fat_serial_number : "-C",
+ "-i", efiimgfat, "::", NULL }; + "-i", efiimgfat, "::", NULL };
+ +
+ rv = grub_util_exec (mformat_args); + rv = grub_util_exec (mformat_args);
if (rv != 0) if (rv != 0)

120
gnu/packages/patches/libexif-CVE-2018-20030.patch Normal file
View File

@ -0,0 +1,120 @@
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;

13
gnu/packages/patches/plib-CVE-2011-4620.patch Normal file
View File

@ -0,0 +1,13 @@
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 )

57
gnu/packages/patches/plib-CVE-2012-4552.patch Normal file
View File

@ -0,0 +1,57 @@
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.

22
gnu/packages/patches/python-slugify-depend-on-unidecode.patch Normal file
View File

@ -0,0 +1,22 @@
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']},
)

4
gnu/packages/patchutils.scm
View File

@ -307,7 +307,7 @@ you to figure out what is going on in that merge you keep avoiding.")
(define-public patchwork (define-public patchwork
(package (package
(name "patchwork") (name "patchwork")
(version "2.1.2") (version "2.1.4")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
@ -316,7 +316,7 @@ you to figure out what is going on in that merge you keep avoiding.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"06ng5pv6744w98zkyfm0ldkmpdgnsql3gbbbh6awq61sr2ndr3qw")))) "0zi1hcqb0pi2diyznbv0c1631qk4rx02zl8ghyrr59g3ljlyr18y"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(;; TODO: Tests require a running database `(;; TODO: Tests require a running database

8
gnu/packages/pdf.scm
View File

@ -5,7 +5,7 @@
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org> ;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;; Copyright © 2016 Roel Janssen <roel@gnu.org> ;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016 ng0 <ng0@n0.is> ;;; 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 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
@ -604,7 +604,7 @@ extracting content or merging files.")
(define-public mupdf (define-public mupdf
(package (package
(name "mupdf") (name "mupdf")
(version "1.14.0") (version "1.15.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -612,7 +612,7 @@ extracting content or merging files.")
name "-" version "-source.tar.xz")) name "-" version "-source.tar.xz"))
(sha256 (sha256
(base32 (base32
"1psnz02w5p7wc1s1ma7vvjmkjfy641xvsh9ykaqzkk84dflnjgk0")) "0kmcz3ivxmqmks8vg50ri1zar18q5svk829z0g1kj08lgz7kcl2n"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
;; We keep lcms2 since it is different than our lcms. ;; We keep lcms2 since it is different than our lcms.
@ -620,7 +620,7 @@ extracting content or merging files.")
(for-each (for-each
(lambda (dir) (lambda (dir)
(delete-file-recursively (string-append "thirdparty/" dir))) (delete-file-recursively (string-append "thirdparty/" dir)))
'("curl" "freeglut" "freetype" "harfbuzz" "jbig2dec" '("freeglut" "freetype" "harfbuzz" "jbig2dec"
"libjpeg" "mujs" "openjpeg" "zlib")) "libjpeg" "mujs" "openjpeg" "zlib"))
#t)))) #t))))
(build-system gnu-build-system) (build-system gnu-build-system)

13
gnu/packages/photo.scm
View File

@ -1,8 +1,8 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015, 2017 Andreas Enge <andreas@enge.fr> ;;; 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 © 2017 Roel Janssen <roel@gnu.org>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Leo Famulari <leo@famulari.name> ;;; Copyright © 2018 Leo Famulari <leo@famulari.name>
@ -70,14 +70,14 @@
(define-public libraw (define-public libraw
(package (package
(name "libraw") (name "libraw")
(version "0.19.2") (version "0.19.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://www.libraw.org/data/LibRaw-" (uri (string-append "https://www.libraw.org/data/LibRaw-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0i4nhjm5556xgn966x0i503ygk2wafq6z83kg0lisacjjab4f3a0")))) "0xs1qb6pcvc4c43fy5xi3nkqxcif77gakkw99irf0fc5iccdd5px"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("pkg-config" ,pkg-config)))
@ -117,7 +117,8 @@ cameras (CRW/CR2, NEF, RAF, DNG, and others).")
(uri (string-append "mirror://sourceforge/libexif/libexif/" (uri (string-append "mirror://sourceforge/libexif/libexif/"
version "/libexif-" version ".tar.bz2")) version "/libexif-" version ".tar.bz2"))
(patches (search-patches "libexif-CVE-2016-6328.patch" (patches (search-patches "libexif-CVE-2016-6328.patch"
"libexif-CVE-2017-7544.patch")) "libexif-CVE-2017-7544.patch"
"libexif-CVE-2018-20030.patch"))
(sha256 (sha256
(base32 (base32
"06nlsibr3ylfwp28w8f5466l6drgrnydgxrm4jmxzrmk5svaxk8n")))) "06nlsibr3ylfwp28w8f5466l6drgrnydgxrm4jmxzrmk5svaxk8n"))))
@ -445,7 +446,7 @@ and enhance them.")
(inputs (inputs
`(("boost" ,boost) `(("boost" ,boost)
("enblend-enfuse" ,enblend-enfuse) ("enblend-enfuse" ,enblend-enfuse)
("exiv2" ,exiv2) ("exiv2" ,exiv2-0.26)
("fftw" ,fftw) ("fftw" ,fftw)
("flann" ,flann) ("flann" ,flann)
("freeglut" ,freeglut) ("freeglut" ,freeglut)

5
gnu/packages/pretty-print.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
@ -63,7 +63,8 @@
#t)) #t))
(patches (search-patches (patches (search-patches
"a2ps-CVE-2001-1593.patch" "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) (build-system gnu-build-system)
(inputs (inputs
`(("psutils" ,psutils) `(("psutils" ,psutils)

58
gnu/packages/pulseaudio.scm
View File

@ -8,6 +8,7 @@
;;; Copyright © 2017 Stefan Reichör <stefan@xsteve.at> ;;; Copyright © 2017 Stefan Reichör <stefan@xsteve.at>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Pierre Langlois <pierre.langlois@gmx.com> ;;; Copyright © 2018 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -27,6 +28,7 @@
(define-module (gnu packages pulseaudio) (define-module (gnu packages pulseaudio)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix l:) #:use-module ((guix licenses) #:prefix l:)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system python) #:use-module (guix build-system python)
@ -43,6 +45,10 @@
#:use-module (gnu packages web) #:use-module (gnu packages web)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages m4) #: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 pkg-config)
#:use-module (gnu packages xiph)) #:use-module (gnu packages xiph))
@ -301,3 +307,55 @@ sinks.")
(description "Pulsemixer is a PulseAudio mixer with command-line and (description "Pulsemixer is a PulseAudio mixer with command-line and
curses-style interfaces.") curses-style interfaces.")
(license l:expat))) (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+))))

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

@ -29,6 +29,7 @@
;;; Copyright © 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2019 Vagrant Cascadian <vagrant@debian.org> ;;; Copyright © 2019 Vagrant Cascadian <vagrant@debian.org>
;;; Copyright © 2019 Brendan Tildesley <mail@brendan.scot> ;;; Copyright © 2019 Brendan Tildesley <mail@brendan.scot>
;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -3165,3 +3166,33 @@ Python.")
(propagated-inputs (propagated-inputs
`(("python-gevent" ,python2-gevent) `(("python-gevent" ,python2-gevent)
("python-tornado" ,python2-tornado))))) ("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)))

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

@ -61,6 +61,8 @@
;;; Copyright © 2019 Sam <smbaines8@gmail.com> ;;; Copyright © 2019 Sam <smbaines8@gmail.com>
;;; Copyright © 2019 Jack Hill <jackhill@jackhill.us> ;;; Copyright © 2019 Jack Hill <jackhill@jackhill.us>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net> ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -667,14 +669,14 @@ other machines, such as over the network.")
(define-public python-setuptools (define-public python-setuptools
(package (package
(name "python-setuptools") (name "python-setuptools")
(version "40.8.0") (version "41.0.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "setuptools" version ".zip")) (uri (pypi-uri "setuptools" version ".zip"))
(sha256 (sha256
(base32 (base32
"0k9hifpgahnw2a26w3cr346iy733k6d3nwh3f7g9m13y6f8fqkkf")) "04sns22y2hhsrwfy1mha2lgslvpjsjsz8xws7h2rh5a7ylkd28m2"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet (snippet
'(begin '(begin
@ -4338,19 +4340,18 @@ services for your Python modules and applications.")
(define-public python-olefile (define-public python-olefile
(package (package
(name "python-olefile") (name "python-olefile")
(version "0.45.1") (version "0.46")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/decalage2/olefile/archive/v" (uri (string-append "https://github.com/decalage2/olefile/releases/"
version ".tar.gz")) "download/v" version "/olefile-" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"18ai19zwagm6nli14k8bii31ipbab2rp7plrvsm6gmfql551a8ai")))) "1kjxh4gr651hpqkjfv89cfzr40hyvf3vjlda7mifiail83j7j07m"))))
(build-system python-build-system) (build-system python-build-system)
(home-page (home-page "https://www.decalage.info/python/olefileio")
"https://www.decalage.info/python/olefileio")
(synopsis "Read and write Microsoft OLE2 files.") (synopsis "Read and write Microsoft OLE2 files.")
(description (description
"@code{olefile} can parse, read and write Microsoft OLE2 files (Structured "@code{olefile} can parse, read and write Microsoft OLE2 files (Structured
@ -5639,6 +5640,33 @@ implementation of D-Bus.")
;; "ValueError: unichr() arg not in range(0x10000) (narrow Python build)" ;; "ValueError: unichr() arg not in range(0x10000) (narrow Python build)"
(arguments `(#:tests? #f)))) (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 (define-public python-lxml
(package (package
(name "python-lxml") (name "python-lxml")
@ -5713,14 +5741,14 @@ converts incoming documents to Unicode and outgoing documents to UTF-8.")
(define-public python-soupsieve (define-public python-soupsieve
(package (package
(name "python-soupsieve") (name "python-soupsieve")
(version "1.9.1") (version "1.9.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "soupsieve" version)) (uri (pypi-uri "soupsieve" version))
(sha256 (sha256
(base32 (base32
"1jnzkiwmjl6yvqckc9mf689g87b6yz07sv868hap2aa5arggy3mj")))) "0in9rc9q3h8w5b4qf7kvl3qxcvw6vrz35ckblchgf70hm6pg3dbj"))))
(build-system python-build-system) (build-system python-build-system)
(arguments `(#:tests? #f)) (arguments `(#:tests? #f))
;;XXX: 2 tests fail currently despite claming they were to be ;;XXX: 2 tests fail currently despite claming they were to be
@ -6874,6 +6902,41 @@ and MAC network addresses.")
(define-public python2-netaddr (define-public python2-netaddr
(package-with-python2 python-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 (define-public python-wrapt
(package (package
(name "python-wrapt") (name "python-wrapt")
@ -15760,6 +15823,42 @@ by Igor Pavlov.")
(define-public python2-pylzma (define-public python2-pylzma
(package-with-python2 python-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 (define-public python-bsddb3
(package (package
(name "python-bsddb3") (name "python-bsddb3")
@ -15796,3 +15895,24 @@ hash, recno, and queue. Complete support of Berkeley DB distributed
transactions. Complete support for Berkeley DB Replication Manager. transactions. Complete support for Berkeley DB Replication Manager.
Complete support for Berkeley DB Base Replication. Support for RPC.") Complete support for Berkeley DB Base Replication. Support for RPC.")
(license license:bsd-3))) (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)))

14
gnu/packages/serialization.scm
View File

@ -297,18 +297,16 @@ that implements both the msgpack and msgpack-rpc specifications.")
(define-public jsoncpp (define-public jsoncpp
(package (package
(name "jsoncpp") (name "jsoncpp")
(version "1.8.4") (version "1.9.0")
(home-page "https://github.com/open-source-parsers/jsoncpp")
(source (origin (source (origin
(method url-fetch) (method git-fetch)
(uri (string-append (uri (git-reference (url home-page) (commit version)))
"https://github.com/open-source-parsers/jsoncpp/archive/" (file-name (git-file-name name version))
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1dpxk8hkni5dq4mdw8qbaj40jmid3a31d1gh8iqcnfwkw34ym7f4")))) "10wnwlq92gp32f5p55kjcc12jfsl0yq6f2y4abb0si6wym12krw9"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(home-page "https://github.com/open-source-parsers/jsoncpp")
(arguments (arguments
`(#:configure-flags '("-DBUILD_SHARED_LIBS:BOOL=YES"))) `(#:configure-flags '("-DBUILD_SHARED_LIBS:BOOL=YES")))
(synopsis "C++ library for interacting with JSON") (synopsis "C++ library for interacting with JSON")

21
gnu/packages/time.scm
View File

@ -15,6 +15,7 @@
;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com> ;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -65,6 +66,26 @@ program uses. The display output of the program can be customized or saved
to a file.") to a file.")
(license gpl3+))) (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 (define-public python-pytzdata
(package (package
(name "python-pytzdata") (name "python-pytzdata")

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

@ -1418,7 +1418,7 @@ machine.")
(uri (string-append (uri (string-append
"https://ftp.gnu.org/non-gnu/cvs/source/feature/" "https://ftp.gnu.org/non-gnu/cvs/source/feature/"
version "/cvs-" version ".tar.bz2")) version "/cvs-" version ".tar.bz2"))
(patches (search-patches "cvs-2017-12836.patch")) (patches (search-patches "cvs-CVE-2017-12836.patch"))
(sha256 (sha256
(base32 (base32
"0pjir8cwn0087mxszzbsi1gyfc6373vif96cw4q3m1x6p49kd1bq")))) "0pjir8cwn0087mxszzbsi1gyfc6373vif96cw4q3m1x6p49kd1bq"))))

10
gnu/packages/vim.scm
View File

@ -565,21 +565,21 @@ and powerline symbols, etc.")
;; There are no tarball releases. ;; There are no tarball releases.
(define-public vim-airline-themes (define-public vim-airline-themes
(let ((commit "6026eb78bf362cb3aa875aff8487f65728d0f7d8") (let ((commit "e6f233231b232b6027cde6aebeeb18d9138e5324")
(revision "1")) (revision "2"))
(package (package
(name "vim-airline-themes") (name "vim-airline-themes")
(version (string-append "0.0.0-" revision "." (string-take commit 7))) (version (git-version "0.0.0" revision commit))
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
(uri (git-reference (uri (git-reference
(url "https://github.com/vim-airline/vim-airline-themes") (url "https://github.com/vim-airline/vim-airline-themes")
(commit commit))) (commit commit)))
(file-name (string-append name "-" version "-checkout")) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"13ijkavh1r0935cn2rjsfbdd1q3ka8bi26kw0bdkrqlrqxwvpss8")))) "1sb7nb7j7bz0pv1c9bgdy0smhr0jk2b1vbdv9yzghg5lrknpsbr6"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f `(#:tests? #f

59
gnu/packages/web.scm
View File

@ -33,6 +33,7 @@
;;; Copyright © 2019 Nicolas Goaziou <mail@nicolasgoaziou.fr> ;;; Copyright © 2019 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2019 Brendan Tildesley <mail@brendan.scot> ;;; Copyright © 2019 Brendan Tildesley <mail@brendan.scot>
;;; Copyright © 2019 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -2520,15 +2521,14 @@ composed of HTML::Element style components.")
(define-public perl-html-form (define-public perl-html-form
(package (package
(name "perl-html-form") (name "perl-html-form")
(version "6.03") (version "6.04")
(source (source
(origin (origin
(method url-fetch) (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")) "HTML-Form-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32 "100090bdsr5kapv8h0wxzwlzfbfqn57rq9gzrvg9i6hvnsl5gmcw"))))
"0dpwr7yz6hjc3bcqgcbdzjjk9l58ycdjmbam9nfcmm85y2a1vh38"))))
(build-system perl-build-system) (build-system perl-build-system)
(propagated-inputs (propagated-inputs
`(("perl-html-parser" ,perl-html-parser) `(("perl-html-parser" ,perl-html-parser)
@ -5241,16 +5241,28 @@ command-line arguments or read from stdin.")
(define-public python-internetarchive (define-public python-internetarchive
(package (package
(name "python-internetarchive") (name "python-internetarchive")
(version "1.7.4") (version "1.8.5")
(source (source
(origin (origin
(method url-fetch) (method git-fetch)
(uri (string-append "https://github.com/jjjake/internetarchive/archive/" (uri (git-reference
"v" version ".tar.gz")) (url "https://github.com/jjjake/internetarchive")
(file-name (string-append name "-" version ".tar.gz")) (commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256 (sha256
(base32 (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) (build-system python-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -6497,3 +6509,30 @@ update an existing mirrored site, and resume interrupted downloads.
HTTrack is fully configurable, and has an integrated help system.") HTTrack is fully configurable, and has an integrated help system.")
(license license:gpl3+))) (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)))

13
gnu/packages/wget.scm
View File

@ -79,7 +79,7 @@ in downloaded documents to relative links.")
(define-public wgetpaste (define-public wgetpaste
(package (package
(name "wgetpaste") (name "wgetpaste")
(version "2.28") (version "2.29")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -87,10 +87,10 @@ in downloaded documents to relative links.")
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1hh9svyypqcvdg5mjxyyfzpdzhylhf7s7xq5dzglnm4injx3i3ak")))) "1rp0wxr3zy7y2xp3azaadfghrx7g0m138f9qg6icjxkkz4vj9r22"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:modules ((guix build gnu-build-system) `(#:modules ((guix build gnu-build-system)
(guix build utils) (guix build utils)
(srfi srfi-1)) (srfi srfi-1))
#:phases #:phases
@ -102,16 +102,17 @@ in downloaded documents to relative links.")
;; https://gitweb.gentoo.org/repo/gentoo.git/tree/app-text/wgetpaste/files/wgetpaste-remove-dead.patch ;; https://gitweb.gentoo.org/repo/gentoo.git/tree/app-text/wgetpaste/files/wgetpaste-remove-dead.patch
(lambda _ (lambda _
(substitute* "wgetpaste" (substitute* "wgetpaste"
((" poundpython\"") "\"") (("-bpaste") "-dpaste")) ; dpaste blocks tor users
(("-poundpython") "-bpaste")) ; dpaste blocks tor users
#t)) #t))
(replace 'install (replace 'install
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin")) (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" bin)
(install-file "_wgetpaste" zsh) (install-file "_wgetpaste" zsh)
(install-file "LICENSE" doc)
#t))) #t)))
(add-after 'install 'wrap-program (add-after 'install 'wrap-program
;; /bin/wgetpaste prides itself on relying only on the following ;; /bin/wgetpaste prides itself on relying only on the following

6
gnu/packages/wine.scm
View File

@ -310,7 +310,7 @@ integrate Windows applications into your desktop.")
(define-public wine-staging-patchset-data (define-public wine-staging-patchset-data
(package (package
(name "wine-staging-patchset-data") (name "wine-staging-patchset-data")
(version "4.11") (version "4.12.1")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -320,7 +320,7 @@ integrate Windows applications into your desktop.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"0h8qldqr9w1kwn48qgg5m1cs2xqkv8xxg2c66cvfka91hy886jcf")))) "1bvpvj6vcw2p6vcjm6mw5maarbs4lfw1ix3pj020w4n3kg4nmmc4"))))
(build-system trivial-build-system) (build-system trivial-build-system)
(native-inputs (native-inputs
`(("bash" ,bash) `(("bash" ,bash)
@ -366,7 +366,7 @@ integrate Windows applications into your desktop.")
(file-name (string-append name "-" version ".tar.xz")) (file-name (string-append name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1rmyfwlynzs2niz7l2lwjs2axm6in6gb43ldbzyzsflxsmk5fl9f")))) "09yjfb2k14y11k19lm8dqmb8qwxyhh67d5q1gqv480y64mljvkx0"))))
(inputs `(("autoconf" ,autoconf) ; for autoreconf (inputs `(("autoconf" ,autoconf) ; for autoreconf
("faudio" ,faudio) ("faudio" ,faudio)
("ffmpeg" ,ffmpeg) ("ffmpeg" ,ffmpeg)

267
gnu/packages/wireservice.scm Normal file
View File

@ -0,0 +1,267 @@
;;; 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)))

6
gnu/packages/wm.scm
View File

@ -268,8 +268,8 @@ Despite the name it should work with any X11 window manager.")
(license license:bsd-3))) (license license:bsd-3)))
(define-public i3blocks (define-public i3blocks
(let ((commit "37f23805ff886639163fbef8aedba71c8071eff8") (let ((commit "ec050e79ad8489a6f8deb37d4c20ab10729c25c3")
(revision "1")) (revision "2"))
(package (package
(name "i3blocks") (name "i3blocks")
(version (string-append "1.4-" revision "." (version (string-append "1.4-" revision "."
@ -281,7 +281,7 @@ Despite the name it should work with any X11 window manager.")
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"15rnrcajzyrmhlz1a21qqsjlj3dkib70806dlb386fliylc2kisb")) "1fx4230lmqa5rpzph68dwnpcjfaaqv5gfkradcr85hd1z8d1qp1b"))
(file-name (git-file-name name version)))) (file-name (git-file-name name version))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments

11
gnu/packages/xdisorg.scm
View File

@ -1062,7 +1062,7 @@ color temperature should be set to match the lamps in your room.")
(define-public xscreensaver (define-public xscreensaver
(package (package
(name "xscreensaver") (name "xscreensaver")
(version "5.42") (version "5.43")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -1070,11 +1070,10 @@ color temperature should be set to match the lamps in your room.")
(string-append "https://www.jwz.org/xscreensaver/xscreensaver-" (string-append "https://www.jwz.org/xscreensaver/xscreensaver-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32 "1571pj1a9998sq14y9366s2rw9wd2kq3l3dvvsk610vyd0fki3qm"))))
"1qfbsnj7201d03vf0b2lzxmlcq4kvkvzp48r5gcgsjr17c1sl7a4"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f ; no check target `(#:tests? #f ; no check target
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-before 'configure 'adjust-gtk-resource-paths (add-before 'configure 'adjust-gtk-resource-paths
@ -1085,9 +1084,7 @@ color temperature should be set to match the lamps in your room.")
#t))) #t)))
#:configure-flags '("--with-pam" "--with-proc-interrupts" #:configure-flags '("--with-pam" "--with-proc-interrupts"
"--without-readdisplay") "--without-readdisplay")
;; FIXME: Remove CFLAGS once our default compiler is GCC6 or later. #:make-flags (list (string-append "AD_DIR="
#:make-flags (list "CFLAGS=-std=c99"
(string-append "AD_DIR="
(assoc-ref %outputs "out") (assoc-ref %outputs "out")
"/usr/lib/X11/app-defaults")))) "/usr/lib/X11/app-defaults"))))
(native-inputs (native-inputs

32
gnu/packages/xml.scm
View File

@ -20,6 +20,7 @@
;;; Copyright © 2017 Petter <petter@mykolab.ch> ;;; Copyright © 2017 Petter <petter@mykolab.ch>
;;; Copyright © 2017 Stefan Reichör <stefan@xsteve.at> ;;; Copyright © 2017 Stefan Reichör <stefan@xsteve.at>
;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz> ;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2018 Jack Hill <jackhill@jackhill.us>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -66,13 +67,18 @@
(package (package
(name "expat") (name "expat")
(version "2.2.7") (version "2.2.7")
(source (origin (source (let ((dot->underscore (lambda (c) (if (char=? #\. c) #\_ c))))
(method url-fetch) (origin
(uri (string-append "mirror://sourceforge/expat/expat/" (method url-fetch)
version "/expat-" version ".tar.xz")) (uri (list (string-append "mirror://sourceforge/expat/expat/"
(sha256 version "/expat-" version ".tar.xz")
(base32 (string-append
"1y5yax6bq8p9xk49zqkd62pxk8bq266wrgbrqgaxp3wsrw5g9qrh")))) "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) (build-system gnu-build-system)
(home-page "https://libexpat.github.io/") (home-page "https://libexpat.github.io/")
(synopsis "Stream-oriented XML parser library written in C") (synopsis "Stream-oriented XML parser library written in C")
@ -82,6 +88,14 @@ stream-oriented parser in which an application registers handlers for
things the parser might find in the XML document (like start tags).") things the parser might find in the XML document (like start tags).")
(license license:expat))) (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 (define-public libebml
(package (package
(name "libebml") (name "libebml")
@ -677,14 +691,14 @@ This module provide functions which simplify writing tests for
(define-public perl-xml-compile (define-public perl-xml-compile
(package (package
(name "perl-xml-compile") (name "perl-xml-compile")
(version "1.62") (version "1.63")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/" (uri (string-append "mirror://cpan/authors/id/M/MA/MARKOV/"
"XML-Compile-" version ".tar.gz")) "XML-Compile-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0a75gr4qcjj8ybzljacbbkdxprbqpypz49bc0jb7cfamx1hp7p2w")))) "0psr5pwsk2biz2bfkigmx04v2rfhs6ybwcfmcrrg7gvh9bpp222b"))))
(build-system perl-build-system) (build-system perl-build-system)
(propagated-inputs (propagated-inputs
`(("perl-carp" ,perl-carp) `(("perl-carp" ,perl-carp)

18
gnu/tests/docker.scm
View File

@ -27,7 +27,6 @@
#:use-module (gnu services networking) #:use-module (gnu services networking)
#:use-module (gnu services docker) #:use-module (gnu services docker)
#:use-module (gnu services desktop) #:use-module (gnu services desktop)
#:use-module (gnu packages bootstrap) ; %bootstrap-guile
#:use-module (gnu packages docker) #:use-module (gnu packages docker)
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
#:use-module (guix gexp) #:use-module (guix gexp)
@ -101,7 +100,7 @@ inside %DOCKER-OS."
marionette)) marionette))
(test-equal "Load docker image and run it" (test-equal "Load docker image and run it"
'("hello world" "hi!") '("hello world" "hi!" "JSON!")
(marionette-eval (marionette-eval
`(begin `(begin
(define slurp (define slurp
@ -125,8 +124,15 @@ inside %DOCKER-OS."
(response2 (slurp ;default entry point (response2 (slurp ;default entry point
,(string-append #$docker-cli "/bin/docker") ,(string-append #$docker-cli "/bin/docker")
"run" repository&tag "run" repository&tag
"-c" "(display \"hi!\")"))) "-c" "(display \"hi!\")"))
(list response1 response2)))
;; 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)) marionette))
(test-end) (test-end)
@ -144,7 +150,7 @@ inside %DOCKER-OS."
(version "0") (version "0")
(source #f) (source #f)
(build-system trivial-build-system) (build-system trivial-build-system)
(arguments `(#:guile ,%bootstrap-guile (arguments `(#:guile ,guile-2.2
#:builder #:builder
(let ((out (assoc-ref %outputs "out"))) (let ((out (assoc-ref %outputs "out")))
(mkdir out) (mkdir out)
@ -158,7 +164,7 @@ standard output device and then enters a new line.")
(home-page #f) (home-page #f)
(license license:public-domain))) (license license:public-domain)))
(profile (profile-derivation (packages->manifest (profile (profile-derivation (packages->manifest
(list %bootstrap-guile (list guile-2.2 guile-json
guest-script-package)) guest-script-package))
#:hooks '() #:hooks '()
#:locales? #f)) #:locales? #f))

2
gnu/tests/install.scm
View File

@ -661,7 +661,7 @@ export GUIX_BUILD_OPTIONS=--no-grafts
ls -l /run/current-system/gc-roots ls -l /run/current-system/gc-roots
parted --script /dev/vdb mklabel gpt \\ parted --script /dev/vdb mklabel gpt \\
mkpart primary ext2 1M 3M \\ mkpart primary ext2 1M 3M \\
mkpart primary ext2 3M 1.2G \\ mkpart primary ext2 3M 1.4G \\
set 1 boot on \\ set 1 boot on \\
set 1 bios_grub on set 1 bios_grub on
echo -n thepassphrase | \\ echo -n thepassphrase | \\

18
gnu/tests/singularity.scm
View File

@ -111,6 +111,21 @@
"run" #$image "-c" "(exit 42)")) "run" #$image "-c" "(exit 42)"))
marionette)) 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) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
@ -122,7 +137,8 @@
(guile (set-guile-for-build (default-guile))) (guile (set-guile-for-build (default-guile)))
;; 'singularity exec' insists on having /bin/sh in the image. ;; 'singularity exec' insists on having /bin/sh in the image.
(profile (profile-derivation (packages->manifest (profile (profile-derivation (packages->manifest
(list bash-minimal guile-2.2)) (list bash-minimal
guile-2.2 guile-json))
#:hooks '() #:hooks '()
#:locales? #f)) #:locales? #f))
(tarball (squashfs-image "singularity-pack" profile (tarball (squashfs-image "singularity-pack" profile

59
guix/channels.scm
View File

@ -349,13 +349,15 @@ INSTANCES."
(resolve-dependencies instances)) (resolve-dependencies instances))
(define (instance->derivation instance) (define (instance->derivation instance)
(mcached (if (eq? instance core-instance) (mlet %store-monad ((system (current-system)))
(build-channel-instance instance) (mcached (if (eq? instance core-instance)
(mlet %store-monad ((core (instance->derivation core-instance)) (build-channel-instance instance)
(deps (mapm %store-monad instance->derivation (mlet %store-monad ((core (instance->derivation core-instance))
(edges instance)))) (deps (mapm %store-monad instance->derivation
(build-channel-instance instance core deps))) (edges instance))))
instance)) (build-channel-instance instance core deps)))
instance
system)))
(unless core-instance (unless core-instance
(let ((loc (and=> (any (compose channel-location channel-instance-channel) (let ((loc (and=> (any (compose channel-location channel-instance-channel)
@ -429,32 +431,27 @@ derivation."
(define (channel-instances->manifest instances) (define (channel-instances->manifest instances)
"Return a profile manifest with entries for all of INSTANCES, a list of "Return a profile manifest with entries for all of INSTANCES, a list of
channel instances." channel instances."
(define instance->entry (define (instance->entry instance drv)
(match-lambda (let ((commit (channel-instance-commit instance))
((instance drv) (channel (channel-instance-channel instance)))
(let ((commit (channel-instance-commit instance)) (manifest-entry
(channel (channel-instance-channel instance))) (name (symbol->string (channel-name channel)))
(with-monad %store-monad (version (string-take commit 7))
(return (manifest-entry (item (if (guix-channel? channel)
(name (symbol->string (channel-name channel))) (if (old-style-guix? drv)
(version (string-take commit 7)) (whole-package-for-legacy (string-append name "-" version)
(item (if (guix-channel? channel) drv)
(if (old-style-guix? drv) drv)
(whole-package-for-legacy drv))
(string-append name "-" version) (properties
drv) `((source (repository
drv) (version 0)
drv)) (url ,(channel-url channel))
(properties (branch ,(channel-branch channel))
`((source (repository (commit ,commit))))))))
(version 0)
(url ,(channel-url channel))
(branch ,(channel-branch channel))
(commit ,commit))))))))))))
(mlet* %store-monad ((derivations (channel-instance-derivations instances)) (mlet* %store-monad ((derivations (channel-instance-derivations instances))
(entries (mapm %store-monad instance->entry (entries -> (map instance->entry instances derivations)))
(zip instances derivations))))
(return (manifest entries)))) (return (manifest entries))))
(define (package-cache-file manifest) (define (package-cache-file manifest)

113
guix/derivations.scm
View File

@ -293,74 +293,78 @@ result is the set of prerequisites of DRV not already in valid."
(derivation-output-path (assoc-ref outputs sub-drv))) (derivation-output-path (assoc-ref outputs sub-drv)))
sub-drvs)))) sub-drvs))))
(define* (substitution-oracle store drv (define* (substitution-oracle store inputs-or-drv
#:key (mode (build-mode normal))) #:key (mode (build-mode normal)))
"Return a one-argument procedure that, when passed a store file name, "Return a one-argument procedure that, when passed a store file name,
returns a 'substitutable?' if it's substitutable and #f otherwise. 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* The returned procedure knows about all substitutes for all the derivation
those that are already valid (that is, it won't bother checking whether an inputs or derivations listed in INPUTS-OR-DRV, *except* those that are already
item is substitutable if it's already on disk); it also knows about their valid (that is, it won't bother checking whether an item is substitutable if
prerequisites, unless they are themselves substitutable. 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 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 reusing it is much more efficient than calling 'has-substitutes?' or similar
repeatedly, because it avoids the costs associated with launching the repeatedly, because it avoids the costs associated with launching the
substituter many times." substituter many times."
(define valid?
(cut valid-path? store <>))
(define valid-input? (define valid-input?
(cut valid-derivation-input? store <>)) (cut valid-derivation-input? store <>))
(define (dependencies drv) (define (closure inputs)
;; Skip prerequisite sub-trees of DRV whose root is valid. This allows us (let loop ((inputs inputs)
;; to ask the substituter for just as much as needed, instead of asking it (closure '())
;; for the whole world, which can be significantly faster when substitute (visited (set)))
;; info is not already in cache. (match inputs
;; Also, skip derivations marked as non-substitutable. (()
(append-map (lambda (input) (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))) (let ((drv (derivation-input-derivation input)))
(if (substitutable-derivation? drv) (loop (append (derivation-inputs drv) rest)
(derivation-input-output-paths input) (if (substitutable-derivation? drv)
'()))) (cons input closure)
(derivation-prerequisites drv valid-input?))) closure)
(set-insert key visited))))))))))
(let* ((paths (delete-duplicates (let* ((inputs (closure (map (match-lambda
(concatenate ((? derivation-input? input)
(fold (lambda (drv result) input)
(let ((self (match (derivation->output-paths drv) ((? derivation? drv)
(((names . paths) ...) (derivation-input drv)))
paths)))) inputs-or-drv)))
(cond ((eqv? mode (build-mode check)) (items (append-map derivation-input-output-paths inputs))
(cons (dependencies drv) result)) (subst (fold (lambda (subst vhash)
((not (substitutable-derivation? drv)) (vhash-cons (substitutable-path subst) subst
(cons (dependencies drv) result)) vhash))
((every valid? self) vlist-null
result) (substitutable-path-info store items))))
(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))))
(lambda (item) (lambda (item)
(match (vhash-assoc item subst) (match (vhash-assoc item subst)
(#f #f) (#f #f)
((key . value) value))))) ((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 (define* (derivation-build-plan store inputs
#:key #:key
(mode (build-mode normal)) (mode (build-mode normal))
(substitutable-info (substitutable-info
(substitution-oracle (substitution-oracle
store store inputs #:mode mode)))
(map derivation-input-derivation
inputs)
#:mode mode)))
"Given INPUTS, a list of derivation-inputs, return two values: the list of "Given INPUTS, a list of derivation-inputs, return two values: the list of
derivation to build, and the list of substitutable items that, together, derivation to build, and the list of substitutable items that, together,
allows INPUTS to be realized. allows INPUTS to be realized.
@ -391,7 +395,9 @@ by 'substitution-oracle'."
(() (()
(values build substitute)) (values build substitute))
((input rest ...) ((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) (cond ((set-contains? visited key)
(loop rest build substitute visited)) (loop rest build substitute visited))
((input-built? input) ((input-built? input)
@ -400,16 +406,17 @@ by 'substitution-oracle'."
((input-substitutable-info input) ((input-substitutable-info input)
=> =>
(lambda (substitutables) (lambda (substitutables)
(loop rest build (loop (append (dependencies-of-substitutables substitutables
deps)
rest)
build
(append substitutables substitute) (append substitutables substitute)
(set-insert key visited)))) (set-insert key visited))))
(else (else
(let ((deps (derivation-inputs (loop (append deps rest)
(derivation-input-derivation input)))) (cons (derivation-input-derivation input) build)
(loop (append deps rest) substitute
(cons (derivation-input-derivation input) build) (set-insert key visited)))))))))
substitute
(set-insert key visited))))))))))
(define-deprecated (derivation-prerequisites-to-build store drv #:rest rest) (define-deprecated (derivation-prerequisites-to-build store drv #:rest rest)
derivation-build-plan derivation-build-plan

4
guix/discovery.scm
View File

@ -78,7 +78,9 @@ DIRECTORY is not accessible."
((= stat:type 'directory) ((= stat:type 'directory)
(append (scheme-files absolute) (append (scheme-files absolute)
result)) result))
(_ result))))) (_ result)))
(else
result)))
(else (else
result)))))) result))))))
'() '()

17
guix/docker.scm
View File

@ -73,7 +73,7 @@
`((,(generate-tag path) . ((latest . ,id))))) `((,(generate-tag path) . ((latest . ,id)))))
;; See https://github.com/opencontainers/image-spec/blob/master/config.md ;; 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." "Generate a minimal image configuration for the given LAYER file."
;; "architecture" must be values matching "platform.arch" in the ;; "architecture" must be values matching "platform.arch" in the
;; runtime-spec at ;; runtime-spec at
@ -81,9 +81,13 @@
`((architecture . ,arch) `((architecture . ,arch)
(comment . "Generated by GNU Guix") (comment . "Generated by GNU Guix")
(created . ,time) (created . ,time)
(config . ,(if entry-point (config . ,`((env . ,(map (match-lambda
`((entrypoint . ,entry-point)) ((name . value)
#nil)) (string-append name "=" value)))
environment))
,@(if entry-point
`((entrypoint . ,entry-point))
'())))
(container_config . #nil) (container_config . #nil)
(os . "linux") (os . "linux")
(rootfs . ((type . "layers") (rootfs . ((type . "layers")
@ -113,6 +117,7 @@ return \"a\"."
(system (utsname:machine (uname))) (system (utsname:machine (uname)))
database database
entry-point entry-point
(environment '())
compressor compressor
(creation-time (current-time time-utc))) (creation-time (current-time time-utc)))
"Write to IMAGE a Docker image archive containing the given PATHS. PREFIX "Write to IMAGE a Docker image archive containing the given PATHS. PREFIX
@ -124,6 +129,9 @@ When DATABASE is true, copy it to /var/guix/db in the image and create
When ENTRY-POINT is true, it must be a list of strings; it is stored as the 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. 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 SYMLINKS must be a list of (SOURCE -> TARGET) tuples describing symlinks to be
created in the image, where each TARGET is relative to PREFIX. created in the image, where each TARGET is relative to PREFIX.
TRANSFORMATIONS must be a list of (OLD -> NEW) tuples describing how to TRANSFORMATIONS must be a list of (OLD -> NEW) tuples describing how to
@ -234,6 +242,7 @@ SRFI-19 time-utc object, as the creation time in metadata."
(lambda () (lambda ()
(scm->json (config (string-append id "/layer.tar") (scm->json (config (string-append id "/layer.tar")
time arch time arch
#:environment environment
#:entry-point entry-point)))) #:entry-point entry-point))))
(with-output-to-file "manifest.json" (with-output-to-file "manifest.json"
(lambda () (lambda ()

233
guix/gexp.scm
View File

@ -39,6 +39,9 @@
gexp-input gexp-input
gexp-input? gexp-input?
gexp-input-thing
gexp-input-output
gexp-input-native?
local-file local-file
local-file? local-file?
@ -78,6 +81,14 @@
load-path-expression load-path-expression
gexp-modules 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->derivation
gexp->file gexp->file
gexp->script gexp->script
@ -566,15 +577,20 @@ list."
"Turn any package from INPUTS into a derivation for SYSTEM; return the "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 corresponding input list as a monadic value. When TARGET is true, use it as
the cross-compilation target triplet." the cross-compilation target triplet."
(define (store-item? obj)
(and (string? obj) (store-path? obj)))
(with-monad %store-monad (with-monad %store-monad
(mapm %store-monad (mapm %store-monad
(match-lambda (match-lambda
(((? struct? thing) sub-drv ...) (((? struct? thing) sub-drv ...)
(mlet %store-monad ((drv (lower-object (mlet %store-monad ((drv (lower-object
thing system #:target target))) thing system #:target target)))
(return `(,drv ,@sub-drv)))) (return (apply gexp-input drv sub-drv))))
(((? store-item? item))
(return (gexp-input item)))
(input (input
(return input))) (return (gexp-input input))))
inputs))) inputs)))
(define* (lower-reference-graphs graphs #:key system target) (define* (lower-reference-graphs graphs #:key system target)
@ -586,7 +602,9 @@ corresponding derivation."
(mlet %store-monad ((inputs (lower-inputs inputs (mlet %store-monad ((inputs (lower-inputs inputs
#:system system #:system system
#:target target))) #: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) (define* (lower-references lst #:key system target)
"Based on LST, a list of output names and packages, return a list of output "Based on LST, a list of output names and packages, return a list of output
@ -618,6 +636,127 @@ names and file names suitable for the #:allowed-references argument to
(lambda (system) (lambda (system)
((force proc) 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 (define* (gexp->derivation name exp
#:key #:key
system (target 'current) system (target 'current)
@ -676,10 +815,8 @@ DEPRECATION-WARNINGS determines whether to show deprecation warnings while
compiling modules. It can be #f, #t, or 'detailed. compiling modules. It can be #f, #t, or 'detailed.
The other arguments are as for 'derivation'." The other arguments are as for 'derivation'."
(define %modules
(delete-duplicates
(append modules (gexp-modules exp))))
(define outputs (gexp-outputs exp)) (define outputs (gexp-outputs exp))
(define requested-graft? graft?)
(define (graphs-file-names graphs) (define (graphs-file-names graphs)
;; Return a list of (FILE-NAME . STORE-PATH) pairs made from GRAPHS. ;; Return a list of (FILE-NAME . STORE-PATH) pairs made from GRAPHS.
@ -693,11 +830,13 @@ The other arguments are as for 'derivation'."
(cons file-name thing))) (cons file-name thing)))
graphs)) graphs))
(define (extension-flags extension) (define (add-modules exp modules)
`("-L" ,(string-append (derivation->output-path extension) (if (null? modules)
"/share/guile/site/" effective-version) exp
"-C" ,(string-append (derivation->output-path extension) (make-gexp (gexp-references exp)
"/lib/guile/" effective-version "/site-ccache"))) (append modules (gexp-self-modules exp))
(gexp-self-extensions exp)
(gexp-proc exp))))
(mlet* %store-monad ( ;; The following binding forces '%current-system' and (mlet* %store-monad ( ;; The following binding forces '%current-system' and
;; '%current-target-system' to be looked up at >>= ;; '%current-target-system' to be looked up at >>=
@ -708,38 +847,19 @@ The other arguments are as for 'derivation'."
(target -> (if (eq? target 'current) (target -> (if (eq? target 'current)
(%current-target-system) (%current-target-system)
target)) target))
(normals (lower-inputs (gexp-inputs exp) (exp -> (add-modules exp modules))
#:system system (lowered (lower-gexp exp
#:target target)) #:module-path module-path
(natives (lower-inputs (gexp-native-inputs exp) #:system system
#:system system #:target target
#:target #f)) #:graft? requested-graft?
(inputs -> (append normals natives)) #:guile-for-build
(sexp (gexp->sexp exp guile-for-build
#:system system #:effective-version
#:target target)) effective-version
(builder (text-file script-name #:deprecation-warnings
(object->string sexp))) deprecation-warnings))
(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)))
(graphs (if references-graphs (graphs (if references-graphs
(lower-reference-graphs references-graphs (lower-reference-graphs references-graphs
#:system system #:system system
@ -755,32 +875,30 @@ The other arguments are as for 'derivation'."
#:system system #:system system
#:target target) #:target target)
(return #f))) (return #f)))
(guile (if guile-for-build (guile -> (lowered-gexp-guile lowered))
(return guile-for-build) (builder (text-file script-name
(default-guile-derivation system)))) (object->string
(lowered-gexp-sexp lowered)))))
(mbegin %store-monad (mbegin %store-monad
(set-grafting graft?) ;restore the initial setting (set-grafting graft?) ;restore the initial setting
(raw-derivation name (raw-derivation name
(string-append (derivation->output-path guile) (string-append (derivation->output-path guile)
"/bin/guile") "/bin/guile")
`("--no-auto-compile" `("--no-auto-compile"
,@(if (pair? %modules) ,@(append-map (lambda (directory)
`("-L" ,(if (derivation? modules) `("-L" ,directory))
(derivation->output-path modules) (lowered-gexp-load-path lowered))
modules) ,@(append-map (lambda (directory)
"-C" ,(derivation->output-path compiled)) `("-C" ,directory))
'()) (lowered-gexp-load-compiled-path lowered))
,@(append-map extension-flags exts)
,builder) ,builder)
#:outputs outputs #:outputs outputs
#:env-vars env-vars #:env-vars env-vars
#:system system #:system system
#:inputs `((,guile) #:inputs `((,guile)
(,builder) (,builder)
,@(if modules ,@(map gexp-input->tuple
`((,modules) (,compiled) ,@inputs) (lowered-gexp-inputs lowered))
inputs)
,@(map list exts)
,@(match graphs ,@(match graphs
(((_ . inputs) ...) inputs) (((_ . inputs) ...) inputs)
(_ '()))) (_ '())))
@ -796,6 +914,7 @@ The other arguments are as for 'derivation'."
(define* (gexp-inputs exp #:key native?) (define* (gexp-inputs exp #:key native?)
"Return the input list for EXP. When NATIVE? is true, return only native "Return the input list for EXP. When NATIVE? is true, return only native
references; otherwise, return only non-native references." references; otherwise, return only non-native references."
;; TODO: Return <gexp-input> records instead of tuples.
(define (add-reference-inputs ref result) (define (add-reference-inputs ref result)
(match ref (match ref
(($ <gexp-input> (? gexp? exp) _ #t) (($ <gexp-input> (? gexp? exp) _ #t)

9
guix/inferior.scm
View File

@ -59,6 +59,7 @@
inferior-eval inferior-eval
inferior-eval-with-store inferior-eval-with-store
inferior-object? inferior-object?
read-repl-response
inferior-packages inferior-packages
inferior-available-packages inferior-available-packages
@ -183,7 +184,8 @@ equivalent. Return #f if the inferior could not be launched."
(set-record-type-printer! <inferior-object> write-inferior-object) (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 (define sexp->object
(match-lambda (match-lambda
(('value value) (('value value)
@ -191,12 +193,15 @@ equivalent. Return #f if the inferior could not be launched."
(('non-self-quoting address string) (('non-self-quoting address string)
(inferior-object address string)))) (inferior-object address string))))
(match (read (inferior-socket inferior)) (match (read port)
(('values objects ...) (('values objects ...)
(apply values (map sexp->object objects))) (apply values (map sexp->object objects)))
(('exception key objects ...) (('exception key objects ...)
(apply throw key (map sexp->object 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) (define (send-inferior-request exp inferior)
(write exp (inferior-socket inferior)) (write exp (inferior-socket inferior))
(newline (inferior-socket inferior))) (newline (inferior-socket inferior)))

134
guix/remote.scm Normal file
View File

@ -0,0 +1,134 @@
;;; 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)))))))

86
guix/repl.scm Normal file
View File

@ -0,0 +1,86 @@
;;; 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)))))

84
guix/scripts/deploy.scm Normal file
View File

@ -0,0 +1,84 @@
;;; 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:
(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))))

67
guix/scripts/environment.scm
View File

@ -162,6 +162,10 @@ COMMAND or an interactive shell in that environment.\n"))
-u, --user=USER instead of copying the name and home of the current -u, --user=USER instead of copying the name and home of the current
user into an isolated container, use the name USER user into an isolated container, use the name USER
with home directory /home/USER")) with home directory /home/USER"))
(display (G_ "
--no-cwd do not share current working directory with an
isolated container"))
(display (G_ " (display (G_ "
--share=SPEC for containers, share writable host file system --share=SPEC for containers, share writable host file system
according to SPEC")) according to SPEC"))
@ -270,6 +274,9 @@ use '--preserve' instead~%"))
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'user arg (alist-cons 'user arg
(alist-delete 'user result eq?)))) (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 (option '("share") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'file-system-mapping (alist-cons 'file-system-mapping
@ -445,7 +452,8 @@ regexps in WHITE-LIST."
((_ . status) status))))) ((_ . status) status)))))
(define* (launch-environment/container #:key command bash user user-mappings (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. "Run COMMAND within a container that features the software in PROFILE.
Environment variables are set according to the search paths of MANIFEST. 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 The global shell is BASH, a file name for a GNU Bash binary in the
@ -480,26 +488,29 @@ will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from
;; /bin/sh, the current working directory, and possibly networking ;; /bin/sh, the current working directory, and possibly networking
;; configuration files within the container. ;; configuration files within the container.
(mappings (mappings
(override-user-mappings (append
user home (override-user-mappings
(append user-mappings user home
;; Current working directory. (append user-mappings
(list (file-system-mapping ;; Share current working directory, unless asked not to.
(source cwd) (if map-cwd?
(target cwd) (list (file-system-mapping
(writable? #t))) (source cwd)
;; When in Rome, do as Nix build.cc does: Automagically (target cwd)
;; map common network configuration files. (writable? #t)))
(if network? '())))
%network-file-mappings ;; When in Rome, do as Nix build.cc does: Automagically
'()) ;; map common network configuration files.
;; Mappings for the union closure of all inputs. (if network?
(map (lambda (dir) %network-file-mappings
(file-system-mapping '())
(source dir) ;; Mappings for the union closure of all inputs.
(target dir) (map (lambda (dir)
(writable? #f))) (file-system-mapping
reqs)))) (source dir)
(target dir)
(writable? #f)))
reqs)))
(file-systems (append %container-file-systems (file-systems (append %container-file-systems
(map file-system-mapping->bind-mount (map file-system-mapping->bind-mount
mappings)))) mappings))))
@ -537,8 +548,10 @@ will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from
(write-group groups) (write-group groups)
;; For convenience, start in the user's current working ;; For convenience, start in the user's current working
;; directory rather than the root directory. ;; directory or, if unmapped, the home directory.
(chdir (override-user-dir user home cwd)) (chdir (if map-cwd?
(override-user-dir user home cwd)
home-dir))
(primitive-exit/status (primitive-exit/status
;; A container's environment is already purified, so no need to ;; A container's environment is already purified, so no need to
@ -664,6 +677,7 @@ message if any test fails."
(container? (assoc-ref opts 'container?)) (container? (assoc-ref opts 'container?))
(link-prof? (assoc-ref opts 'link-profile?)) (link-prof? (assoc-ref opts 'link-profile?))
(network? (assoc-ref opts 'network?)) (network? (assoc-ref opts 'network?))
(no-cwd? (assoc-ref opts 'no-cwd?))
(user (assoc-ref opts 'user)) (user (assoc-ref opts 'user))
(bootstrap? (assoc-ref opts 'bootstrap?)) (bootstrap? (assoc-ref opts 'bootstrap?))
(system (assoc-ref opts 'system)) (system (assoc-ref opts 'system))
@ -684,6 +698,9 @@ message if any test fails."
(leave (G_ "'--link-profile' cannot be used without '--container'~%"))) (leave (G_ "'--link-profile' cannot be used without '--container'~%")))
(when (and (not container?) user) (when (and (not container?) user)
(leave (G_ "'--user' cannot be used without '--container'~%"))) (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-store store
(with-status-verbosity (assoc-ref opts 'verbosity) (with-status-verbosity (assoc-ref opts 'verbosity)
@ -740,7 +757,9 @@ message if any test fails."
#:profile profile #:profile profile
#:manifest manifest #:manifest manifest
#:link-profile? link-prof? #:link-profile? link-prof?
#:network? network?))) #:network? network?
#:map-cwd? (not no-cwd?))))
(else (else
(return (return
(exit/status (exit/status

18
guix/scripts/gc.scm
View File

@ -104,11 +104,14 @@ Invoke the garbage collector.\n"))
'())))) '()))))
(define (delete-old-generations store profile pattern) (define (delete-old-generations store profile pattern)
"Remove the generations of PROFILE that match PATTERN, a duration pattern. "Remove the generations of PROFILE that match PATTERN, a duration pattern;
Do nothing if none matches." do nothing if none matches. If PATTERN is #f, delete all generations but the
current one."
(let* ((current (generation-number profile)) (let* ((current (generation-number profile))
(numbers (matching-generations pattern profile (numbers (if (not pattern)
#:duration-relation >))) (profile-generations profile)
(matching-generations pattern profile
#:duration-relation >))))
;; Make sure we don't inadvertently remove the current generation. ;; Make sure we don't inadvertently remove the current generation.
(delete-generations store profile (delv current numbers)))) (delete-generations store profile (delv current numbers))))
@ -155,8 +158,7 @@ is deprecated; use '-D'~%"))
(when (and arg (not (string->duration arg))) (when (and arg (not (string->duration arg)))
(leave (G_ "~s does not denote a duration~%") (leave (G_ "~s does not denote a duration~%")
arg)) arg))
(alist-cons 'delete-generations (or arg "") (alist-cons 'delete-generations arg result)))))
result)))))
(option '("optimize") #f #f (option '("optimize") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'action 'optimize (alist-cons 'action 'optimize
@ -287,9 +289,9 @@ is deprecated; use '-D'~%"))
(assert-no-extra-arguments) (assert-no-extra-arguments)
(let ((min-freed (assoc-ref opts 'min-freed)) (let ((min-freed (assoc-ref opts 'min-freed))
(free-space (assoc-ref opts 'free-space))) (free-space (assoc-ref opts 'free-space)))
(match (assoc-ref opts 'delete-generations) (match (assq 'delete-generations opts)
(#f #t) (#f #t)
((? string? pattern) ((_ . pattern)
(delete-generations store pattern))) (delete-generations store pattern)))
(cond (cond
(free-space (free-space

64
guix/scripts/pack.scm
View File

@ -27,6 +27,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix store) #:use-module (guix store)
#:use-module ((guix status) #:select (with-status-verbosity)) #:use-module ((guix status) #:select (with-status-verbosity))
#:use-module ((guix self) #:select (make-config.scm))
#:use-module (guix grafts) #:use-module (guix grafts)
#:autoload (guix inferior) (inferior-package?) #:autoload (guix inferior) (inferior-package?)
#:use-module (guix monads) #:use-module (guix monads)
@ -285,6 +286,32 @@ added to the pack."
build build
#:references-graphs `(("profile" ,profile)))) #: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 (define* (squashfs-image name profile
#:key target #:key target
(profile-name "guix-profile") (profile-name "guix-profile")
@ -304,6 +331,9 @@ added to the pack."
(file-append (store-database (list profile)) (file-append (store-database (list profile))
"/db/db.sqlite"))) "/db/db.sqlite")))
(define environment
(singularity-environment-file profile))
(define build (define build
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((guix build utils) '((guix build utils)
@ -338,6 +368,7 @@ added to the pack."
`(,@(map store-info-item `(,@(map store-info-item
(call-with-input-file "profile" (call-with-input-file "profile"
read-reference-graph)) read-reference-graph))
#$environment
,#$output ,#$output
;; Do not perform duplicate checking because we ;; Do not perform duplicate checking because we
@ -378,10 +409,19 @@ added to the pack."
target))))))) target)))))))
'#$symlinks) '#$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' ;; Create /.singularity.d/actions, and optionally the 'run'
;; script, used by 'singularity run'. ;; script, used by 'singularity run'.
"-p" "/.singularity.d d 555 0 0"
"-p" "/.singularity.d/actions d 555 0 0" "-p" "/.singularity.d/actions d 555 0 0"
,@(if entry-point ,@(if entry-point
`(;; This one if for Singularity 2.x. `(;; This one if for Singularity 2.x.
"-p" "-p"
@ -440,11 +480,24 @@ the image."
(define build (define build
;; Guile-JSON and Guile-Gcrypt are required by (guix docker). ;; Guile-JSON and Guile-Gcrypt are required by (guix docker).
(with-extensions (list guile-json guile-gcrypt) (with-extensions (list guile-json guile-gcrypt)
(with-imported-modules (source-module-closure '((guix docker) (with-imported-modules `(((guix config) => ,(make-config.scm))
(guix build store-copy)) ,@(source-module-closure
#:select? not-config?) `((guix docker)
(guix build store-copy)
(guix profiles)
(guix search-paths))
#:select? not-config?))
#~(begin #~(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")) (setenv "PATH" (string-append #$archiver "/bin"))
@ -455,6 +508,7 @@ the image."
#$profile #$profile
#:database #+database #:database #+database
#:system (or #$target (utsname:machine (uname))) #:system (or #$target (utsname:machine (uname)))
#:environment environment
#:entry-point #$(and entry-point #:entry-point #$(and entry-point
#~(string-append #$profile "/" #~(string-append #$profile "/"
#$entry-point)) #$entry-point))

17
guix/scripts/package.scm
View File

@ -98,7 +98,7 @@ denote ranges as interpreted by 'matching-generations'."
(cond ((not (file-exists? profile)) ; XXX: race condition (cond ((not (file-exists? profile)) ; XXX: race condition
(raise (condition (&profile-not-found-error (raise (condition (&profile-not-found-error
(profile profile))))) (profile profile)))))
((string-null? pattern) ((not pattern)
(delete-generations store profile (delete-generations store profile
(delv current (profile-generations profile)))) (delv current (profile-generations profile))))
;; Do not delete the zeroth generation. ;; Do not delete the zeroth generation.
@ -120,9 +120,7 @@ denote ranges as interpreted by 'matching-generations'."
(let ((numbers (delv current numbers))) (let ((numbers (delv current numbers)))
(when (null-list? numbers) (when (null-list? numbers)
(leave (G_ "no matching generation~%"))) (leave (G_ "no matching generation~%")))
(delete-generations store profile numbers)))) (delete-generations store profile numbers)))))))
(else
(leave (G_ "invalid syntax: ~a~%") pattern)))))
(define* (build-and-use-profile store profile manifest (define* (build-and-use-profile store profile manifest
#:key #:key
@ -457,12 +455,12 @@ command-line option~%")
arg-handler))) arg-handler)))
(option '(#\l "list-generations") #f #t (option '(#\l "list-generations") #f #t
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (cons `(query list-generations ,(or arg "")) (values (cons `(query list-generations ,arg)
result) result)
#f))) #f)))
(option '(#\d "delete-generations") #f #t (option '(#\d "delete-generations") #f #t
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(values (alist-cons 'delete-generations (or arg "") (values (alist-cons 'delete-generations arg
result) result)
#f))) #f)))
(option '(#\S "switch-generation") #t #f (option '(#\S "switch-generation") #t #f
@ -683,7 +681,7 @@ processed, #f otherwise."
(cond ((not (file-exists? profile)) ; XXX: race condition (cond ((not (file-exists? profile)) ; XXX: race condition
(raise (condition (&profile-not-found-error (raise (condition (&profile-not-found-error
(profile profile))))) (profile profile)))))
((string-null? pattern) ((not pattern)
(match (profile-generations profile) (match (profile-generations profile)
(() (()
#t) #t)
@ -697,10 +695,7 @@ processed, #f otherwise."
(exit 1) (exit 1)
(begin (begin
(list-generation display-profile-content (car numbers)) (list-generation display-profile-content (car numbers))
(diff-profiles profile numbers))))) (diff-profiles profile numbers)))))))
(else
(leave (G_ "invalid syntax: ~a~%")
pattern))))
#t) #t)
(('list-installed regexp) (('list-installed regexp)

4
guix/scripts/pull.scm
View File

@ -117,7 +117,7 @@ Download and deploy the latest version of Guix.\n"))
(alist-cons 'channel-file arg result))) (alist-cons 'channel-file arg result)))
(option '(#\l "list-generations") #f #t (option '(#\l "list-generations") #f #t
(lambda (opt name arg result) (lambda (opt name arg result)
(cons `(query list-generations ,(or arg "")) (cons `(query list-generations ,arg)
result))) result)))
(option '(#\N "news") #f #f (option '(#\N "news") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
@ -486,7 +486,7 @@ list of package changes.")))))
(cond ((not (file-exists? profile)) ; XXX: race condition (cond ((not (file-exists? profile)) ; XXX: race condition
(raise (condition (&profile-not-found-error (raise (condition (&profile-not-found-error
(profile profile))))) (profile profile)))))
((string-null? pattern) ((not pattern)
(list-generations profile (profile-generations profile))) (list-generations profile (profile-generations profile)))
((matching-generations pattern profile) ((matching-generations pattern profile)
=> =>

56
guix/scripts/repl.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,6 +19,7 @@
(define-module (guix scripts repl) (define-module (guix scripts repl)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module (guix repl)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (gnu packages) #:use-module (gnu packages)
@ -29,8 +30,7 @@
#:autoload (system repl repl) (start-repl) #:autoload (system repl repl) (start-repl)
#:autoload (system repl server) #:autoload (system repl server)
(make-tcp-server-socket make-unix-domain-server-socket) (make-tcp-server-socket make-unix-domain-server-socket)
#:export (machine-repl #:export (guix-repl))
guix-repl))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -68,62 +68,12 @@ Start a Guile REPL in the Guix execution environment.\n"))
(newline) (newline)
(show-bug-report-information)) (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 (define user-module
;; Module where we execute user code. ;; Module where we execute user code.
(let ((module (resolve-module '(guix-user) #f #f #:ensure #t))) (let ((module (resolve-module '(guix-user) #f #f #:ensure #t)))
(beautify-user-module! module) (beautify-user-module! 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) (define (call-with-connection spec thunk)
"Dynamically-bind the current input and output ports according to SPEC and "Dynamically-bind the current input and output ports according to SPEC and
call THUNK." call THUNK."

10
guix/scripts/system.scm
View File

@ -614,7 +614,7 @@ PATTERN, a string. When PATTERN is #f, display all the system generations."
(cond ((not (file-exists? profile)) ; XXX: race condition (cond ((not (file-exists? profile)) ; XXX: race condition
(raise (condition (&profile-not-found-error (raise (condition (&profile-not-found-error
(profile profile))))) (profile profile)))))
((string-null? pattern) ((not pattern)
(for-each display-system-generation (profile-generations profile))) (for-each display-system-generation (profile-generations profile)))
((matching-generations pattern profile) ((matching-generations pattern profile)
=> =>
@ -622,9 +622,7 @@ PATTERN, a string. When PATTERN is #f, display all the system generations."
(if (null-list? numbers) (if (null-list? numbers)
(exit 1) (exit 1)
(leave-on-EPIPE (leave-on-EPIPE
(for-each display-system-generation numbers))))) (for-each display-system-generation numbers)))))))
(else
(leave (G_ "invalid syntax: ~a~%") pattern))))
;;; ;;;
@ -1232,7 +1230,7 @@ argument list and OPTS is the option alist."
;; an operating system configuration file. ;; an operating system configuration file.
((list-generations) ((list-generations)
(let ((pattern (match args (let ((pattern (match args
(() "") (() #f)
((pattern) pattern) ((pattern) pattern)
(x (leave (G_ "wrong number of arguments~%")))))) (x (leave (G_ "wrong number of arguments~%"))))))
(list-generations pattern))) (list-generations pattern)))
@ -1242,7 +1240,7 @@ argument list and OPTS is the option alist."
;; operating system configuration file. ;; operating system configuration file.
((delete-generations) ((delete-generations)
(let ((pattern (match args (let ((pattern (match args
(() "") (() #f)
((pattern) pattern) ((pattern) pattern)
(x (leave (G_ "wrong number of arguments~%")))))) (x (leave (G_ "wrong number of arguments~%"))))))
(with-store store (with-store store

3
guix/self.scm
View File

@ -770,7 +770,8 @@ Info manual."
(gnu services) (gnu services)
,@(scheme-modules* source "gnu/bootloader") ,@(scheme-modules* source "gnu/bootloader")
,@(scheme-modules* source "gnu/system") ,@(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* (list *core-package-modules* *package-modules*
*extra-modules* *core-modules*) *extra-modules* *core-modules*)
#:extensions dependencies #:extensions dependencies

10
guix/ssh.scm
View File

@ -57,12 +57,14 @@
(define %compression (define %compression
"zlib@openssh.com,zlib") "zlib@openssh.com,zlib")
(define* (open-ssh-session host #:key user port (define* (open-ssh-session host #:key user port identity
(compression %compression)) (compression %compression))
"Open an SSH session for HOST and return it. When USER and PORT are #f, use "Open an SSH session for HOST and return it. IDENTITY specifies the file
default values or whatever '~/.ssh/config' specifies; otherwise use them. name of a private key to use for authenticating with the host. When USER,
Throw an error on failure." 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 (let ((session (make-session #:user user
#:identity identity
#:host host #:host host
#:port port #:port port
#:timeout 10 ;seconds #:timeout 10 ;seconds

11
guix/store.scm
View File

@ -1802,11 +1802,12 @@ connection, and return the result."
(call-with-values (lambda () (call-with-values (lambda ()
(run-with-state mval store)) (run-with-state mval store))
(lambda (result new-store) (lambda (result new-store)
;; Copy the object cache from NEW-STORE so we don't fully discard the (when (and store new-store)
;; state. ;; Copy the object cache from NEW-STORE so we don't fully discard
(let ((cache (store-connection-object-cache new-store))) ;; the state.
(set-store-connection-object-cache! store cache) (let ((cache (store-connection-object-cache new-store)))
result))))) (set-store-connection-object-cache! store cache)))
result))))
;;; ;;;

21
guix/ui.scm
View File

@ -835,8 +835,7 @@ check and report what is prerequisites are available for download."
;; substituter many times. This makes a big difference, especially when ;; substituter many times. This makes a big difference, especially when
;; DRV is a long list as is the case with 'guix environment'. ;; DRV is a long list as is the case with 'guix environment'.
(if use-substitutes? (if use-substitutes?
(substitution-oracle store (map derivation-input-derivation inputs) (substitution-oracle store inputs #:mode mode)
#:mode mode)
(const #f))) (const #f)))
(let*-values (((build download) (let*-values (((build download)
@ -844,18 +843,6 @@ check and report what is prerequisites are available for download."
#:mode mode #:mode mode
#:substitutable-info #:substitutable-info
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) ((graft hook build)
(match (fold (lambda (drv acc) (match (fold (lambda (drv acc)
(let ((file (derivation-file-name drv))) (let ((file (derivation-file-name drv)))
@ -1497,7 +1484,11 @@ DURATION-RELATION with the current time."
((string->duration str) ((string->duration str)
=> =>
filter-by-duration) filter-by-duration)
(else #f))) (else
(raise
(condition (&message
(message (format #f (G_ "invalid syntax: ~a~%")
str))))))))
(define (display-generation profile number) (define (display-generation profile number)
"Display a one-line summary of generation NUMBER of PROFILE." "Display a one-line summary of generation NUMBER of PROFILE."

2
po/guix/POTFILES.in
View File

@ -36,6 +36,7 @@ gnu/installer/steps.scm
gnu/installer/timezone.scm gnu/installer/timezone.scm
gnu/installer/user.scm gnu/installer/user.scm
gnu/installer/utils.scm gnu/installer/utils.scm
gnu/machine/ssh.scm
gnu/packages/bootstrap.scm gnu/packages/bootstrap.scm
guix/build/utils.scm guix/build/utils.scm
guix/scripts.scm guix/scripts.scm
@ -68,6 +69,7 @@ guix/scripts/pack.scm
guix/scripts/weather.scm guix/scripts/weather.scm
guix/scripts/describe.scm guix/scripts/describe.scm
guix/scripts/processes.scm guix/scripts/processes.scm
guix/scripts/deploy.scm
guix/gnu-maintenance.scm guix/gnu-maintenance.scm
guix/scripts/container.scm guix/scripts/container.scm
guix/scripts/container/exec.scm guix/scripts/container/exec.scm

129
release.nix
View File

@ -1,129 +0,0 @@
/* 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

29
tests/derivations.scm
View File

@ -895,6 +895,35 @@
(((= derivation-file-name build)) (((= derivation-file-name build))
(string=? build (derivation-file-name drv))))))))) (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" (test-assert "derivation-build-plan and substitutes, local build"
(with-store store (with-store store
(let* ((drv (build-expression->derivation store "prereq-subst-local" (let* ((drv (build-expression->derivation store "prereq-subst-local"

37
tests/gexp.scm
View File

@ -832,6 +832,43 @@
(built-derivations (list drv)) (built-derivations (list drv))
(return (equal? '(42 84) (call-with-input-file out read)))))) (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" (test-assertm "gexp->derivation #:references-graphs"
(mlet* %store-monad (mlet* %store-monad
((one (text-file "one" (random-text))) ((one (text-file "one" (random-text)))

8
tests/guix-environment.sh
View File

@ -84,6 +84,14 @@ echo "(use-modules (guix profiles) (gnu packages bootstrap))
guix environment --bootstrap --manifest=$tmpdir/manifest.scm --pure \ guix environment --bootstrap --manifest=$tmpdir/manifest.scm --pure \
-- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile"' -- "$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. # Make sure '-r' works as expected.
rm -f "$gcroot" rm -f "$gcroot"
expected="`guix environment --bootstrap --ad-hoc guile-bootstrap \ expected="`guix environment --bootstrap --ad-hoc guile-bootstrap \