me
/
guix
Archived
1
0
Fork 0

Merge branch 'master' into core-updates

master
Marius Bakke 2017-08-01 23:42:28 +02:00
commit aa9780daf9
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
65 changed files with 1740 additions and 611 deletions

View File

@ -219,6 +219,7 @@ Services
* Database Services:: SQL databases. * Database Services:: SQL databases.
* Mail Services:: IMAP, POP3, SMTP, and all that. * Mail Services:: IMAP, POP3, SMTP, and all that.
* Messaging Services:: Messaging services. * Messaging Services:: Messaging services.
* Monitoring Services:: Monitoring services.
* Kerberos Services:: Kerberos services. * Kerberos Services:: Kerberos services.
* Web Services:: Web servers. * Web Services:: Web servers.
* DNS Services:: DNS daemons. * DNS Services:: DNS daemons.
@ -9011,6 +9012,7 @@ declaration.
* Database Services:: SQL databases. * Database Services:: SQL databases.
* Mail Services:: IMAP, POP3, SMTP, and all that. * Mail Services:: IMAP, POP3, SMTP, and all that.
* Messaging Services:: Messaging services. * Messaging Services:: Messaging services.
* Monitoring Services:: Monitoring services.
* Kerberos Services:: Kerberos services. * Kerberos Services:: Kerberos services.
* Web Services:: Web servers. * Web Services:: Web servers.
* DNS Services:: DNS daemons. * DNS Services:: DNS daemons.
@ -10201,10 +10203,22 @@ shell daemon, @command{sshd}. Its value must be an
(service openssh-service-type (service openssh-service-type
(openssh-configuration (openssh-configuration
(x11-forwarding? #t) (x11-forwarding? #t)
(permit-root-login 'without-password))) (permit-root-login 'without-password)
(authorized-keys
`(("alice" ,(local-file "alice.pub"))
("bob" ,(local-file "bob.pub"))))))
@end example @end example
See below for details about @code{openssh-configuration}. See below for details about @code{openssh-configuration}.
This service can be extended with extra authorized keys, as in this
example:
@example
(service-extension openssh-service-type
(const `(("charlie"
,(local-file "charlie.pub")))))
@end example
@end deffn @end deffn
@deftp {Data Type} openssh-configuration @deftp {Data Type} openssh-configuration
@ -10276,8 +10290,33 @@ server. Alternately, one can specify the @command{sftp-server} command:
(service openssh-service-type (service openssh-service-type
(openssh-configuration (openssh-configuration
(subsystems (subsystems
'(("sftp" ,(file-append openssh "/libexec/sftp-server")))))) `(("sftp" ,(file-append openssh "/libexec/sftp-server"))))))
@end example @end example
@item @code{authorized-keys} (default: @code{'()})
@cindex authorized keys, SSH
@cindex SSH authorized keys
This is the list of authorized keys. Each element of the list is a user
name followed by one or more file-like objects that represent SSH public
keys. For example:
@example
(openssh-configuration
(authorized-keys
`(("rekado" ,(local-file "rekado.pub"))
("chris" ,(local-file "chris.pub"))
("root" ,(local-file "rekado.pub") ,(local-file "chris.pub")))))
@end example
@noindent
registers the specified public keys for user accounts @code{rekado},
@code{chris}, and @code{root}.
Additional authorized keys can be specified @i{via}
@code{service-extension}.
Note that this does @emph{not} interfere with the use of
@file{~/.ssh/authorized_keys}.
@end table @end table
@end deftp @end deftp
@ -11722,6 +11761,38 @@ TCP port on which the database server listens for incoming connections.
@end table @end table
@end deftp @end deftp
@defvr {Scheme Variable} memcached-service-type
This is the service type for the @uref{https://memcached.org/,
Memcached} service, which provides a distributed in memory cache. The
value for the service type is a @code{memcached-configuration} object.
@end defvr
@example
(service memcached-service-type)
@end example
@deftp {Data Type} memcached-configuration
Data type representing the configuration of memcached.
@table @asis
@item @code{memcached} (default: @code{memcached})
The Memcached package to use.
@item @code{interfaces} (default: @code{'("0.0.0.0")})
Network interfaces on which to listen.
@item @code{tcp-port} (default: @code{11211})
Port on which to accept connections on,
@item @code{udp-port} (default: @code{11211})
Port on which to accept UDP connections on, a value of 0 will disable
listening on a UDP socket.
@item @code{additional-options} (default: @code{'()})
Additional command line options to pass to @code{memcached}.
@end table
@end deftp
@defvr {Scheme Variable} redis-service-type @defvr {Scheme Variable} redis-service-type
This is the service type for the @uref{https://redis.io/, Redis} This is the service type for the @uref{https://redis.io/, Redis}
key/value store, whose value is a @code{redis-configuration} object. key/value store, whose value is a @code{redis-configuration} object.
@ -13599,6 +13670,94 @@ string, you could instantiate a prosody service like this:
(prosody.cfg.lua ""))) (prosody.cfg.lua "")))
@end example @end example
@node Monitoring Services
@subsubsection Monitoring Services
@subsubheading Tailon Service
@uref{https://tailon.readthedocs.io/, Tailon} is a web application for
viewing and searching log files.
The following example will configure the service with default values.
By default, Tailon can be accessed on port 8080 (@code{http://localhost:8080}).
@example
(service tailon-service-type)
@end example
The following example customises more of the Tailon configuration,
adding @command{sed} to the list of allowed commands.
@example
(service tailon-service-type
(tailon-configuration
(config-file
(tailon-configuration-file
(allowed-commands '("tail" "grep" "awk" "sed"))))))
@end example
@deftp {Data Type} tailon-configuration
Data type representing the configuration of Tailon.
This type has the following parameters:
@table @asis
@item @code{config-file} (default: @code{(tailon-configuration-file)})
The configuration file to use for Tailon. This can be set to a
@dfn{tailon-configuration-file} record value, or any gexp
(@pxref{G-Expressions}).
For example, to instead use a local file, the @code{local-file} function
can be used:
@example
(service tailon-service-type
(tailon-configuration
(config-file (local-file "./my-tailon.conf"))))
@end example
@item @code{package} (default: @code{tailon})
The tailon package to use.
@end table
@end deftp
@deftp {Data Type} tailon-configuration-file
Data type representing the configuration options for Tailon.
This type has the following parameters:
@table @asis
@item @code{files} (default: @code{(list "/var/log")})
List of files to display. The list can include strings for a single file
or directory, or a list, where the first item is the name of a
subsection, and the remaining items are the files or directories in that
subsection.
@item @code{bind} (default: @code{"localhost:8080"})
Address and port to which Tailon should bind on.
@item @code{relative-root} (default: @code{#f})
URL path to use for Tailon, set to @code{#f} to not use a path.
@item @code{allow-transfers?} (default: @code{#t})
Allow downloading the log files in the web interface.
@item @code{follow-names?} (default: @code{#t})
Allow tailing of not-yet existent files.
@item @code{tail-lines} (default: @code{200})
Number of lines to read initially from each file.
@item @code{allowed-commands} (default: @code{(list "tail" "grep" "awk")})
Commands to allow running. By default, @code{sed} is disabled.
@item @code{debug?} (default: @code{#f})
Set @code{debug?} to @code{#t} to show debug messages.
@end table
@end deftp
@node Kerberos Services @node Kerberos Services
@subsubsection Kerberos Services @subsubsection Kerberos Services
@cindex Kerberos @cindex Kerberos
@ -16350,7 +16509,13 @@ passed.
@anchor{guix system vm} @anchor{guix system vm}
Build a virtual machine that contains the operating system declared in Build a virtual machine that contains the operating system declared in
@var{file}, and return a script to run that virtual machine (VM). @var{file}, and return a script to run that virtual machine (VM).
Arguments given to the script are passed to QEMU. Arguments given to the script are passed to QEMU as in the example
below, which enables networking and requests 1@tie{}GiB of RAM for the
emulated machine:
@example
$ /gnu/store/@dots{}-run-vm.sh -m 1024 -net user
@end example
The VM shares its store with the host system. The VM shares its store with the host system.

View File

@ -30,6 +30,7 @@
menu-entry-linux menu-entry-linux
menu-entry-linux-arguments menu-entry-linux-arguments
menu-entry-initrd menu-entry-initrd
menu-entry-device-mount-point
bootloader bootloader
bootloader? bootloader?
@ -67,6 +68,8 @@
(label menu-entry-label) (label menu-entry-label)
(device menu-entry-device ; file system uuid, label, or #f (device menu-entry-device ; file system uuid, label, or #f
(default #f)) (default #f))
(device-mount-point menu-entry-device-mount-point
(default #f))
(linux menu-entry-linux) (linux menu-entry-linux)
(linux-arguments menu-entry-linux-arguments (linux-arguments menu-entry-linux-arguments
(default '())) ; list of string-valued gexps (default '())) ; list of string-valued gexps

View File

@ -38,14 +38,13 @@
corresponding to old generations of the system." corresponding to old generations of the system."
(define all-entries (define all-entries
(append entries (map menu-entry->boot-parameters (append entries (bootloader-configuration-menu-entries config)))
(bootloader-configuration-menu-entries config))))
(define (boot-parameters->gexp params) (define (menu-entry->gexp entry)
(let ((label (boot-parameters-label params)) (let ((label (menu-entry-label entry))
(kernel (boot-parameters-kernel params)) (kernel (menu-entry-linux entry))
(kernel-arguments (boot-parameters-kernel-arguments params)) (kernel-arguments (menu-entry-linux-arguments entry))
(initrd (boot-parameters-initrd params))) (initrd (menu-entry-initrd entry)))
#~(format port "LABEL ~a #~(format port "LABEL ~a
MENU LABEL ~a MENU LABEL ~a
KERNEL ~a KERNEL ~a
@ -69,11 +68,11 @@ TIMEOUT ~a~%"
(if (> timeout 0) 1 0) (if (> timeout 0) 1 0)
;; timeout is expressed in 1/10s of seconds. ;; timeout is expressed in 1/10s of seconds.
(* 10 timeout)) (* 10 timeout))
#$@(map boot-parameters->gexp all-entries) #$@(map menu-entry->gexp all-entries)
#$@(if (pair? old-entries) #$@(if (pair? old-entries)
#~((format port "~%") #~((format port "~%")
#$@(map boot-parameters->gexp old-entries) #$@(map menu-entry->gexp old-entries)
(format port "~%")) (format port "~%"))
#~()))))) #~())))))

View File

@ -316,16 +316,14 @@ code."
STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
entries corresponding to old generations of the system." entries corresponding to old generations of the system."
(define all-entries (define all-entries
(append entries (map menu-entry->boot-parameters (append entries (bootloader-configuration-menu-entries config)))
(bootloader-configuration-menu-entries config)))) (define (menu-entry->gexp entry)
(let ((device (menu-entry-device entry))
(define (boot-parameters->gexp params) (device-mount-point (menu-entry-device-mount-point entry))
(let ((device (boot-parameters-store-device params)) (label (menu-entry-label entry))
(device-mount-point (boot-parameters-store-mount-point params)) (kernel (menu-entry-linux entry))
(label (boot-parameters-label params)) (arguments (menu-entry-linux-arguments entry))
(kernel (boot-parameters-kernel params)) (initrd (menu-entry-initrd entry)))
(arguments (boot-parameters-kernel-arguments params))
(initrd (boot-parameters-initrd params)))
;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point. ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
;; Use the right file names for KERNEL and INITRD in case ;; Use the right file names for KERNEL and INITRD in case
;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
@ -341,11 +339,10 @@ entries corresponding to old generations of the system."
#$(grub-root-search device kernel) #$(grub-root-search device kernel)
#$kernel (string-join (list #$@arguments)) #$kernel (string-join (list #$@arguments))
#$initrd)))) #$initrd))))
(mlet %store-monad ((sugar (eye-candy config (mlet %store-monad ((sugar (eye-candy config
(boot-parameters-store-device (menu-entry-device
(first all-entries)) (first all-entries))
(boot-parameters-store-mount-point (menu-entry-device-mount-point
(first all-entries)) (first all-entries))
#:system system #:system system
#:port #~port))) #:port #~port)))
@ -362,12 +359,12 @@ set default=~a
set timeout=~a~%" set timeout=~a~%"
#$(bootloader-configuration-default-entry config) #$(bootloader-configuration-default-entry config)
#$(bootloader-configuration-timeout config)) #$(bootloader-configuration-timeout config))
#$@(map boot-parameters->gexp all-entries) #$@(map menu-entry->gexp all-entries)
#$@(if (pair? old-entries) #$@(if (pair? old-entries)
#~((format port " #~((format port "
submenu \"GNU system, old configurations...\" {~%") submenu \"GNU system, old configurations...\" {~%")
#$@(map boot-parameters->gexp old-entries) #$@(map menu-entry->gexp old-entries)
(format port "}~%")) (format port "}~%"))
#~())))) #~()))))

View File

@ -478,7 +478,9 @@ GNU_SYSTEM_MODULES = \
%D%/build/vm.scm \ %D%/build/vm.scm \
\ \
%D%/tests.scm \ %D%/tests.scm \
%D%/tests/admin.scm \
%D%/tests/base.scm \ %D%/tests/base.scm \
%D%/tests/databases.scm \
%D%/tests/dict.scm \ %D%/tests/dict.scm \
%D%/tests/nfs.scm \ %D%/tests/nfs.scm \
%D%/tests/install.scm \ %D%/tests/install.scm \
@ -576,6 +578,7 @@ dist_patch_DATA = \
%D%/packages/patches/emacs-fix-scheme-indent-function.patch \ %D%/packages/patches/emacs-fix-scheme-indent-function.patch \
%D%/packages/patches/emacs-scheme-complete-scheme-r5rs-info.patch \ %D%/packages/patches/emacs-scheme-complete-scheme-r5rs-info.patch \
%D%/packages/patches/emacs-source-date-epoch.patch \ %D%/packages/patches/emacs-source-date-epoch.patch \
%D%/packages/patches/erlang-man-path.patch \
%D%/packages/patches/eudev-rules-directory.patch \ %D%/packages/patches/eudev-rules-directory.patch \
%D%/packages/patches/evilwm-lost-focus-bug.patch \ %D%/packages/patches/evilwm-lost-focus-bug.patch \
%D%/packages/patches/exim-CVE-2017-1000369.patch \ %D%/packages/patches/exim-CVE-2017-1000369.patch \
@ -668,9 +671,6 @@ dist_patch_DATA = \
%D%/packages/patches/guile-present-coding.patch \ %D%/packages/patches/guile-present-coding.patch \
%D%/packages/patches/guile-relocatable.patch \ %D%/packages/patches/guile-relocatable.patch \
%D%/packages/patches/guile-rsvg-pkgconfig.patch \ %D%/packages/patches/guile-rsvg-pkgconfig.patch \
%D%/packages/patches/guile-ssh-channel-finalization.patch \
%D%/packages/patches/guile-ssh-double-free.patch \
%D%/packages/patches/guile-ssh-rexec-bug.patch \
%D%/packages/patches/gtk2-respect-GUIX_GTK2_PATH.patch \ %D%/packages/patches/gtk2-respect-GUIX_GTK2_PATH.patch \
%D%/packages/patches/gtk2-respect-GUIX_GTK2_IM_MODULE_FILE.patch \ %D%/packages/patches/gtk2-respect-GUIX_GTK2_IM_MODULE_FILE.patch \
%D%/packages/patches/gtk2-theme-paths.patch \ %D%/packages/patches/gtk2-theme-paths.patch \
@ -750,7 +750,6 @@ dist_patch_DATA = \
%D%/packages/patches/libgit2-0.25.1-mtime-0.patch \ %D%/packages/patches/libgit2-0.25.1-mtime-0.patch \
%D%/packages/patches/libgdata-fix-tests.patch \ %D%/packages/patches/libgdata-fix-tests.patch \
%D%/packages/patches/libgdata-glib-duplicate-tests.patch \ %D%/packages/patches/libgdata-glib-duplicate-tests.patch \
%D%/packages/patches/libgit2-use-after-free.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 \
@ -948,7 +947,6 @@ dist_patch_DATA = \
%D%/packages/patches/python-pandas-skip-failing-tests.patch \ %D%/packages/patches/python-pandas-skip-failing-tests.patch \
%D%/packages/patches/python-paste-remove-website-test.patch \ %D%/packages/patches/python-paste-remove-website-test.patch \
%D%/packages/patches/python-paste-remove-timing-test.patch \ %D%/packages/patches/python-paste-remove-timing-test.patch \
%D%/packages/patches/python-pbr-fix-man-page-support.patch \
%D%/packages/patches/python-pillow-freetype-2.7-test-failure.patch \ %D%/packages/patches/python-pillow-freetype-2.7-test-failure.patch \
%D%/packages/patches/python-pygit2-disable-network-tests.patch \ %D%/packages/patches/python-pygit2-disable-network-tests.patch \
%D%/packages/patches/python-pycrypto-CVE-2013-7459.patch \ %D%/packages/patches/python-pycrypto-CVE-2013-7459.patch \

View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org> ;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
;;; Copyright © 2014 Manolis Fragkiskos Ragkousis <manolis837@gmail.com> ;;; Copyright © 2014 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;; Copyright © 2015, 2017 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015, 2017 Mark H Weaver <mhw@netris.org>
@ -237,6 +237,7 @@ output is indexed in many ways to simplify browsing.")
(license gpl3+))) (license gpl3+)))
(define-public automake (define-public automake
;; Replace with 'automake/latest' on the next rebuild cycle.
(package (package
(name "automake") (name "automake")
(version "1.15") (version "1.15")
@ -315,6 +316,22 @@ intuitive format and then Automake works with Autoconf to produce a robust
Makefile, simplifying the entire process for the developer.") Makefile, simplifying the entire process for the developer.")
(license gpl2+))) ; some files are under GPLv3+ (license gpl2+))) ; some files are under GPLv3+
(define-public automake/latest
;; Merge with 'automake' on the next rebuild cycle.
(package
(inherit automake)
(version "1.15.1")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/automake/automake-"
version ".tar.xz"))
(sha256
(base32
"1bzd9g32dfm4rsbw93ld9x7b5nc1y6i4m6zp032qf1i28a8s6sxg"))
(patches
(search-patches "automake-skip-amhello-tests.patch"))))))
(define-public libtool (define-public libtool
(package (package
(name "libtool") (name "libtool")

View File

@ -1,6 +1,7 @@
;;; guix-emacs.el --- Emacs packages installed with Guix ;;; guix-emacs.el --- Emacs packages installed with Guix
;; Copyright © 2014, 2015, 2016, 2017 Alex Kost <alezost@gmail.com> ;; Copyright © 2014, 2015, 2016, 2017 Alex Kost <alezost@gmail.com>
;; Copyright © 2017 Kyle Meyer <kyle@kyleam.com>
;; This file is part of GNU Guix. ;; This file is part of GNU Guix.
@ -87,9 +88,11 @@ profiles.
(interactive (list (if (fboundp 'guix-read-package-profile) (interactive (list (if (fboundp 'guix-read-package-profile)
(funcall 'guix-read-package-profile) (funcall 'guix-read-package-profile)
guix-user-profile))) guix-user-profile)))
(let ((profiles (or profiles (let* ((env (getenv "GUIX_ENVIRONMENT"))
(list "/run/current-system/profile" (profiles (or profiles
guix-user-profile)))) (append (list "/run/current-system/profile"
guix-user-profile)
(and env (list env))))))
(dolist (profile profiles) (dolist (profile profiles)
(let ((dirs (guix-emacs-directories profile))) (let ((dirs (guix-emacs-directories profile)))
(when dirs (when dirs

View File

@ -3469,7 +3469,7 @@ form of assemblies or reads.")
(define-public metabat (define-public metabat
(package (package
(name "metabat") (name "metabat")
(version "2.11.1") (version "2.11.2")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -3478,7 +3478,7 @@ form of assemblies or reads.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0ll00l81aflscgggs5nfhj12cbvdiz3gg7f7n5f537a3xhx60vn9")) "0rws9r1ziv6way8cf49jg8bzj7x2131kfqkhj8byf0z5hnrq3bwv"))
(patches (search-patches "metabat-remove-compilation-date.patch" (patches (search-patches "metabat-remove-compilation-date.patch"
"metabat-fix-compilation.patch" "metabat-fix-compilation.patch"
"metabat-fix-boost-issue.patch")))) "metabat-fix-boost-issue.patch"))))
@ -3547,6 +3547,8 @@ sequences to deconvolute complex microbial communities, or metagenome binning,
enables the study of individual organisms and their interactions. MetaBAT is enables the study of individual organisms and their interactions. MetaBAT is
an automated metagenome binning software, which integrates empirical an automated metagenome binning software, which integrates empirical
probabilistic distances of genome abundance and tetranucleotide frequency.") probabilistic distances of genome abundance and tetranucleotide frequency.")
;; The source code contains inline assembly.
(supported-systems '("x86_64-linux" "i686-linux"))
(license (license:non-copyleft "file://license.txt" (license (license:non-copyleft "file://license.txt"
"See license.txt in the distribution.")))) "See license.txt in the distribution."))))

View File

@ -38,6 +38,7 @@
#:use-module (gnu packages gettext) #:use-module (gnu packages gettext)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages man) #:use-module (gnu packages man)
#:use-module (gnu packages mtools)
#:use-module (gnu packages ncurses) #:use-module (gnu packages ncurses)
#:use-module (gnu packages perl) #:use-module (gnu packages perl)
#:use-module (gnu packages python) #:use-module (gnu packages python)
@ -150,6 +151,7 @@ menu to select one of the installed operating systems.")
(synopsis "GRand Unified Boot loader (UEFI version)") (synopsis "GRand Unified Boot loader (UEFI version)")
(inputs (inputs
`(("efibootmgr" ,efibootmgr) `(("efibootmgr" ,efibootmgr)
("mtools", mtools)
,@(package-inputs grub))) ,@(package-inputs grub)))
(arguments (arguments
`(;; TODO: Tests need a UEFI firmware for qemu. There is one at `(;; TODO: Tests need a UEFI firmware for qemu. There is one at
@ -167,7 +169,19 @@ menu to select one of the installed operating systems.")
(("efibootmgr") (("efibootmgr")
(string-append (assoc-ref inputs "efibootmgr") (string-append (assoc-ref inputs "efibootmgr")
"/sbin/efibootmgr"))) "/sbin/efibootmgr")))
#t))))))))) #t))
(add-after 'patch-stuff 'use-absolute-mtools-path
(lambda* (#:key inputs #:allow-other-keys)
(let ((mtools (assoc-ref inputs "mtools")))
(substitute* "util/grub-mkrescue.c"
(("\"mformat\"")
(string-append "\"" mtools
"/bin/mformat\"")))
(substitute* "util/grub-mkrescue.c"
(("\"mcopy\"")
(string-append "\"" mtools
"/bin/mcopy\"")))
#t))))))))))
(define-public syslinux (define-public syslinux
(let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c")) (let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))

View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -155,13 +155,26 @@ taken from the NSS package and thus ultimately from the Mozilla project.")
(let ((root (assoc-ref %build-inputs "isrgrootx1.pem")) (let ((root (assoc-ref %build-inputs "isrgrootx1.pem"))
(intermediate (assoc-ref %build-inputs "letsencryptauthorityx3.pem")) (intermediate (assoc-ref %build-inputs "letsencryptauthorityx3.pem"))
(backup (assoc-ref %build-inputs "letsencryptauthorityx4.pem")) (backup (assoc-ref %build-inputs "letsencryptauthorityx4.pem"))
(out (string-append (assoc-ref %outputs "out") "/etc/ssl/certs"))) (out (string-append (assoc-ref %outputs "out") "/etc/ssl/certs"))
(openssl (assoc-ref %build-inputs "openssl"))
(perl (assoc-ref %build-inputs "perl")))
(mkdir-p out) (mkdir-p out)
(for-each (for-each
(lambda (cert) (lambda (cert)
(copy-file cert (string-append out "/" (copy-file cert (string-append out "/"
(strip-store-file-name cert)))) (strip-store-file-name cert))))
(list root intermediate backup)))))) (list root intermediate backup))
;; Create hash symlinks suitable for OpenSSL ('SSL_CERT_DIR' and
;; similar.)
(chdir (string-append %output "/etc/ssl/certs"))
(unless (zero? (system* (string-append perl "/bin/perl")
(string-append openssl "/bin/c_rehash")
"."))
(error "'c_rehash' failed" openssl))))))
(native-inputs
`(("openssl" ,openssl)
("perl" ,perl))) ;for 'c_rehash'
(inputs (inputs
`(; The Let's Encrypt root certificate, "ISRG Root X1". `(; The Let's Encrypt root certificate, "ISRG Root X1".
("isrgrootx1.pem" ("isrgrootx1.pem"

View File

@ -53,6 +53,7 @@
#:use-module (gnu packages gnupg) #:use-module (gnu packages gnupg)
#:use-module (gnu packages jemalloc) #:use-module (gnu packages jemalloc)
#:use-module (gnu packages language) #:use-module (gnu packages language)
#:use-module (gnu packages libevent)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages man) #:use-module (gnu packages man)
#:use-module (gnu packages ncurses) #:use-module (gnu packages ncurses)
@ -290,6 +291,28 @@ SQL, Key/Value, XML/XQuery or Java Object storage for their data model.")
mapping from string keys to string values.") mapping from string keys to string values.")
(license license:bsd-3))) (license license:bsd-3)))
(define-public memcached
(package
(name "memcached")
(version "1.5.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://memcached.org/files/memcached-" version ".tar.gz"))
(sha256
(base32 "0chwc0g7wfvcad36z8pf2jbgygdnm9nm1l6pwjsn3d2b089gh0f0"))))
(build-system gnu-build-system)
(inputs
`(("libevent" ,libevent)
("cyrus-sasl" ,cyrus-sasl)))
(home-page "https://memcached.org/")
(synopsis "In memory caching service")
(description "Memcached is a in memory key value store. It has a small
and generic API, and was originally intended for use with dynamic web
applications.")
(license license:bsd-3)))
(define-public mysql (define-public mysql
(package (package
(name "mysql") (name "mysql")
@ -1181,14 +1204,14 @@ similar to BerkeleyDB, LevelDB, etc.")
(define-public redis (define-public redis
(package (package
(name "redis") (name "redis")
(version "3.2.4") (version "4.0.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://download.redis.io/releases/redis-" (uri (string-append "http://download.redis.io/releases/redis-"
version".tar.gz")) version".tar.gz"))
(sha256 (sha256
(base32 (base32
"1wb9jd692a0y52bkkxr6815kk4g039mirjdrvqx24265lv2l5l1a")))) "14bm8lkhylc93r4dgl7kkzzpw2xq7gr6w6h80n3jazqnx5mcsj90"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:tests? #f ; tests related to master/slave and replication fail '(#:tests? #f ; tests related to master/slave and replication fail

View File

@ -130,7 +130,7 @@ tables, and it understands a variety of different formats.")
(define-public gptfdisk (define-public gptfdisk
(package (package
(name "gptfdisk") (name "gptfdisk")
(version "1.0.1") (version "1.0.3")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -138,7 +138,7 @@ tables, and it understands a variety of different formats.")
version "/" name "-" version ".tar.gz")) version "/" name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1izazbyv5n2d81qdym77i8mg9m870hiydmq4d0s51npx5vp8lk46")))) "0p0vr67lnqdsgdv2y144xmjqa1a2nijrrd3clc8dc2f46pn5mzc9"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("gettext" ,gettext-minimal) `(("gettext" ,gettext-minimal)
@ -168,9 +168,9 @@ tables, and it understands a variety of different formats.")
(home-page "http://www.rodsbooks.com/gdisk/") (home-page "http://www.rodsbooks.com/gdisk/")
(synopsis "Low-level GPT disk partitioning and formatting") (synopsis "Low-level GPT disk partitioning and formatting")
(description "GPT fdisk (aka gdisk) is a text-mode partitioning tool that (description "GPT fdisk (aka gdisk) is a text-mode partitioning tool that
works on Globally Unique Identifier (GUID) Partition Table (GPT) disks, rather works on Globally Unique Identifier (@dfn{GUID}) Partition Table (@dfn{GPT})
than on the more common (through 2009) Master Boot Record (MBR) partition disks, rather than on the older Master Boot Record (@dfn{MBR}) partition
tables.") scheme.")
(license license:gpl2))) (license license:gpl2)))
(define-public ddrescue (define-public ddrescue

View File

@ -99,7 +99,7 @@ and BOOTP/TFTP for network booting of diskless machines.")
(define-public isc-bind (define-public isc-bind
(package (package
(name "bind") (name "bind")
(version "9.11.1-P3") (version "9.11.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -107,7 +107,7 @@ and BOOTP/TFTP for network booting of diskless machines.")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1x6cfwkcv6nwc0mh5fzv70f38nl04yhgq90gr5nrjiif8dsnwhjj")))) "0yn7wgi2y8mpmvbjbkl4va7p0xsnn48m4yjx6ynb1hzp423asikz"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs `("out" "utils")) (outputs `("out" "utils"))
(inputs (inputs

View File

@ -641,30 +641,6 @@ process, passing on the arguments as command line arguments.")
programs.") programs.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public let-alist
(package
(name "emacs-let-alist")
(version "1.0.4")
(source (origin
(method url-fetch)
(uri (string-append "https://elpa.gnu.org/packages/let-alist-"
version ".el"))
(sha256
(base32
"07312bvvyz86lf64vdkxg2l1wgfjl25ljdjwlf1bdzj01c4hm88x"))))
(build-system emacs-build-system)
(home-page "https://elpa.gnu.org/packages/let-alist.html")
(synopsis "Easily let-bind values of an assoc-list by their names")
(description
"This package offers a single Emacs Lisp macro, @code{let-alist}. This
macro takes a first argument, whose value must be an alist (association list),
and a body.
The macro expands to a let form containing the body, where each dotted symbol
inside body is let-bound to their cdrs in the alist. Only those present in
the body are let-bound and this search is done at compile time.")
(license license:gpl3+)))
(define-public flycheck (define-public flycheck
(package (package
(name "emacs-flycheck") (name "emacs-flycheck")
@ -679,9 +655,7 @@ the body are let-bound and this search is done at compile time.")
"1rxzkaqsj48z3nska5wsgwafvwkam014dzqd32baycmxjl0jxvy7")))) "1rxzkaqsj48z3nska5wsgwafvwkam014dzqd32baycmxjl0jxvy7"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(propagated-inputs (propagated-inputs
`(("emacs-dash" ,emacs-dash) `(("emacs-dash" ,emacs-dash)))
("emacs-let-alist" ,let-alist)
("emacs-seq" ,emacs-seq)))
(home-page "https://www.flycheck.org") (home-page "https://www.flycheck.org")
(synopsis "On-the-fly syntax checking") (synopsis "On-the-fly syntax checking")
(description (description
@ -1113,7 +1087,7 @@ as a library for other Emacs packages.")
(define-public emacs-auctex (define-public emacs-auctex
(package (package
(name "emacs-auctex") (name "emacs-auctex")
(version "11.90.0") (version "11.91.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -1123,7 +1097,7 @@ as a library for other Emacs packages.")
".tar")) ".tar"))
(sha256 (sha256
(base32 (base32
"04nsndwcf0dimgc2p1yzzrymc36amzdnjg0158nxplmjkzdp28gy")))) "1yh182mxgngjmwpkyv2n9km3vyq95bqfq8mnly3dbv78nwk7f2l3"))))
(build-system emacs-build-system) (build-system emacs-build-system)
;; We use 'emacs' because AUCTeX requires dbus at compile time ;; We use 'emacs' because AUCTeX requires dbus at compile time
;; ('emacs-minimal' does not provide dbus). ;; ('emacs-minimal' does not provide dbus).
@ -1326,8 +1300,6 @@ single buffer.")
("automake" ,automake) ("automake" ,automake)
("pkg-config" ,pkg-config) ("pkg-config" ,pkg-config)
("emacs" ,emacs-minimal))) ("emacs" ,emacs-minimal)))
(propagated-inputs
`(("let-alist" ,let-alist)))
(inputs `(("poppler" ,poppler) (inputs `(("poppler" ,poppler)
("cairo" ,cairo) ("cairo" ,cairo)
("glib" ,glib) ("glib" ,glib)
@ -1579,8 +1551,7 @@ strings.")
"1w0xghfljqg31axcnv8gzlrd8pw25nji6idnrhflq0af9qh1dw03")))) "1w0xghfljqg31axcnv8gzlrd8pw25nji6idnrhflq0af9qh1dw03"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(propagated-inputs (propagated-inputs
`(("emacs-markdown-mode" ,emacs-markdown-mode) `(("emacs-markdown-mode" ,emacs-markdown-mode)))
("let-alist" ,let-alist)))
(home-page "https://github.com/vermiculus/sx.el/") (home-page "https://github.com/vermiculus/sx.el/")
(synopsis "Emacs StackExchange client") (synopsis "Emacs StackExchange client")
(description (description
@ -3035,26 +3006,6 @@ be removed from the front. This type of data structure is sometimes called an
ongoing operations.") ongoing operations.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-seq
(package
(name "emacs-seq")
(version "2.19")
(source (origin
(method url-fetch)
(uri (string-append "https://elpa.gnu.org/packages/seq-"
version ".tar"))
(sha256
(base32
"11hb7is6a4h1lscjcfrzh576j0g3m5yjydn16s6x5bxp5gsr6zha"))))
(build-system emacs-build-system)
(home-page "https://elpa.gnu.org/packages/seq.html")
(synopsis "Sequence manipulation functions for Emacs")
(description
"This Emacs library provides sequence-manipulation functions that
complement basic functions provided by @code{subr.el}. All provided functions
work on lists, strings and vectors.")
(license license:gpl3+)))
(define-public emacs-sparql-mode (define-public emacs-sparql-mode
(package (package
(name "emacs-sparql-mode") (name "emacs-sparql-mode")
@ -3134,7 +3085,9 @@ E-Prime forbids the use of the \"to be\" form to strengthen your writing.")
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f ; There is no test suite. `(#:tests? #f ; There is no test suite.
#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))) #:make-flags (list (string-append "PREFIX=" %output)
(string-append "LISPDIR=" %output
"/share/emacs/site-lisp/guix.d/ess"))
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(delete 'configure) (delete 'configure)
@ -3558,8 +3511,7 @@ for search-based navigation of buffers.")
`(("emacs-clojure-mode" ,emacs-clojure-mode) `(("emacs-clojure-mode" ,emacs-clojure-mode)
("emacs-spinner" ,emacs-spinner) ("emacs-spinner" ,emacs-spinner)
("emacs-pkg-info" ,emacs-pkg-info) ("emacs-pkg-info" ,emacs-pkg-info)
("emacs-queue" ,emacs-queue) ("emacs-queue" ,emacs-queue)))
("emacs-seq" ,emacs-seq)))
(home-page "https://cider.readthedocs.org/") (home-page "https://cider.readthedocs.org/")
(synopsis "Clojure development environment for Emacs") (synopsis "Clojure development environment for Emacs")
(description (description
@ -4160,7 +4112,7 @@ mode-line.")
(define-public emacs-yasnippet (define-public emacs-yasnippet
(package (package
(name "emacs-yasnippet") (name "emacs-yasnippet")
(version "0.11.0") (version "0.12.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/joaotavora/yasnippet/" (uri (string-append "https://github.com/joaotavora/yasnippet/"
@ -4168,7 +4120,18 @@ mode-line.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"15di6mkkf09b7qddpsrm0qln02hji3sx8blya5jxssi9wxxx9iq5")))) "1yqiprighgqz1hsslph50cy09xxqabc06jffrnjcsdf6nj70xlkc"))
(modules '((guix build utils)))
(snippet
'(begin
;; YASnippet expects a "snippets" subdirectory in the same
;; directory as yasnippet.el, but we don't install it
;; because it's a git submodule pointing to an external
;; repository. Adjust `yas-snippet-dirs' to prevent
;; warnings about a missing directory.
(substitute* "yasnippet.el"
(("^ +'yas-installed-snippets-dir\\)\\)\n")
"))\n"))))))
(build-system emacs-build-system) (build-system emacs-build-system)
(home-page "https://github.com/joaotavora/yasnippet") (home-page "https://github.com/joaotavora/yasnippet")
(synopsis "Yet another snippet extension for Emacs") (synopsis "Yet another snippet extension for Emacs")
@ -4177,6 +4140,51 @@ mode-line.")
abbreviation and automatically expand it into function templates.") abbreviation and automatically expand it into function templates.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-yasnippet-snippets
(let ((commit "885050d34737e2fb36a3e7759d60c09347bd4ce0")
(revision "1"))
(package
(name "emacs-yasnippet-snippets")
(version (string-append "1-" revision "." (string-take commit 8)))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/AndreaCrotti/yasnippet-snippets")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"1m935zgglw0iakzrixld5rcjz3wnj84f8wy2mvc3pggjri9l0qr9"))))
(build-system trivial-build-system)
(arguments
`(#:modules ((ice-9 ftw)
(ice-9 regex)
(guix build utils))
#:builder
(begin
(use-modules (ice-9 ftw)
(ice-9 regex)
(guix build utils))
(with-directory-excursion (assoc-ref %build-inputs "source")
(for-each (lambda (dir)
(copy-recursively
dir
(string-append %output
"/share/emacs/yasnippet-snippets/"
dir)))
(scandir "." (lambda (fname)
(and (string-match "-mode$" fname)
(directory-exists? fname)))))))))
(home-page "https://github.com/AndreaCrotti/yasnippet-snippets")
(synopsis "Collection of YASnippet snippets for many languages")
(description
"Provides Andrea Crotti's collection of YASnippet snippets. After installation,
the snippets will be in \"~/.guix-profile/share/emacs/yasnippet-snippets/\".
To make YASnippet aware of these snippets, add the above directory to
@code{yas-snippet-dirs}.")
(license license:expat))))
(define-public emacs-memoize (define-public emacs-memoize
(package (package
(name "emacs-memoize") (name "emacs-memoize")
@ -5200,3 +5208,26 @@ src block.")
"@code{emacs-emamux} lets Emacs interact with the @code{tmux} terminal "@code{emacs-emamux} lets Emacs interact with the @code{tmux} terminal
multiplexer.") multiplexer.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-rpm-spec-mode
(package
(name "emacs-rpm-spec-mode")
(version "0.16")
(source
(origin
(method url-fetch)
;; URI has the Fedora release number instead of the version
;; number. This will have to updated manually every new release.
(uri (string-append
"https://src.fedoraproject.org/cgit/rpms"
"/emacs-rpm-spec-mode.git/snapshot"
"/emacs-rpm-spec-mode-f26.tar.gz"))
(sha256
(base32
"17dz80lhjrc89fj17pysl8slahzrqdkxgcjdk55zls6jizkr6kz3"))))
(build-system emacs-build-system)
(home-page "http://pkgs.fedoraproject.org/cgit/rpms/emacs-rpm-spec-mode.git")
(synopsis "Emacs major mode for editing RPM spec files")
(description "@code{emacs-rpm-spec-mode} provides an Emacs major mode for
editing RPM spec files.")
(license license:gpl2+)))

View File

@ -53,6 +53,7 @@
#:use-module (gnu packages python) #:use-module (gnu packages python)
#:use-module (gnu packages tls) #:use-module (gnu packages tls)
#:use-module (gnu packages video) #:use-module (gnu packages video)
#:use-module (gnu packages xdisorg)
#:use-module (gnu packages xorg)) #:use-module (gnu packages xorg))
(define-public efl (define-public efl
@ -101,11 +102,11 @@
("libxscrnsaver" ,libxscrnsaver) ("libxscrnsaver" ,libxscrnsaver)
("libxtst" ,libxtst) ("libxtst" ,libxtst)
("lz4" ,lz4) ("lz4" ,lz4)
("mesa" ,mesa)
("openjpeg" ,openjpeg-1) ("openjpeg" ,openjpeg-1)
("poppler" ,poppler) ("poppler" ,poppler)
("printproto" ,printproto) ("printproto" ,printproto)
("scrnsaverproto" ,scrnsaverproto) ("scrnsaverproto" ,scrnsaverproto)
("wayland-protocols" ,wayland-protocols)
("xextproto" ,xextproto) ("xextproto" ,xextproto)
("xinput" ,xinput) ("xinput" ,xinput)
("xpr" ,xpr) ("xpr" ,xpr)
@ -122,11 +123,15 @@
("glib" ,glib) ; ecore.pc, ecore-cxx.pc ("glib" ,glib) ; ecore.pc, ecore-cxx.pc
("harfbuzz" ,harfbuzz) ; evas.pc, evas-cxx.pc ("harfbuzz" ,harfbuzz) ; evas.pc, evas-cxx.pc
("luajit" ,luajit) ; elua.pc, evas.pc, evas-cxx.pc ("luajit" ,luajit) ; elua.pc, evas.pc, evas-cxx.pc
("libinput" ,libinput) ; elput.pc
("libpng" ,libpng) ; evas.pc, evas-cxx.pc ("libpng" ,libpng) ; evas.pc, evas-cxx.pc
("libsndfile" ,libsndfile) ; ecore-audio.pc, ecore-audio-cxx.pc ("libsndfile" ,libsndfile) ; ecore-audio.pc, ecore-audio-cxx.pc
("libxkbcommon" ,libxkbcommon) ; ecore-wl2.pc, elementary.pc, elput.pc
("mesa" ,mesa) ; ecore-drm2.pc
("openssl" ,openssl) ; ecore-con.pc, eet.pc, eet-cxx.pc, emile.pc ("openssl" ,openssl) ; ecore-con.pc, eet.pc, eet-cxx.pc, emile.pc
("pulseaudio" ,pulseaudio) ; ecore-audio.pc, ecore-audio-cxx.pc ("pulseaudio" ,pulseaudio) ; ecore-audio.pc, ecore-audio-cxx.pc
("util-linux" ,util-linux) ; mount: eeze.pc ("util-linux" ,util-linux) ; mount: eeze.pc
("wayland" ,wayland) ; ecore-wl2.pc, elementary.pc
("zlib" ,zlib))) ; eet.pc, eet-cxx.pc, emile.pc ("zlib" ,zlib))) ; eet.pc, eet-cxx.pc, emile.pc
(arguments (arguments
`(#:configure-flags '("--disable-silent-rules" `(#:configure-flags '("--disable-silent-rules"
@ -137,7 +142,11 @@
"--enable-multisense" "--enable-multisense"
"--with-opengl=es" "--with-opengl=es"
"--enable-egl" "--enable-egl"
"--enable-harfbuzz") "--enable-harfbuzz"
;; for wayland
"--enable-wayland"
"--enable-elput"
"--enable-drm")
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'unpack 'set-home-directory (add-after 'unpack 'set-home-directory

View File

@ -23,6 +23,7 @@
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (gnu packages)
#:use-module (gnu packages autotools) #:use-module (gnu packages autotools)
#:use-module (gnu packages fontutils) #:use-module (gnu packages fontutils)
#:use-module (gnu packages gl) #:use-module (gnu packages gl)
@ -34,7 +35,7 @@
(define-public erlang (define-public erlang
(package (package
(name "erlang") (name "erlang")
(version "19.3") (version "20.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
;; The tarball from http://erlang.org/download contains many ;; The tarball from http://erlang.org/download contains many
@ -45,7 +46,8 @@
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1b47jh549yywyp8fbs8a8j4ydr3zn982navzyqvlms6rg8vwb0pw")))) "1azjjyb743i6vjq7rnh5qnslsqg0x60a9zrlhg9n3dpm13z1b22l"))
(patches (search-patches "erlang-man-path.patch"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("perl" ,perl) `(("perl" ,perl)
@ -60,7 +62,7 @@
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0p6r3n3y7lbhv38sw8f2vi1xlmc137gyspk9ap086w1nszyjy6gq")))))) "1k25p37w1l1j20qd8rga4j4q7s7r0rbsi02x3xwzhw51jhm59wdp"))))))
(inputs (inputs
`(("ncurses" ,ncurses) `(("ncurses" ,ncurses)
("openssl" ,openssl) ("openssl" ,openssl)
@ -109,8 +111,7 @@
(("date\\(\\), time\\(\\),") (("date\\(\\), time\\(\\),")
(date->string source-date-epoch (date->string source-date-epoch
"{~Y,~m,~d}, {~H,~M,~S},"))) "{~Y,~m,~d}, {~H,~M,~S},")))
(substitute* '("lib/dialyzer/test/small_SUITE_data/src/gs_make.erl" (substitute* "lib/dialyzer/test/small_SUITE_data/src/gs_make.erl"
"lib/gs/src/gs_make.erl")
(("tuple_to_list\\(date\\(\\)\\),tuple_to_list\\(time\\(\\)\\)") (("tuple_to_list\\(date\\(\\)\\),tuple_to_list\\(time\\(\\)\\)")
(date->string (date->string
source-date-epoch source-date-epoch

View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org> ;;; Copyright © 2016 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2016 Theodoros Foradis <theodoros.for@openmailbox.org> ;;; Copyright © 2016, 2017 Theodoros Foradis <theodoros.for@openmailbox.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -36,6 +36,7 @@
#:use-module (gnu packages graphviz) #:use-module (gnu packages graphviz)
#:use-module (gnu packages libffi) #:use-module (gnu packages libffi)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages maths)
#:use-module (gnu packages perl) #:use-module (gnu packages perl)
#:use-module (gnu packages ghostscript) #:use-module (gnu packages ghostscript)
#:use-module (gnu packages gperf) #:use-module (gnu packages gperf)
@ -198,6 +199,8 @@ For synthesis, the compiler generates netlists in the desired format.")
("psmisc" ,psmisc) ("psmisc" ,psmisc)
("xdot" ,xdot) ("xdot" ,xdot)
("abc" ,abc))) ("abc" ,abc)))
(propagated-inputs
`(("z3" ,z3))) ; should be in path for yosys-smtbmc
(home-page "http://www.clifford.at/yosys/") (home-page "http://www.clifford.at/yosys/")
(synopsis "FPGA Verilog RTL synthesizer") (synopsis "FPGA Verilog RTL synthesizer")
(description "Yosys synthesizes Verilog-2005.") (description "Yosys synthesizes Verilog-2005.")

View File

@ -1301,15 +1301,15 @@ either by Infocom or created using the Inform compiler.")
(define-public retroarch (define-public retroarch
(package (package
(name "retroarch") (name "retroarch")
(version "1.6.1") (version "1.6.3")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/libretro/RetroArch/archive/v" (uri (string-append "https://github.com/libretro/RetroArch/archive/"
version ".tar.gz")) version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 "121h9j57gvjr155vvm4f7ybphfvqrdz2ib059kfi444xcxz19sl0")))) (base32 "0a0w2sjizjs20376h7j1gfi0qccr8mhkl1cm6hi0c17hy1493l6d"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:tests? #f ; no tests '(#:tests? #f ; no tests
@ -3532,7 +3532,7 @@ throwing people around in pseudo-randomly generated buildings.")
(define-public hyperrogue (define-public hyperrogue
(package (package
(name "hyperrogue") (name "hyperrogue")
(version "9.4n") (version "10.0e")
;; When updating this package, be sure to update the "hyperrogue-data" ;; When updating this package, be sure to update the "hyperrogue-data"
;; origin in native-inputs. ;; origin in native-inputs.
(source (origin (source (origin
@ -3543,7 +3543,7 @@ throwing people around in pseudo-randomly generated buildings.")
"-src.tgz")) "-src.tgz"))
(sha256 (sha256
(base32 (base32
"1kf9i9gqadnb0m143c860dcvdn91vp6vnfzma4bcgfgwmcn9sx0r")))) "1p6fam73khhys54098qsgmp52d0rnqc3k5hknjig0znvfb2kwi38"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f ; no check target `(#:tests? #f ; no check target
@ -3565,7 +3565,7 @@ throwing people around in pseudo-randomly generated buildings.")
"/share/fonts/truetype")) "/share/fonts/truetype"))
(dejavu-font "DejaVuSans-Bold.ttf") (dejavu-font "DejaVuSans-Bold.ttf")
(music-file "hyperrogue-music.txt")) (music-file "hyperrogue-music.txt"))
(substitute* "graph.cpp" (substitute* "basegraph.cpp"
((dejavu-font) ((dejavu-font)
(string-append dejavu-dir "/" dejavu-font))) (string-append dejavu-dir "/" dejavu-font)))
(substitute* "sound.cpp" (substitute* "sound.cpp"
@ -3618,7 +3618,7 @@ throwing people around in pseudo-randomly generated buildings.")
"-win.zip")) "-win.zip"))
(sha256 (sha256
(base32 (base32
"1vrk0k0ch3azpa72y7acmmpifvks6c0466fvmz804hici93pglvi")))) "1z9w3nd57ybnf4w7ckhhp5vfws2hwd8x26fx6h496f6160fgcj6m"))))
("unzip" ,unzip))) ("unzip" ,unzip)))
(inputs (inputs
`(("font-dejavu" ,font-dejavu) `(("font-dejavu" ,font-dejavu)
@ -4617,3 +4617,121 @@ computer-hosted roleplaying games. This is the last version released by
Crowther & Woods, its original authors, in 1995. It has been known as Crowther & Woods, its original authors, in 1995. It has been known as
\"adventure 2.5\" and \"430-point adventure\".") \"adventure 2.5\" and \"430-point adventure\".")
(license license:bsd-2)))) (license license:bsd-2))))
(define-public tome4
(package
(name "tome4")
(version "1.5.5")
(synopsis "Single-player, RPG roguelike game set in the world of Eyal")
(source
(origin
(method url-fetch)
(uri (string-append "https://te4.org/dl/t-engine/t-engine4-src-"
version ".tar.bz2"))
(sha256
(base32
"0v2qgdfpvdzd1bcbp9v8pfahj1bgczsq2d4xfhh5wg11jgjcwz03"))
(modules '((guix build utils)))
(snippet
'(substitute* '("src/music.h" "src/tSDL.h")
(("#elif defined(__FreeBSD__)" line)
(string-append
line " || defined(__GNUC__)"))))))
(build-system gnu-build-system)
(native-inputs
`(("unzip" ,unzip)))
(inputs
`(("sdl-union" ,(sdl-union (list sdl2 sdl2-image sdl2-mixer sdl2-ttf)))
("glu" ,glu)
("premake4" ,premake4)
("openal" ,openal)
("vorbis" ,libvorbis)
("luajit" ,luajit)))
(arguments
`(#:make-flags '("CC=gcc" "config=release")
#:phases (modify-phases %standard-phases
(replace 'configure
(lambda _
(zero? (system* "premake4" "gmake"))
#t))
(add-after 'set-paths 'set-sdl-paths
(lambda* (#:key inputs #:allow-other-keys)
(setenv "CPATH"
(string-append (assoc-ref inputs "sdl-union")
"/include/SDL2"))
#t))
(delete 'check)
;; premake doesn't provide install target
(replace 'install
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(usr (string-append out "/usr"))
(bin (string-append out "/bin"))
(licenses (string-append out "/share/licenses"))
(documents (string-append out "/share/doc"))
(pixmaps (string-append out "/share/pixmaps"))
(icon "te4-icon.png")
(data (string-append out "/share/" ,name))
(applications (string-append
out "/share/applications"))
(unzip (string-append
(assoc-ref inputs "unzip") "/bin/unzip"))
(wrapper (string-append bin "/" ,name)))
;; icon
(mkdir-p pixmaps)
(system* unzip "-j"
(string-append
"game/engines/te4-" ,version ".teae")
(string-append
"data/gfx/" icon) "-d" pixmaps)
;; game executable
(install-file "t-engine" data)
(mkdir-p bin)
(with-output-to-file wrapper
(lambda ()
(display
(string-append
"#!/bin/sh\n"
;; No bootstrap code found,
;; defaulting to working directory
;; for engine code!
"cd " data "\n"
"exec -a tome4 ./t-engine \"$@\"\n"))))
(chmod wrapper #o555)
;; licenses
(for-each (lambda (file)
(install-file file licenses))
'("COPYING" "COPYING-MEDIA"))
;; documents
(for-each (lambda (file)
(install-file file documents))
'("CONTRIBUTING" "CREDITS"))
;; data
(copy-recursively "bootstrap" (string-append
data "/bootstrap"))
(copy-recursively "game" (string-append data "/game"))
;; launcher
(mkdir-p applications)
(with-output-to-file (string-append applications "/"
,name ".desktop")
(lambda ()
(display
(string-append
"[Desktop Entry]
Name=ToME4
Comment=" ,synopsis "\n"
"Exec=" ,name "\n"
"Icon=" icon "\n"
"Terminal=false
Type=Application
Categories=Game;RolePlaying;\n")))))
#t)))))
(home-page "https://te4.org")
(description "Tales of MajEyal (ToME) RPG, featuring tactical turn-based
combat and advanced character building. Play as one of many unique races and
classes in the lore-filled world of Eyal, exploring random dungeons, facing
challenging battles, and developing characters with your own tailored mix of
abilities and powers. With a modern graphical and customisable interface,
intuitive mouse control, streamlined mechanics and deep, challenging combat,
Tales of MajEyal offers engaging roguelike gameplay for the 21st century.")
(license license:gpl3+)))

View File

@ -109,6 +109,7 @@
#:use-module (gnu packages rdesktop) #:use-module (gnu packages rdesktop)
#:use-module (gnu packages scanner) #:use-module (gnu packages scanner)
#:use-module (gnu packages selinux) #:use-module (gnu packages selinux)
#:use-module (gnu packages slang)
#:use-module (gnu packages ssh) #:use-module (gnu packages ssh)
#:use-module (gnu packages xml) #:use-module (gnu packages xml)
#:use-module (gnu packages gl) #:use-module (gnu packages gl)
@ -1766,14 +1767,14 @@ Hints specification (EWMH).")
(define-public goffice (define-public goffice
(package (package
(name "goffice") (name "goffice")
(version "0.10.34") (version "0.10.35")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/" (uri (string-append "mirror://gnome/sources/" name "/"
(version-major+minor version) "/" (version-major+minor version) "/"
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 "00yn5ly1x50ynrwgl783pwnjy4k2ckp8n54mfnqv6qsq5fi7ajjm")))) (base32 "0f2p3p7idfpbms4mi75031014mqsv09s21b6w1359p09raph3461"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" (outputs '("out"
"doc")) ;4.1 MiB of gtk-doc "doc")) ;4.1 MiB of gtk-doc
@ -4349,7 +4350,7 @@ metadata in photo and video files of various formats.")
(define-public shotwell (define-public shotwell
(package (package
(name "shotwell") (name "shotwell")
(version "0.26.1") (version "0.26.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/" (uri (string-append "mirror://gnome/sources/" name "/"
@ -4357,7 +4358,7 @@ metadata in photo and video files of various formats.")
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0xak1f69lp1yx3p8jgmr9c0z3jypi8zjpy3kiknn5n9g2f5cqq0a")))) "0frjqa6nmh025clwnb74z2rzbdq65wjcp2lf9csgcbkpahyjhrag"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(propagated-inputs (propagated-inputs
`(("dconf" ,dconf))) `(("dconf" ,dconf)))
@ -5026,6 +5027,7 @@ users.")
("libnl" ,libnl) ("libnl" ,libnl)
("libsoup" ,libsoup) ("libsoup" ,libsoup)
("modem-manager" ,modem-manager) ("modem-manager" ,modem-manager)
("newt" ,newt) ;for the 'nmtui' console interface
("polkit" ,polkit) ("polkit" ,polkit)
("ppp" ,ppp) ("ppp" ,ppp)
("readline" ,readline) ("readline" ,readline)
@ -5549,7 +5551,7 @@ shared object databases, search tools and indexing.")
(define-public nautilus (define-public nautilus
(package (package
(name "nautilus") (name "nautilus")
(version "3.24.1") (version "3.24.2.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/" (uri (string-append "mirror://gnome/sources/" name "/"
@ -5557,7 +5559,7 @@ shared object databases, search tools and indexing.")
name "-" version ".tar.xz")) name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1cn6bmzmahzlwcd4gllsvx6dva386xm3papgzpv1r34abw73sf27")))) "1cv138z04qx0fh1a2z2hvxy4p1x15vdv5gmkx5f3hb6c3w2rsz9m"))))
(build-system glib-or-gtk-build-system) (build-system glib-or-gtk-build-system)
(arguments (arguments
'(#:configure-flags '(#:configure-flags

View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in> ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;; 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>
@ -144,14 +144,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.52") (version "0.9.55")
(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
"1smgxw6jv81yybg86bzr4c2sn7a31apf8q4zz0kpch9xfrp7yyal")))) "1y6h1slav5l6k8zyb01dpw65dscdgxxgfa3a0z9qnn7jr66sn70c"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("curl" ,curl) `(("curl" ,curl)
@ -160,7 +160,17 @@ tool to extract metadata from a file and print the results.")
("openssl" ,openssl) ("openssl" ,openssl)
("zlib" ,zlib))) ("zlib" ,zlib)))
(arguments (arguments
`(#:parallel-tests? #f)) `(#:parallel-tests? #f
#:phases (modify-phases %standard-phases
(add-before 'check 'add-missing-LDFLAGS
(lambda _
;; The two test_upgrade* programs depend on GnuTLS
;; directly but lack -lgnutls; add it.
(substitute* "src/microhttpd/Makefile"
(("^test_upgrade(.*)LDFLAGS = (.*)$" _ first rest)
(string-append "test_upgrade" first
"LDFLAGS = -lgnutls " rest)))
#t)))))
(synopsis "C library implementing an HTTP 1.1 server") (synopsis "C library implementing an HTTP 1.1 server")
(description (description
"GNU libmicrohttpd is a small, embeddable HTTP server implemented as a "GNU libmicrohttpd is a small, embeddable HTTP server implemented as a

View File

@ -203,14 +203,14 @@ compatible to GNU Pth.")
(define-public gnupg (define-public gnupg
(package (package
(name "gnupg") (name "gnupg")
(version "2.1.21") (version "2.1.22")
(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
"1p97limv29p01y79mgnzpwixa50lv53wgdl3ymk9idkmpaldisks")))) "1msazgy1q1pp7y2xr46z0il4pfzmzgzkp7v0hv5cz4hvkspnywa6"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("pkg-config" ,pkg-config)))

View File

@ -3,7 +3,7 @@
;;; Copyright © 2014 John Darrington <jmd@gnu.org> ;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;; Copyright © 2015, 2016 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2015, 2016 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -244,15 +244,9 @@ for the GStreamer multimedia library.")
'unpack 'disable-failing-tests 'unpack 'disable-failing-tests
(lambda _ (lambda _
;; Disable tests that fail non-deterministically. ;; Disable tests that fail non-deterministically.
;; XXX FIXME: Try removing this for version > 1.8.0. ;; This test fails on aarch64 on 1.12.x.
(substitute* "tests/check/elements/rtprtx.c" (substitute* "tests/check/elements/alpha.c"
(("tcase_add_test \\(tc_chain, test_push_forward_seq\\);" all) (("tcase_add_test \\(tc_chain, test_chromakeying\\);" all)
(string-append "/* " all " */"))
(("tcase_add_test \
\\(tc_chain, test_rtxreceive_data_reconstruction\\);" all)
(string-append "/* " all " */")))
(substitute* "tests/check/elements/splitmux.c"
(("tcase_add_test \\(tc_chain, test_splitmuxsink\\);" all)
(string-append "/* " all " */"))) (string-append "/* " all " */")))
#t))))) #t)))))
(home-page "https://gstreamer.freedesktop.org/") (home-page "https://gstreamer.freedesktop.org/")

View File

@ -7,7 +7,7 @@
;;; Copyright © 2016 Erik Edrosa <erik.edrosa@gmail.com> ;;; Copyright © 2016 Erik Edrosa <erik.edrosa@gmail.com>
;;; Copyright © 2016 Eraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Eraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org> ;;; Copyright © 2016, 2017 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org>
;;; Copyright © 2016 Amirouche <amirouche@hypermove.net> ;;; Copyright © 2016 Amirouche <amirouche@hypermove.net>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017 Andy Wingo <wingo@igalia.com> ;;; Copyright © 2017 Andy Wingo <wingo@igalia.com>
@ -395,19 +395,45 @@ program can be installed in one go.")
;;; ;;;
(define-public artanis (define-public artanis
(let ((release "0.2.1")
(revision 3))
(package (package
(name "artanis") (name "artanis")
(version "0.2.1") (version (if (zero? revision)
release
(string-append release "-"
(number->string revision))))
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/artanis/artanis-" (uri (string-append "mirror://gnu/artanis/artanis-"
version ".tar.gz")) release ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"041ajcg2pz918kd9iqcj4inpzddc3impvz3r2nhlpbv8zrz011hn")))) "041ajcg2pz918kd9iqcj4inpzddc3impvz3r2nhlpbv8zrz011hn"))
(modules '((guix build utils)))
(snippet
'(begin
(delete-file-recursively "artanis/third-party/json.scm")
(delete-file-recursively "artanis/third-party/json")
(substitute* '("artanis/artanis.scm"
"artanis/oht.scm")
(("(#:use-module \\()artanis third-party (json\\))" _
use-module json)
(string-append use-module json)))
(substitute* "artanis/oht.scm"
(("([[:punct:][:space:]]+)(->json-string)([[:punct:][:space:]]+)"
_ pre json-string post)
(string-append pre
"scm" json-string
post)))
(substitute* "artanis/artanis.scm"
(("[[:punct:][:space:]]+->json-string[[:punct:][:space:]]+")
""))))))
(build-system gnu-build-system) (build-system gnu-build-system)
;; TODO: Add guile-dbi and guile-dbd optional dependencies. ;; TODO: Add guile-dbi and guile-dbd optional dependencies.
(inputs `(("guile" ,guile-2.2))) (inputs `(("guile" ,guile-2.2)
("guile-json" ,guile-json)))
(native-inputs `(("bash" ,bash) ;for the `source' builtin (native-inputs `(("bash" ,bash) ;for the `source' builtin
("pkgconfig" ,pkg-config) ("pkgconfig" ,pkg-config)
("util-linux" ,util-linux))) ;for the `script' command ("util-linux" ,util-linux))) ;for the `script' command
@ -452,7 +478,7 @@ provides several tools for web development: database access, templating
frameworks, session management, URL-remapping for RESTful, page caching, and frameworks, session management, URL-remapping for RESTful, page caching, and
more.") more.")
(home-page "https://www.gnu.org/software/artanis/") (home-page "https://www.gnu.org/software/artanis/")
(license (list license:gpl3+ license:lgpl3+)))) ;dual license (license (list license:gpl3+ license:lgpl3+))))) ;dual license
(define-public guile-reader (define-public guile-reader
(package (package
@ -1584,6 +1610,8 @@ is no support for parsing block and inline level HTML.")
"-c" "(display (effective-version))"))) "-c" "(display (effective-version))")))
(module-dir (string-append out "/share/guile/site/" (module-dir (string-append out "/share/guile/site/"
effective)) effective))
(object-dir (string-append out "/lib/guile/" effective
"/site-ccache"))
(source (getcwd)) (source (getcwd))
(doc (string-append out "/share/doc/scheme-bytestructures")) (doc (string-append out "/share/doc/scheme-bytestructures"))
(sld-files (with-directory-excursion source (sld-files (with-directory-excursion source
@ -1603,7 +1631,7 @@ is no support for parsing block and inline level HTML.")
(for-each (lambda (file) (for-each (lambda (file)
(let* ((dest-file (string-append module-dir "/" (let* ((dest-file (string-append module-dir "/"
file)) file))
(go-file (string-append module-dir "/" (go-file (string-append object-dir "/"
(substring file 0 (substring file 0
(string-rindex file #\.)) (string-rindex file #\.))
".go"))) ".go")))
@ -1822,8 +1850,8 @@ is not available for Guile 2.0.")
(license license:lgpl3+))) (license license:lgpl3+)))
(define-public guile-git (define-public guile-git
(let ((revision "2") (let ((revision "3")
(commit "06f9fc3d9ac95798d4a51e6310f7b594ce5597e0")) (commit "e156a1054cc1d9e58d9be82e36e8acf5c9f9ee8d"))
(package (package
(name "guile-git") (name "guile-git")
(version (string-append "0.0-" revision "." (string-take commit 7))) (version (string-append "0.0-" revision "." (string-take commit 7)))
@ -1833,17 +1861,30 @@ is not available for Guile 2.0.")
(uri (git-reference (url home-page) (commit commit))) (uri (git-reference (url home-page) (commit commit)))
(sha256 (sha256
(base32 (base32
"0rcq0f8dhl89ia7336bq8y279q5ada0b1kabcqw9zl3125k3cp4v")) "1vhr2bqkljy1zzdy02dky2nk1w9bd46afj5wd4gp4kr333pz4ch6"))
(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
'(#:phases (modify-phases %standard-phases `(#:phases (modify-phases %standard-phases
(add-after 'unpack 'bootstrap (add-after 'unpack 'bootstrap
(lambda _ (lambda _
(zero? (system* "autoreconf" "-vfi"))))))) (zero? (system* "autoreconf" "-vfi"))))
;; FIXME: On i686, bytestructures miscalculates the offset
;; of the 'old-file' and 'new-file' fields within the
;; '%diff-delta' structure.
,@(if (string=? (%current-system) "x86_64-linux")
'()
'((add-before 'check 'skip-tests
(lambda _
(substitute* "Makefile"
(("tests/status\\.scm")
""))
#t)))))))
(native-inputs (native-inputs
`(("autoconf" ,autoconf) `(("autoconf" ,autoconf)
("automake" ,automake) ("automake" ,automake)
("texinfo" ,texinfo)
("pkg-config" ,pkg-config))) ("pkg-config" ,pkg-config)))
(inputs (inputs
`(("guile" ,guile-2.2) `(("guile" ,guile-2.2)

View File

@ -366,8 +366,8 @@ It has been modified to remove all non-free binary blobs.")
(define %intel-compatible-systems '("x86_64-linux" "i686-linux")) (define %intel-compatible-systems '("x86_64-linux" "i686-linux"))
(define %linux-libre-version "4.12.3") (define %linux-libre-version "4.12.4")
(define %linux-libre-hash "1b02snh41fgr5i55wlc86nvksyzy1cq994mkmj195pa57hy6y6ak") (define %linux-libre-hash "13c6ka4fhzi41bjlssbkz84hkag7knqpvfyp2jjhm3wm25r4lhw8")
(define-public linux-libre (define-public linux-libre
(make-linux-libre %linux-libre-version (make-linux-libre %linux-libre-version
@ -376,14 +376,14 @@ It has been modified to remove all non-free binary blobs.")
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define-public linux-libre-4.9 (define-public linux-libre-4.9
(make-linux-libre "4.9.39" (make-linux-libre "4.9.40"
"03rnbz1wf3d0fi5zrhygx1b20bx23fy310d8h74zc6z4jh6fsbx3" "1qaqi2dcydyxw79yj9pa7yxf13ss4rng7bgg0i1dl63c3g7qjgcz"
%intel-compatible-systems %intel-compatible-systems
#: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.78" (make-linux-libre "4.4.79"
"0g8pc0kam33rn2dx9fkp7w749s38qs2iykawpj0k9jm19775hn4k" "03x1nc2fxmh29sf2fbsqzmw8qrdzv5gakr9xrg1shxh31c6xr3xr"
%intel-compatible-systems %intel-compatible-systems
#:configuration-file kernel-config)) #:configuration-file kernel-config))
@ -3091,7 +3091,7 @@ and copy/paste text in the console and in xterm.")
(define-public btrfs-progs (define-public btrfs-progs
(package (package
(name "btrfs-progs") (name "btrfs-progs")
(version "4.11.1") (version "4.12")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://kernel.org/linux/kernel/" (uri (string-append "mirror://kernel.org/linux/kernel/"
@ -3099,10 +3099,10 @@ and copy/paste text in the console and in xterm.")
"btrfs-progs-v" version ".tar.xz")) "btrfs-progs-v" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0vcp9a0a35chhjhq291kvirqhd4i9w5f4zql4y5n81kbwcrxil6h")))) "1kif8xw2dbyc70ygkp0wyq4x96p1mkwdv4430f99qllx9b410xwi"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" (outputs '("out"
"static")) ; static versions of binaries in "out" (~16MiB!) "static")) ; static versions of the binaries in "out"
(arguments (arguments
'(#:phases (modify-phases %standard-phases '(#:phases (modify-phases %standard-phases
(add-after 'build 'build-static (add-after 'build 'build-static

View File

@ -18,6 +18,7 @@
;;; Copyright © 2017 Paul Garlick <pgarlick@tourbillion-technology.com> ;;; Copyright © 2017 Paul Garlick <pgarlick@tourbillion-technology.com>
;;; Copyright © 2017 ng0 <contact.ng0@cryptolab.net> ;;; Copyright © 2017 ng0 <contact.ng0@cryptolab.net>
;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2017 Theodoros Foradis <theodoros.for@openmailbox.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -3161,3 +3162,37 @@ as equations, scalars, vectors, and matrices.")
(home-page "https://www.gnu.org/software/jacal/") (home-page "https://www.gnu.org/software/jacal/")
(license license:gpl3+))) (license license:gpl3+)))
(define-public z3
(package
(name "z3")
(version "4.5.0")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/Z3Prover/z3/archive/z3-"
version ".tar.gz"))
(sha256
(base32
"032a5lvji2liwmc25jv52bdrhimqflvqbpg77ccaq1jykhiivbmf"))))
(build-system gnu-build-system)
(arguments
`(#:test-target "test"
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(zero?
(system* "python" "scripts/mk_make.py"
(string-append "--prefix="
(assoc-ref outputs "out"))))))
(add-after 'configure 'change-dir
(lambda _
(chdir "build")
#t)))))
(native-inputs
`(("python" ,python-2)))
(synopsis "Theorem prover")
(description "Z3 is a theorem prover and @dfn{satisfiability modulo
theories} (SMT) solver. It provides a C/C++ API.")
(home-page "https://github.com/Z3Prover/z3")
(license license:expat)))

View File

@ -57,7 +57,7 @@ extensive examples, including parsers for the Javascript and C99 languages.")
(let ((triplet "i686-unknown-linux-gnu")) (let ((triplet "i686-unknown-linux-gnu"))
(package (package
(name "mes") (name "mes")
(version "0.8") (version "0.9")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://gitlab.com/janneke/mes" (uri (string-append "https://gitlab.com/janneke/mes"
@ -66,7 +66,7 @@ extensive examples, including parsers for the Javascript and C99 languages.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1igmrks20ci6l5c0jx2bn4swf0w8jy5inhg61cwld9d7hwanmdnj")))) "0ph0fvabpb7zhbk4zpacbp7m4b142ds17dq5dzn00m7dz8farw9r"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(supported-systems '("i686-linux" "x86_64-linux")) (supported-systems '("i686-linux" "x86_64-linux"))
(propagated-inputs (propagated-inputs
@ -91,29 +91,31 @@ extensive examples, including parsers for the Javascript and C99 languages.")
(lambda () (lambda ()
(display "Please run (display "Please run
build-aux/gitlog-to-changelog --srcdir=<git-checkout> > ChangeLog\n"))) build-aux/gitlog-to-changelog --srcdir=<git-checkout> > ChangeLog\n")))
#t))))) #t))
(synopsis "Maxwell Equations of Software") (delete 'strip)))) ; binutil's strip b0rkes Mescc/M1/hex2 binaries
(synopsis "Scheme interpreter and C compiler for full source bootstrapping")
(description (description
"Mes aims to create full source bootstrapping for GuixSD. It "Mes [Maxwell Equations of Software] aims to create full source
consists of a mutual self-hosting [close to Guile-] Scheme interpreter bootstrapping for GuixSD. It consists of a mutual self-hosting [close to
prototype in C and a Nyacc-based C compiler in [Guile] Scheme.") Guile-] Scheme interpreter prototype in C and a Nyacc-based C compiler in
[Guile] Scheme.")
(home-page "https://gitlab.com/janneke/mes") (home-page "https://gitlab.com/janneke/mes")
(license gpl3+)))) (license gpl3+))))
(define-public mescc-tools (define-public mescc-tools
(package (package
(name "mescc-tools") (name "mescc-tools")
(version "0.1") (version "0.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
"https://github.com/oriansj/MESCC_Tools/archive/Release_" "https://github.com/oriansj/mescc-tools/archive/Release_"
version version
".tar.gz")) ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1lzi9sqv41269isn7in70q2hhh087n4v97zr5i2qzz69j2lkr3xb")))) "0gmyczh88xcsmrmxqksbpaqidchj5hfqxqk7apx40k9r3vav6mnz"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(supported-systems '("i686-linux" "x86_64-linux")) (supported-systems '("i686-linux" "x86_64-linux"))
(arguments (arguments
@ -124,7 +126,7 @@ prototype in C and a Nyacc-based C compiler in [Guile] Scheme.")
(synopsis "Tools for the full source bootstrapping process") (synopsis "Tools for the full source bootstrapping process")
(description (description
"Mescc-tools is a collection of tools for use in a full source "Mescc-tools is a collection of tools for use in a full source
bootstrapping process. Currently consists of the M0 macro assembler and the bootstrapping process. Currently consists of the M1 macro assembler and the
hex2 linker.") hex2 linker.")
(home-page "https://github.com/oriansj/MESCC_Tools") (home-page "https://github.com/oriansj/mescc-tools")
(license gpl3+))) (license gpl3+)))

View File

@ -8,7 +8,7 @@
;;; Copyright © 2016 John Darrington <jmd@gnu.org> ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2016 Nicolas Goaziou <mail@nicolasgoaziou.fr> ;;; Copyright © 2016 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2017 ng0 <ng0@libertad.pw> ;;; Copyright © 2016, 2017 ng0 <ng0@infotropique.org>
;;; Copyright © 2016, 2017 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2016, 2017 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch> ;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch>
;;; Copyright © 2016, 2017 Pjotr Prins <pjotr.guix@thebird.nl> ;;; Copyright © 2016, 2017 Pjotr Prins <pjotr.guix@thebird.nl>
@ -1270,6 +1270,32 @@ enabled due to license conflicts between the BSD advertising clause and the GPL.
;; distribution for clarification. ;; distribution for clarification.
(license (list license:bsd-3 license:bsd-4)))) (license (list license:bsd-3 license:bsd-4))))
(define-public pidentd
(package
(name "pidentd")
(version "3.0.19")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/ptrrkssn/pidentd/archive/"
"v" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0y3kd1bkydqkpc1qdff24yswysamsqivvadjy0468qri5730izgc"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f)) ; No tests are included
(inputs
`(("openssl" ,openssl))) ; For the DES library
(home-page "https://www.lysator.liu.se/~pen/pidentd/")
(synopsis "Small Ident Daemon")
(description
"@dfn{Pidentd} (Peter's Ident Daemon) is a identd, which implements a
identification server. Pidentd looks up specific TCP/IP connections and
returns the user name and other information about the connection.")
(license license:public-domain)))
(define-public spiped (define-public spiped
(package (package
(name "spiped") (name "spiped")

View File

@ -28,10 +28,13 @@
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages autotools) #:use-module (gnu packages autotools)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bison)
#:use-module (gnu packages boost)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages curl) #:use-module (gnu packages curl)
#:use-module (gnu packages databases) #:use-module (gnu packages databases)
#:use-module (gnu packages emacs) #:use-module (gnu packages emacs)
#:use-module (gnu packages flex)
#:use-module (gnu packages gcc) #:use-module (gnu packages gcc)
#:use-module (gnu packages ghostscript) #:use-module (gnu packages ghostscript)
#:use-module (gnu packages glib) #:use-module (gnu packages glib)
@ -3153,3 +3156,238 @@ writing to these structures, and they are accessed via the Bigarray module.")
(synopsis "Minimal library providing hexadecimal converters") (synopsis "Minimal library providing hexadecimal converters")
(description "Hex is a minimal library providing hexadecimal converters.") (description "Hex is a minimal library providing hexadecimal converters.")
(license license:isc))) (license license:isc)))
(define-public coq-flocq
(package
(name "coq-flocq")
(version "2.5.2")
(source (origin
(method url-fetch)
(uri (string-append "https://gforge.inria.fr/frs/download.php/file"
"/36199/flocq-" version ".tar.gz"))
(sha256
(base32
"0h5mlasirfzc0wwn2isg4kahk384n73145akkpinrxq5jsn5d22h"))))
(build-system gnu-build-system)
(native-inputs
`(("ocaml" ,ocaml)
("which" ,which)
("coq" ,coq)))
(arguments
`(#:configure-flags
(list (string-append "--libdir=" (assoc-ref %outputs "out")
"/lib/coq/user-contrib/Flocq"))
#:phases
(modify-phases %standard-phases
(add-before 'configure 'fix-remake
(lambda _
(substitute* "remake.cpp"
(("/bin/sh") (which "sh")))))
(replace 'build
(lambda _
(zero? (system* "./remake"))))
(replace 'check
(lambda _
(zero? (system* "./remake" "check"))))
;; TODO: requires coq-gappa and coq-interval.
;(zero? (system* "./remake" "check-more"))))
(replace 'install
(lambda _
(zero? (system* "./remake" "install")))))))
(home-page "http://flocq.gforge.inria.fr/")
(synopsis "Floating-point formalization for the Coq system")
(description "Flocq (Floats for Coq) is a floating-point formalization for
the Coq system. It provides a comprehensive library of theorems on a multi-radix
multi-precision arithmetic. It also supports efficient numerical computations
inside Coq.")
(license license:lgpl3+)))
(define-public coq-gappa
(package
(name "coq-gappa")
(version "1.3.1")
(source (origin
(method url-fetch)
(uri (string-append "https://gforge.inria.fr/frs/download.php/file/36351/gappa-"
version ".tar.gz"))
(sha256
(base32
"0924jr6f15fx22qfsvim5vc0qxqg30ivg9zxj34lf6slbgdl3j39"))))
(build-system gnu-build-system)
(native-inputs
`(("ocaml" ,ocaml)
("which" ,which)
("coq" ,coq)
("bison" ,bison)
("flex" ,flex)))
(inputs
`(("gmp" ,gmp)
("mpfr" ,mpfr)
("boost" ,boost)))
(arguments
`(#:configure-flags
(list (string-append "--libdir=" (assoc-ref %outputs "out")
"/lib/coq/user-contrib/Gappa"))
#:phases
(modify-phases %standard-phases
(add-before 'configure 'fix-remake
(lambda _
(substitute* "remake.cpp"
(("/bin/sh") (which "sh")))))
(replace 'build
(lambda _
(zero? (system* "./remake"))))
(replace 'check
(lambda _
(zero? (system* "./remake" "check"))))
(replace 'install
(lambda _
(zero? (system* "./remake" "install")))))))
(home-page "http://gappa.gforge.inria.fr/")
(synopsis "Verify and formally prove properties on numerical programs")
(description "Gappa is a tool intended to help verifying and formally proving
properties on numerical programs dealing with floating-point or fixed-point
arithmetic. It has been used to write robust floating-point filters for CGAL
and it is used to certify elementary functions in CRlibm. While Gappa is
intended to be used directly, it can also act as a backend prover for the Why3
software verification plateform or as an automatic tactic for the Coq proof
assistant.")
(license (list license:gpl2+ license:cecill))));either gpl2+ or cecill
(define-public coq-mathcomp
(package
(name "coq-mathcomp")
(version "1.6.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/math-comp/math-comp/archive/mathcomp-"
version ".tar.gz"))
(sha256
(base32
"1j9ylggjzrxz1i2hdl2yhsvmvy5z6l4rprwx7604401080p5sgjw"))))
(build-system gnu-build-system)
(native-inputs
`(("ocaml" ,ocaml)
("which" ,which)
("coq" ,coq)))
(arguments
`(#:tests? #f; No need to test formally-verified programs :)
#:phases
(modify-phases %standard-phases
(delete 'configure)
(add-before 'build 'chdir
(lambda _
(chdir "mathcomp")))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(setenv "COQLIB" (string-append (assoc-ref outputs "out") "/lib/coq/"))
(zero? (system* "make" "-f" "Makefile.coq"
(string-append "COQLIB=" (assoc-ref outputs "out")
"/lib/coq/")
"install")))))))
(home-page "https://math-comp.github.io/math-comp/")
(synopsis "Mathematical Components for Coq")
(description "Mathematical Components for Coq has its origins in the formal
proof of the Four Colour Theorem. Since then it has grown to cover many areas
of mathematics and has been used for large scale projects like the formal proof
of the Odd Order Theorem.
The library is written using the Ssreflect proof language that is an integral
part of the distribution.")
(license license:cecill-b)))
(define-public coq-coquelicot
(package
(name "coq-coquelicot")
(version "3.0.0")
(source (origin
(method url-fetch)
(uri (string-append "https://gforge.inria.fr/frs/download.php/"
"file/36537/coquelicot-" version ".tar.gz"))
(sha256
(base32
"0fx99bvsbdizj00gx2im8939y4wwl05f4qhw184j90kcx5vjxxv9"))))
(build-system gnu-build-system)
(native-inputs
`(("ocaml" ,ocaml)
("which" ,which)
("coq" ,coq)))
(propagated-inputs
`(("mathcomp" ,coq-mathcomp)))
(arguments
`(#:configure-flags
(list (string-append "--libdir=" (assoc-ref %outputs "out")
"/lib/coq/user-contrib/Coquelicot"))
#:phases
(modify-phases %standard-phases
(add-before 'configure 'fix-remake
(lambda _
(substitute* "remake.cpp"
(("/bin/sh") (which "sh")))))
(replace 'build
(lambda _
(zero? (system* "./remake"))))
(replace 'check
(lambda _
(zero? (system* "./remake" "check"))))
(replace 'install
(lambda _
(zero? (system* "./remake" "install")))))))
(home-page "http://coquelicot.saclay.inria.fr/index.html")
(synopsis "Coq library for Reals")
(description "Coquelicot is an easier way of writing formulas and theorem
statements, achieved by relying on total functions in place of dependent types
for limits, derivatives, integrals, power series, and so on. To help with the
proof process, the library comes with a comprehensive set of theorems that cover
not only these notions, but also some extensions such as parametric integrals,
two-dimensional differentiability, asymptotic behaviors. It also offers some
automations for performing differentiability proofs. Moreover, Coquelicot is a
conservative extension of Coq's standard library and provides correspondence
theorems between the two libraries.")
(license license:lgpl3+)))
(define-public coq-interval
(package
(name "coq-interval")
(version "3.2.0")
(source (origin
(method url-fetch)
(uri (string-append "https://gforge.inria.fr/frs/download.php/"
"file/36538/interval-" version ".tar.gz"))
(sha256
(base32
"16ir7mizl18kwa1ls8fwjih6r87894bvc1r6lh85cd43la7nriq3"))))
(build-system gnu-build-system)
(native-inputs
`(("ocaml" ,ocaml)
("which" ,which)
("coq" ,coq)))
(propagated-inputs
`(("flocq" ,coq-flocq)
("coquelicot" ,coq-coquelicot)
("mathcomp" ,coq-mathcomp)))
(arguments
`(#:configure-flags
(list (string-append "--libdir=" (assoc-ref %outputs "out")
"/lib/coq/user-contrib/Gappa"))
#:phases
(modify-phases %standard-phases
(add-before 'configure 'fix-remake
(lambda _
(substitute* "remake.cpp"
(("/bin/sh") (which "sh")))))
(replace 'build
(lambda _
(zero? (system* "./remake"))))
(replace 'check
(lambda _
(zero? (system* "./remake" "check"))))
(replace 'install
(lambda _
(zero? (system* "./remake" "install")))))))
(home-page "http://coq-interval.gforge.inria.fr/")
(synopsis "Coq tactics to simplify inequality proofs")
(description "Interval provides vernacular files containing tactics for
simplifying the proofs of inequalities on expressions of real numbers for the
Coq proof assistant.")
(license license:cecill-c)))

View File

@ -76,8 +76,8 @@
;; Note: the 'update-guix-package.scm' script expects this definition to ;; Note: the 'update-guix-package.scm' script expects this definition to
;; start precisely like this. ;; start precisely like this.
(let ((version "0.13.0") (let ((version "0.13.0")
(commit "f1ddfe4f14b8a8d963f2f3e68d800b745696246d") (commit "228a3982df157847554abc9d0831d687264d8ebd")
(revision 4)) (revision 5))
(package (package
(name "guix") (name "guix")
@ -93,7 +93,7 @@
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"11yjsn957igh6migxrnicdqrxc76skz5r0l7hfnm5gp45my1kd9p")) "1gnc1w9kby7db9jih4xwrhrv0j57zy09lmr85gbmcqna6bx3wypw"))
(file-name (string-append "guix-" version "-checkout")))) (file-name (string-append "guix-" version "-checkout"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
@ -121,6 +121,7 @@
#:modules ((guix build gnu-build-system) #:modules ((guix build gnu-build-system)
(guix build utils) (guix build utils)
(srfi srfi-26)
(ice-9 popen) (ice-9 popen)
(ice-9 rdelim)) (ice-9 rdelim))
@ -187,21 +188,31 @@
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(guile (assoc-ref inputs "guile")) (guile (assoc-ref inputs "guile"))
(json (assoc-ref inputs "guile-json")) (json (assoc-ref inputs "guile-json"))
(git (assoc-ref inputs "guile-git"))
(ssh (assoc-ref inputs "guile-ssh")) (ssh (assoc-ref inputs "guile-ssh"))
(gnutls (assoc-ref inputs "gnutls")) (gnutls (assoc-ref inputs "gnutls"))
(deps (list json gnutls git ssh))
(effective (effective
(read-line (read-line
(open-pipe* OPEN_READ (open-pipe* OPEN_READ
(string-append guile "/bin/guile") (string-append guile "/bin/guile")
"-c" "(display (effective-version))"))) "-c" "(display (effective-version))")))
(path (string-append (path (string-join
json "/share/guile/site/" effective ":" (map (cut string-append <>
ssh "/share/guile/site/" effective ":" "/share/guile/site/"
gnutls "/share/guile/site/" effective))) effective)
deps)
":"))
(gopath (string-join
(map (cut string-append <>
"/lib/guile/" effective
"/site-ccache")
deps)
":")))
(wrap-program (string-append out "/bin/guix") (wrap-program (string-append out "/bin/guix")
`("GUILE_LOAD_PATH" ":" prefix (,path)) `("GUILE_LOAD_PATH" ":" prefix (,path))
`("GUILE_LOAD_COMPILED_PATH" ":" prefix (,path))) `("GUILE_LOAD_COMPILED_PATH" ":" prefix (,gopath)))
#t)))))) #t))))))
(native-inputs `(("pkg-config" ,pkg-config) (native-inputs `(("pkg-config" ,pkg-config)
@ -252,7 +263,8 @@
(propagated-inputs (propagated-inputs
`(("gnutls" ,gnutls) `(("gnutls" ,gnutls)
("guile-json" ,guile-json) ("guile-json" ,guile-json)
("guile-ssh" ,guile-ssh))) ("guile-ssh" ,guile-ssh)
("guile-git" ,guile-git)))
(home-page "https://www.gnu.org/software/guix/") (home-page "https://www.gnu.org/software/guix/")
(synopsis "Functional package manager for installed software packages and versions") (synopsis "Functional package manager for installed software packages and versions")
@ -278,7 +290,8 @@ the Nix package manager.")
(propagated-inputs (propagated-inputs
`(("gnutls" ,gnutls/guile-2.0) `(("gnutls" ,gnutls/guile-2.0)
("guile-json" ,guile2.0-json) ("guile-json" ,guile2.0-json)
("guile-ssh" ,guile2.0-ssh))))) ("guile-ssh" ,guile2.0-ssh)
("guile-git" ,guile2.0-git)))))
(define (source-file? file stat) (define (source-file? file stat)
"Return true if FILE is likely a source file, false if it is a typical "Return true if FILE is likely a source file, false if it is a typical

View File

@ -0,0 +1,24 @@
Patch originally from https://sources.debian.net/patches/erlang/1:20.0.1%2Bdfsg-2/man.patch/
by Francois-Denis Gonthier <neumann@lostwebsite.net>.
Patch description rewritten for Guix.
This patch allows access to the man page with the 'erl -man' command
(Erlang manual pages are placed to /gnu/store/..erlang../share/man/ hierarchy
as other man pages.)
--- a/erts/etc/common/erlexec.c
+++ b/erts/etc/common/erlexec.c
@@ -709,8 +709,10 @@
error("-man not supported on Windows");
#else
argv[i] = "man";
- erts_snprintf(tmpStr, sizeof(tmpStr), "%s/man", rootdir);
- set_env("MANPATH", tmpStr);
+ /*
+ * Conform to erlang-manpages content.
+ */
+ putenv(strsave("MANSECT=1:3:5:7"));
execvp("man", argv+i);
error("Could not execute the 'man' command.");
#endif

View File

@ -1,28 +0,0 @@
Avoid asynchronous channel finalization, which could lead to segfaults due to
libssh not being thread-safe: <https://bugs.gnu.org/26976>.
--- guile-ssh-0.11.0/modules/ssh/dist/node.scm 2017-06-13 14:37:44.861671297 +0200
+++ guile-ssh-0.11.0/modules/ssh/dist/node.scm 2017-06-13 14:38:02.841580565 +0200
@@ -391,11 +391,18 @@ listens on an expected port, return #f o
"Evaluate QUOTED-EXP on the node and return the evaluated result."
(let ((repl-channel (node-open-rrepl node)))
(rrepl-skip-to-prompt repl-channel)
- (call-with-values (lambda () (rrepl-eval repl-channel quoted-exp))
- (lambda vals
- (and (node-stop-repl-server? node)
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (rrepl-eval repl-channel quoted-exp))
+ (lambda ()
+ (when (node-stop-repl-server? node)
(node-stop-server node))
- (apply values vals)))))
+
+ ;; Close REPL-CHANNEL right away to prevent finalization from
+ ;; happening in another thread at the wrong time (see
+ ;; <https://bugs.gnu.org/26976>.)
+ (close-port repl-channel)))))
(define (node-eval-1 node quoted-exp)
"Evaluate QUOTED-EXP on the node and return the evaluated result. The

View File

@ -1,37 +0,0 @@
Fix a double-free or use-after-free issue with Guile-SSH used
with Guile 2.2. See <https://bugs.gnu.org/26976>.
diff --git a/libguile-ssh/channel-type.c b/libguile-ssh/channel-type.c
index 3dd641f..0839854 100644
--- a/libguile-ssh/channel-type.c
+++ b/libguile-ssh/channel-type.c
@@ -229,10 +229,11 @@ ptob_close (SCM channel)
ssh_channel_free (ch->ssh_channel);
}
+ SCM_SETSTREAM (channel, NULL);
+
#if USING_GUILE_BEFORE_2_2
scm_gc_free (pt->write_buf, pt->write_buf_size, "port write buffer");
scm_gc_free (pt->read_buf, pt->read_buf_size, "port read buffer");
- SCM_SETSTREAM (channel, NULL);
return 0;
#endif
diff --git a/libguile-ssh/sftp-file-type.c b/libguile-ssh/sftp-file-type.c
index 8879924..f87cf03 100644
--- a/libguile-ssh/sftp-file-type.c
+++ b/libguile-ssh/sftp-file-type.c
@@ -224,10 +224,11 @@ ptob_close (SCM sftp_file)
sftp_close (fd->file);
}
+ SCM_SETSTREAM (sftp_file, NULL);
+
#if USING_GUILE_BEFORE_2_2
scm_gc_free (pt->write_buf, pt->write_buf_size, "port write buffer");
scm_gc_free (pt->read_buf, pt->read_buf_size, "port read buffer");
- SCM_SETSTREAM (sftp_file, NULL);
return 1;
#endif

View File

@ -1,16 +0,0 @@
Fix a bug whereby 'node-guile-version' would pass a node instead of
a session to 'rexec'.
diff --git a/modules/ssh/dist/node.scm b/modules/ssh/dist/node.scm
index 9c065c7..29a3906 100644
--- a/modules/ssh/dist/node.scm
+++ b/modules/ssh/dist/node.scm
@@ -411,7 +411,8 @@ procedure returns the 1st evaluated value if multiple values were returned."
"Get Guile version installed on a NODE, return the version string. Return
#f if Guile is not installed."
(receive (result rc)
- (rexec node "which guile > /dev/null && guile --version")
+ (rexec (node-session node)
+ "which guile > /dev/null && guile --version")
(and (zero? rc)
(car result))))

View File

@ -1,24 +0,0 @@
This patch is taken from <https://github.com/libgit2/libgit2/pull/4122>;
we need it to fix the use-after-free error in 'git_commit_extract_signature'
reported at <https://github.com/libgit2/libgit2/issues/4118>.
From ade0d9c658fdfc68d8046935f6908f033fe7a529 Mon Sep 17 00:00:00 2001
From: Patrick Steinhardt <ps@pks.im>
Date: Mon, 13 Feb 2017 13:46:17 +0100
Subject: [PATCH 3/3] commit: avoid possible use-after-free
diff --git a/src/commit.c b/src/commit.c
index 89a4db1..05b70a9 100644
--- a/src/commit.c
+++ b/src/commit.c
@@ -766,8 +766,9 @@ int git_commit_extract_signature(git_buf *signature, git_buf *signed_data, git_r
if (git_buf_oom(signature))
goto oom;
+ error = git_buf_puts(signed_data, eol+1);
git_odb_object_free(obj);
- return git_buf_puts(signed_data, eol+1);
+ return error;
}
giterr_set(GITERR_OBJECT, "this commit is not signed");

View File

@ -1,28 +0,0 @@
See: https://bugs.launchpad.net/oslosphinx/+bug/1661861
diff -ur orig/pbr-1.10.0/pbr/builddoc.py pbr-1.10.0/pbr/builddoc.py
--- orig/pbr-1.10.0/pbr/builddoc.py 2016-05-23 21:38:18.000000000 +0200
+++ pbr-1.10.0/pbr/builddoc.py 2017-02-18 14:01:37.424434317 +0100
@@ -138,7 +138,8 @@
sphinx_config.init_values(warnings.warn)
else:
sphinx_config.init_values()
- if self.builder == 'man' and len(sphinx_config.man_pages) == 0:
+ if self.builder == 'man' and len(
+ getattr(sphinx_config, 'man_pages', '')) == 0:
return
app = application.Sphinx(
self.source_dir, self.config_dir,
diff -ur orig/pbr-1.10.0/pbr/util.py pbr-1.10.0/pbr/util.py
--- orig/pbr-1.10.0/pbr/util.py 2016-05-23 21:38:18.000000000 +0200
+++ pbr-1.10.0/pbr/util.py 2017-02-18 15:36:32.951196795 +0100
@@ -211,7 +211,9 @@
parser.read(path)
config = {}
for section in parser.sections():
- config[section] = dict(parser.items(section))
+ config[section] = dict()
+ for k, value in parser.items(section):
+ config[section][k.replace('-', '_')] = value
# Run setup_hooks, if configured
setup_hooks = has_get_option(config, 'global', 'setup_hooks')

View File

@ -2280,15 +2280,14 @@ protocol.")
(define python-pbr-minimal (define python-pbr-minimal
(package (package
(name "python-pbr-minimal") (name "python-pbr-minimal")
(version "1.10.0") (version "3.0.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (pypi-uri "pbr" version)) (uri (pypi-uri "pbr" version))
(sha256 (sha256
(base32 (base32
"177kd9kbv1hvf2ban7l3x9ymzbi1md4hkaymwbgnz7ihf312hr0q")) "14fs5acnalnb3h62s7q7av239j541fk0n0z0lawh4h09b1s93s6p"))))
(patches (search-patches "python-pbr-fix-man-page-support.patch"))))
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:tests? #f)) `(#:tests? #f))

View File

@ -28,7 +28,7 @@
(define-public re2 (define-public re2
(package (package
(name "re2") (name "re2")
(version "2017-07-01") (version "2017-08-01")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (uri
@ -38,7 +38,7 @@
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"07jbhcfpa4z8ra08q0i7j9p9sq6yy1wdx09laysz9jysgkc6mw76")))) "0dhndzr4ncdpa3yq22qlzxk7i1vlrcdg9z65k0k3j9bi37f271wk"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:modules ((guix build gnu-build-system) `(#:modules ((guix build gnu-build-system)

View File

@ -443,13 +443,13 @@ expectations and mocks frameworks.")
(define-public bundler (define-public bundler
(package (package
(name "bundler") (name "bundler")
(version "1.15.1") (version "1.15.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (rubygems-uri "bundler" version)) (uri (rubygems-uri "bundler" version))
(sha256 (sha256
(base32 (base32
"1mq0n8g08vf2rnd7fvylx3f4sspx15abid49gycf9zzsjj7w8vps")))) "125amldnpzzrfw76mmr7mlx002k1k6xdyrqf5bdnzl5hajvn0s5f"))))
(build-system ruby-build-system) (build-system ruby-build-system)
(arguments (arguments
'(#:tests? #f)) ; avoid dependency cycles '(#:tests? #f)) ; avoid dependency cycles
@ -929,13 +929,13 @@ Ruby Gems.")
(define-public ruby-ffi (define-public ruby-ffi
(package (package
(name "ruby-ffi") (name "ruby-ffi")
(version "1.9.14") (version "1.9.18")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (rubygems-uri "ffi" version)) (uri (rubygems-uri "ffi" version))
(sha256 (sha256
(base32 (base32
"1nkcrmxqr0vb1y4rwliclwlj2ajsi4ddpdx2gvzjy0xbkk5iqzfp")))) "034f52xf7zcqgbvwbl20jwdyjwznvqnwpbaps9nk18v9lgb1dpx0"))))
(build-system ruby-build-system) (build-system ruby-build-system)
;; FIXME: Before running tests the build system attempts to build libffi ;; FIXME: Before running tests the build system attempts to build libffi
;; from sources. ;; from sources.
@ -1913,24 +1913,24 @@ to reproduce user environments.")
(define-public ruby-mini-portile-2 (define-public ruby-mini-portile-2
(package (inherit ruby-mini-portile) (package (inherit ruby-mini-portile)
(version "2.1.0") (version "2.2.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (rubygems-uri "mini_portile2" version)) (uri (rubygems-uri "mini_portile2" version))
(sha256 (sha256
(base32 (base32
"1y25adxb1hgg1wb2rn20g3vl07qziq6fz364jc5694611zz863hb")))))) "0g5bpgy08q0nc0anisg3yvwc1gc3inl854fcrg48wvg7glqd6dpm"))))))
(define-public ruby-nokogiri (define-public ruby-nokogiri
(package (package
(name "ruby-nokogiri") (name "ruby-nokogiri")
(version "1.7.0.1") (version "1.8.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (rubygems-uri "nokogiri" version)) (uri (rubygems-uri "nokogiri" version))
(sha256 (sha256
(base32 (base32
"10xahg0fwydh27psm8bv429mdja2ks6x83vxizq26ib8wvs05mv3")))) "1nffsyx1xjg6v5n9rrbi8y1arrcx2i5f21cp6clgh9iwiqkr7rnn"))))
(build-system ruby-build-system) (build-system ruby-build-system)
(arguments (arguments
;; Tests fail because Nokogiri can only test with an installed extension, ;; Tests fail because Nokogiri can only test with an installed extension,
@ -2463,46 +2463,34 @@ a native C extension.")
(define-public ruby-json-pure (define-public ruby-json-pure
(package (package
(name "ruby-json-pure") (name "ruby-json-pure")
(version "1.8.3") (version "2.1.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (rubygems-uri "json_pure" version)) (uri (rubygems-uri "json_pure" version))
(sha256 (sha256
(base32 (base32
"025aykr360x6dr1jmg8pmsrx7gr30pws4p1q686vnb48zyw1sc94")))) "12yf9fmhr4c2jm3xl20vf1qyz5i63vc8a6ngz9j0f86nqwhmi2as"))))
(build-system ruby-build-system) (build-system ruby-build-system)
(arguments (arguments
`(#:modules ((srfi srfi-1) `(#:phases
(ice-9 regex)
(rnrs io ports)
(guix build ruby-build-system)
(guix build utils))
#:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'unpack 'replace-git-ls-files (add-after 'unpack 'fix-rakefile
(lambda _ (lambda _
;; The existing gemspec file already contains a nice list of
;; files that belong to the gem. We extract the list from the
;; gemspec file and then replace the file list in the Rakefile to
;; get rid of the call to "git ls-files".
(let* ((contents (call-with-input-file "json.gemspec" get-string-all))
;; Guile is unhappy about the #\nul characters in comments.
(filtered (string-filter (lambda (char)
(not (equal? #\nul char)))
contents))
(files (match:substring
(string-match " s\\.files = ([^]]+\\])" filtered) 1)))
(substitute* "Rakefile" (substitute* "Rakefile"
(("FileList\\[`git ls-files`\\.split\\(/\\\\n/\\)\\]") ;; Since this is not a git repository, do not call 'git'.
(string-append "FileList" files)))) (("`git ls-files`") "`find . -type f |sort`")
(substitute* "Gemfile" ;; Loosen dependency constraint.
((".*json-java.*") "\n")) (("'test-unit', '~> 2.0'") "'test-unit', '>= 2.0'"))
#t))))) #t))
(add-after 'replace-git-ls-files 'regenerate-gemspec
(lambda _
;; Regenerate gemspec so loosened dependency constraints are
;; propagated.
(zero? (system* "rake" "gemspec")))))))
(native-inputs (native-inputs
`(("ruby-permutation" ,ruby-permutation) `(("bundler" ,bundler)
("ruby-utils" ,ruby-utils) ("ruby-test-unit" ,ruby-test-unit)
("ragel" ,ragel) ("ruby-simplecov" ,ruby-simplecov)))
("bundler" ,bundler)))
(synopsis "JSON implementation in pure Ruby") (synopsis "JSON implementation in pure Ruby")
(description (description
"This package provides a JSON implementation written in pure Ruby.") "This package provides a JSON implementation written in pure Ruby.")
@ -3639,14 +3627,14 @@ subprocess.")
(define-public ruby-bio-commandeer (define-public ruby-bio-commandeer
(package (package
(name "ruby-bio-commandeer") (name "ruby-bio-commandeer")
(version "0.1.3") (version "0.2.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (rubygems-uri "bio-commandeer" version)) (uri (rubygems-uri "bio-commandeer" version))
(sha256 (sha256
(base32 (base32
"0lin6l99ldqqjc90l9ihcrv882c4xgbgqm16jqkdy6jf955jd9a8")))) "1xlcnh13r33zybpmqniw0j8q5n0kq9al67ygqpf0xbbwxnnkqqvj"))))
(build-system ruby-build-system) (build-system ruby-build-system)
(arguments (arguments
`(#:phases `(#:phases

View File

@ -215,7 +215,7 @@ Additionally, various channel-specific options can be negotiated.")
(define-public guile-ssh (define-public guile-ssh
(package (package
(name "guile-ssh") (name "guile-ssh")
(version "0.11.0") (version "0.11.2")
(home-page "https://github.com/artyom-poptsov/guile-ssh") (home-page "https://github.com/artyom-poptsov/guile-ssh")
(source (origin (source (origin
;; ftp://memory-heap.org/software/guile-ssh/guile-ssh-VERSION.tar.gz ;; ftp://memory-heap.org/software/guile-ssh/guile-ssh-VERSION.tar.gz
@ -227,19 +227,7 @@ Additionally, various channel-specific options can be negotiated.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0r261i8kc3avbmbwgyzak2vnqwssjlgz37g2y2fwm80w9bmn2m7j")) "1w0k5s09xj5xycb7lbp5b7rm0xncclms3jwl98lwj8fxwngi1s90"))))
(patches (search-patches "guile-ssh-rexec-bug.patch"
"guile-ssh-double-free.patch"
"guile-ssh-channel-finalization.patch"))
(modules '((guix build utils)))
(snippet
;; 'configure.ac' mistakenly tries to link files from examples/
;; that are not instantiated yet. Work around it.
'(substitute* "configure.ac"
(("AC_CONFIG_LINKS\\(\\[examples/([^:]+):.*" _ file)
(string-append "AC_CONFIG_FILES([examples/" file
"], [chmod +x examples/"
file "])\n"))))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" "debug")) (outputs '("out" "debug"))
(arguments (arguments

View File

@ -80,14 +80,14 @@ fundamental object types for C.")
(define-public sssd (define-public sssd
(package (package
(name "sssd") (name "sssd")
(version "1.15.2") (version "1.15.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://releases.pagure.org/SSSD/sssd/" (uri (string-append "http://releases.pagure.org/SSSD/sssd/"
"sssd-" version ".tar.gz")) "sssd-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0r6j28f7vjb1aw65gkw4nz2l3jy605h7wsr1k815hynp2jrzrmac")))) "0d36dmzqdjfpspm9fw4zx0kh0qcx60p9vchxvcajn4qf3k3qsl3f"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:make-flags `(#:make-flags
@ -161,7 +161,8 @@ fundamental object types for C.")
("docbook-xsl" ,docbook-xsl) ("docbook-xsl" ,docbook-xsl)
("docbook-xml" ,docbook-xml) ("docbook-xml" ,docbook-xml)
("libxslt" ,libxslt) ("libxslt" ,libxslt)
("pkg-config" ,pkg-config))) ("pkg-config" ,pkg-config)
("util-linux" ,util-linux))) ; for uuid.h, reqired for KCM
(home-page "https://pagure.io/SSSD/sssd/") (home-page "https://pagure.io/SSSD/sssd/")
(synopsis "System security services daemon") (synopsis "System security services daemon")
(description "SSSD is a system daemon. Its primary function is to provide (description "SSSD is a system daemon. Its primary function is to provide

View File

@ -373,7 +373,7 @@ Hubert, based on Kaufman and Rousseeuw (1990) \"Finding Groups in Data\".")
(uri (cran-uri "foreign" version)) (uri (cran-uri "foreign" version))
(sha256 (sha256
(base32 (base32
"1mcrm2pydimbyjhkrw5h380bifj1jhwzifph1xgh90asf3lvd1xd")))) "0j0z815zyp8n97rk6hlk68d1r8b26vls39s03viq0pnx3cbpwyga"))))
(build-system r-build-system) (build-system r-build-system)
(home-page "http://cran.r-project.org/web/packages/foreign") (home-page "http://cran.r-project.org/web/packages/foreign")
(synopsis "Read data stored by other statistics software") (synopsis "Read data stored by other statistics software")
@ -1602,26 +1602,6 @@ It is based on the methods described in Kaufman and Rousseeuw (1990) \"Finding
Groups in Data\".") Groups in Data\".")
(license license:gpl2+))) (license license:gpl2+)))
(define-public r-foreign
(package
(name "r-foreign")
(version "0.8-67")
(source
(origin
(method url-fetch)
(uri (cran-uri "foreign" version))
(sha256
(base32
"1mcrm2pydimbyjhkrw5h380bifj1jhwzifph1xgh90asf3lvd1xd"))))
(build-system r-build-system)
(home-page "http://cran.r-project.org/web/packages/foreign")
(synopsis "Read data stored by other statistics software in R")
(description
"This package provides functions for reading and writing data stored by
some versions of Epi Info, Minitab, S, SAS, SPSS, Stata, Systat and Weka, and
for reading and writing some dBase files.")
(license license:gpl2+)))
(define-public r-formula (define-public r-formula
(package (package
(name "r-formula") (name "r-formula")

View File

@ -2,7 +2,7 @@
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017 ng0 <contact.ng0@cryptolab.net> ;;; Copyright © 2016, 2017 ng0 <ng0@infotropique.org>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2017 Rutger Helling <rhelling@mykolab.com> ;;; Copyright © 2017 Rutger Helling <rhelling@mykolab.com>
@ -54,8 +54,7 @@
"0hhyb1wil8japynqnm07r1f67w3wdnafdg9amzlrrcfcyq5qim28")))) "0hhyb1wil8japynqnm07r1f67w3wdnafdg9amzlrrcfcyq5qim28"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:configure-flags (list "--enable-expensive-hardening" `(#:configure-flags (list "--enable-gcc-hardening"
"--enable-gcc-hardening"
"--enable-linker-hardening"))) "--enable-linker-hardening")))
(native-inputs (native-inputs
`(("python" ,python-2))) ; for tests `(("python" ,python-2))) ; for tests

View File

@ -120,14 +120,14 @@ as well as the classic centralized workflow.")
(define-public git (define-public git
(package (package
(name "git") (name "git")
(version "2.13.3") (version "2.13.4")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://kernel.org/software/scm/git/git-" (uri (string-append "mirror://kernel.org/software/scm/git/git-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"0qiy696pwqhbxcrvm3zhyjnfjrym541glhvgc4cynrwg8az27ali")))) "1nmg0n9l5ix876iqhcyhdnmiy7ihv0ybdijf1lssch6ja8m5j6ip"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("native-perl" ,perl) `(("native-perl" ,perl)
@ -140,7 +140,7 @@ as well as the classic centralized workflow.")
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1hl1fhbr3jn4y9pkj26kk9frj6wjlxiphl7x5c9ma6x4081xna0i")))))) "0ljxkfi7ski9bgpdb8xpikl1xgjjk7bdzmzzkbj93jybk6iajkv7"))))))
(inputs (inputs
`(("curl" ,curl) `(("curl" ,curl)
("expat" ,expat) ("expat" ,expat)
@ -334,7 +334,7 @@ everything from small to very large projects with speed and efficiency.")
(define-public libgit2 (define-public libgit2
(package (package
(name "libgit2") (name "libgit2")
(version "0.25.1") (version "0.26.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/libgit2/libgit2/" (uri (string-append "https://github.com/libgit2/libgit2/"
@ -342,12 +342,13 @@ everything from small to very large projects with speed and efficiency.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1cdwcw38frc1wf28x5ppddazv9hywc718j92f3xa3ybzzycyds3s")) "1fdk9yhwvl1w1z71ykzcvgh4nsf8scxcbclz5anh98zpplmhmisa"))
(patches (search-patches "libgit2-use-after-free.patch" (patches (search-patches "libgit2-0.25.1-mtime-0.patch"))))
"libgit2-0.25.1-mtime-0.patch"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(outputs '("out" "debug"))
(arguments (arguments
`(#:phases `(#:configure-flags '("-DUSE_SHA1DC=ON") ; SHA-1 collision detection
#:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'unpack 'fix-hardcoded-paths (add-after 'unpack 'fix-hardcoded-paths
(lambda _ (lambda _

View File

@ -580,14 +580,14 @@ standards (MPEG-2, MPEG-4 ASP/H.263, MPEG-4 AVC/H.264, and VC-1/VMW3).")
(define-public ffmpeg (define-public ffmpeg
(package (package
(name "ffmpeg") (name "ffmpeg")
(version "3.3.2") (version "3.3.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://ffmpeg.org/releases/ffmpeg-" (uri (string-append "https://ffmpeg.org/releases/ffmpeg-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"11974vcfsy8w0i6f4lfwqmg80xkfybqw7vw6zzrcn5i6ncddx60r")))) "07is8msrhxr1dk6vgwa192k2pl2a0in1h9w8f9cknlvbvhn01afj"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("fontconfig" ,fontconfig) `(("fontconfig" ,fontconfig)

View File

@ -60,7 +60,7 @@
(define-public vim (define-public vim
(package (package
(name "vim") (name "vim")
(version "8.0.0727") (version "8.0.0808")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/vim/vim/archive/v" (uri (string-append "https://github.com/vim/vim/archive/v"
@ -68,20 +68,13 @@
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0hwqglpsk8qlp2rn6q9p35fxk88xixljk1yv42m3j01g3bgqg0gx")))) "0qrn9fhq5wdrrf2qhpygwfm5rynl32l406xhbr7lg69r9wl8cjjn"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:test-target "test" `(#:test-target "test"
#:parallel-tests? #f #:parallel-tests? #f
#:phases #:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'unpack 'make-bit-reproducable
(lambda _
(substitute* "src/version.c"
((" VIM_VERSION_LONG_DATE") " VIM_VERSION_LONG")
((" __DATE__") "")
((" __TIME__") ""))
#t))
(add-after 'configure 'patch-config-files (add-after 'configure 'patch-config-files
(lambda _ (lambda _
(substitute* "runtime/tools/mve.awk" (substitute* "runtime/tools/mve.awk"
@ -116,15 +109,6 @@ configuration files.")
;; frequency of important bug fixes. ;; frequency of important bug fixes.
(inherit vim) (inherit vim)
(name "vim-full") (name "vim-full")
(version "8.0.0600")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/vim/vim/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1ifaj0lfzqn06snkcd83l58m9r6lg7lk3wspx71k5ycvypyfi67s"))))
(arguments (arguments
`(#:configure-flags `(#:configure-flags
(list (string-append "--with-lua-prefix=" (list (string-append "--with-lua-prefix="
@ -144,17 +128,6 @@ configuration files.")
,@(substitute-keyword-arguments (package-arguments vim) ,@(substitute-keyword-arguments (package-arguments vim)
((#:phases phases) ((#:phases phases)
`(modify-phases ,phases `(modify-phases ,phases
(add-after 'build 'drop-failing-tests
(lambda _
;; These tests fail mysteriously with GUI enabled.
;; https://github.com/vim/vim/issues/1460
(substitute* "src/testdir/test_cmdline.vim"
(("call assert_equal\\(.+getcmd.+\\(\\)\\)") ""))
;; FIXME: This test broke after GCC-5 core-updates merge.
;; "Test_system_exmode line 7: Expected '0' but got '/'"
(substitute* "src/testdir/test_system.vim"
(("call assert_equal\\('0', a\\[0\\]\\)") ""))
#t))
(add-before 'check 'start-xserver (add-before 'check 'start-xserver
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
;; Some tests require an X server, but does not start one. ;; Some tests require an X server, but does not start one.

View File

@ -145,7 +145,7 @@
`(("alsa-lib" ,alsa-lib) `(("alsa-lib" ,alsa-lib)
("attr" ,attr) ("attr" ,attr)
("glib" ,glib) ("glib" ,glib)
;; ("libaio" ,libaio) ("libaio" ,libaio)
("libattr" ,attr) ("libattr" ,attr)
("libcap" ,libcap) ; virtfs support requires libcap & libattr ("libcap" ,libcap) ; virtfs support requires libcap & libattr
("libjpeg" ,libjpeg-8) ("libjpeg" ,libjpeg-8)

View File

@ -449,7 +449,7 @@ current version of any major web browser.")
(define-public rapidjson (define-public rapidjson
(package (package
(name "rapidjson") (name "rapidjson")
(version "1.0.2") (version "1.1.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -458,13 +458,7 @@ current version of any major web browser.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0rl6s0vg5y1dhh9vfl1lqay3sxf69sxjh0czxrjmasn7ng91wwf3")) "13nrpvw8f1wx0ga7svbzld7pgrv8l172nangpipnj7jaf0lysz5z"))))
(modules '((guix build utils)))
(snippet
;; Building with GCC 4.8 with -Werror was fine, but 4.9.3
;; complains in new ways, so turn of -Werror.
'(substitute* (find-files "." "^CMakeLists\\.txt$")
(("-Werror") "")))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
`(,@(if (string-prefix? "aarch64" (or (%current-target-system) `(,@(if (string-prefix? "aarch64" (or (%current-target-system)

View File

@ -93,16 +93,7 @@
(build-system python-build-system) (build-system python-build-system)
(arguments (arguments
`(#:python ,python-2 ;incompatible with python 3 `(#:python ,python-2 ;incompatible with python 3
#:tests? #f ;no tests #:tests? #f)) ;no tests
#:phases
(modify-phases %standard-phases
(add-after 'install 'make-xrandr-available
(lambda* (#:key inputs outputs #:allow-other-keys)
(wrap-program (string-append (assoc-ref outputs "out")
"/bin/arandr")
`("PATH" ":" prefix (,(string-append (assoc-ref inputs "xrandr")
"/bin"))))
#t)))))
(inputs `(("pygtk" ,python2-pygtk) (inputs `(("pygtk" ,python2-pygtk)
("xrandr" ,xrandr))) ("xrandr" ,xrandr)))
(native-inputs `(("gettext" ,gettext-minimal) (native-inputs `(("gettext" ,gettext-minimal)
@ -452,7 +443,7 @@ of the screen selected by mouse.")
(define-public slop (define-public slop
(package (package
(name "slop") (name "slop")
(version "6.3.47") (version "7.3.48")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -461,7 +452,7 @@ of the screen selected by mouse.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1kjivsq4c7dr7ggp44k09xm97i9chg8czvachqrfnv6fiqvwys0i")))) "14igmf6a6vwx75gjnj10497n04klc35dvq87id8g9jn9rd3m6n25"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
'(#:tests? #f)) ; no "check" target '(#:tests? #f)) ; no "check" target
@ -485,7 +476,7 @@ selection's dimensions to stdout.")
(define-public maim (define-public maim
(package (package
(name "maim") (name "maim")
(version "5.4.64") (version "5.4.66")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -494,7 +485,7 @@ selection's dimensions to stdout.")
(file-name (string-append name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0y7ajwcp6x9q7581alz2b5xqijs5cb9l38h10fzinswqrcz53ak1")))) "077aww1fab3ihzxdybxpdh0h3d7fbgpvsm9q92byfb2ig32viyfa"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
'(#:tests? #f)) ; no "check" target '(#:tests? #f)) ; no "check" target

View File

@ -2886,10 +2886,12 @@ X server.")
(define-public xf86-video-intel (define-public xf86-video-intel
(let ((commit "6babcf15dd605ef40de53f5c34f95b7fd195edbe")) (let ((commit "2100efa105e8c9615eda867d39471d78e500b1bb")
(revision "7"))
(package (package
(name "xf86-video-intel") (name "xf86-video-intel")
(version (string-append "2.99.917-6-" (string-take commit 7))) (version (string-append "2.99.917-" revision "-"
(string-take commit 7)))
(source (source
(origin (origin
;; there's no current tarball ;; there's no current tarball
@ -2899,7 +2901,7 @@ X server.")
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"055v4z26r00h3mxsd084n3aq8b5h0h3jkv52xss76zgbsq3n2354")) "15fg844msmixsvlxcd5wm2awmns652sxcxj2wmp6819lr32lc4ir"))
(file-name (string-append name "-" version)))) (file-name (string-append name "-" version))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("mesa" ,mesa) (inputs `(("mesa" ,mesa)

View File

@ -20,14 +20,19 @@
(define-module (gnu services admin) (define-module (gnu services admin)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages logging)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services mcron) #:use-module (gnu services mcron)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
#:use-module (gnu services web)
#:use-module (gnu system shadow)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix records) #:use-module (guix records)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:export (%default-rotations #:export (%default-rotations
%rotated-files %rotated-files
@ -41,7 +46,27 @@
rottlog-configuration rottlog-configuration
rottlog-configuration? rottlog-configuration?
rottlog-service rottlog-service
rottlog-service-type)) rottlog-service-type
<tailon-configuration-file>
tailon-configuration-file
tailon-configuration-file?
tailon-configuration-file-files
tailon-configuration-file-bind
tailon-configuration-file-relative-root
tailon-configuration-file-allow-transfers?
tailon-configuration-file-follow-names?
tailon-configuration-file-tail-lines
tailon-configuration-file-allowed-commands
tailon-configuration-file-debug?
<tailon-configuration>
tailon-configuration
tailon-configuration?
tailon-configuration-config-file
tailon-configuration-package
tailon-service-type))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -172,4 +197,128 @@ for ROTATION."
rotations))))) rotations)))))
(default-value (rottlog-configuration)))) (default-value (rottlog-configuration))))
;;;
;;; Tailon
;;;
(define-record-type* <tailon-configuration-file>
tailon-configuration-file make-tailon-configuration-file
tailon-configuration-file?
(files tailon-configuration-file-files
(default '("/var/log")))
(bind tailon-configuration-file-bind
(default "localhost:8080"))
(relative-root tailon-configuration-file-relative-root
(default #f))
(allow-transfers? tailon-configuration-file-allow-transfers?
(default #t))
(follow-names? tailon-configuration-file-follow-names?
(default #t))
(tail-lines tailon-configuration-file-tail-lines
(default 200))
(allowed-commands tailon-configuration-file-allowed-commands
(default '("tail" "grep" "awk")))
(debug? tailon-configuration-file-debug?
(default #f)))
(define (tailon-configuration-files-string files)
(string-append
"\n"
(string-join
(map
(lambda (x)
(string-append
" - "
(cond
((string? x)
(simple-format #f "'~A'" x))
((list? x)
(string-join
(cons (simple-format #f "'~A':" (car x))
(map
(lambda (x) (simple-format #f " - '~A'" x))
(cdr x)))
"\n"))
(else (error x)))))
files)
"\n")))
(define-gexp-compiler (tailon-configuration-file-compiler
(file <tailon-configuration-file>) system target)
(match file
(($ <tailon-configuration-file> files bind relative-root
allow-transfers? follow-names?
tail-lines allowed-commands debug?)
(text-file
"tailon-config.yaml"
(string-concatenate
(filter-map
(match-lambda
((key . #f) #f)
((key . value) (string-append key ": " value "\n")))
`(("files" . ,(tailon-configuration-files-string files))
("bind" . ,bind)
("relative-root" . ,relative-root)
("allow-transfers" . ,(if allow-transfers? "true" "false"))
("follow-names" . ,(if follow-names? "true" "false"))
("tail-lines" . ,(number->string tail-lines))
("commands" . ,(string-append "["
(string-join allowed-commands ", ")
"]"))
,@(if debug? '(("debug" . "true")) '()))))))))
(define-record-type* <tailon-configuration>
tailon-configuration make-tailon-configuration
tailon-configuration?
(config-file tailon-configuration-config-file
(default (tailon-configuration-file)))
(package tailon-configuration-package
(default tailon)))
(define tailon-shepherd-service
(match-lambda
(($ <tailon-configuration> config-file package)
(list (shepherd-service
(provision '(tailon))
(documentation "Run the tailon daemon.")
(start #~(make-forkexec-constructor
`(,(string-append #$package "/bin/tailon")
"-c" ,#$config-file)
#:user "tailon"
#:group "tailon"))
(stop #~(make-kill-destructor)))))))
(define %tailon-accounts
(list (user-group (name "tailon") (system? #t))
(user-account
(name "tailon")
(group "tailon")
(system? #t)
(comment "tailon")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))))
(define tailon-service-type
(service-type
(name 'tailon)
(extensions
(list (service-extension shepherd-root-service-type
tailon-shepherd-service)
(service-extension account-service-type
(const %tailon-accounts))))
(compose concatenate)
(extend (lambda (parameter files)
(tailon-configuration
(inherit parameter)
(config-file
(let ((old-config-file
(tailon-configuration-config-file parameter)))
(tailon-configuration-file
(inherit old-config-file)
(files (append (tailon-configuration-file-files old-config-file)
files))))))))
(default-value (tailon-configuration))))
;;; admin.scm ends here ;;; admin.scm ends here

View File

@ -23,6 +23,7 @@
#:use-module (guix records) #:use-module (guix records)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:autoload (gnu packages ci) (cuirass) #:autoload (gnu packages ci) (cuirass)
#:autoload (gnu packages version-control) (git)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services base) #:use-module (gnu services base)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
@ -105,6 +106,12 @@
#$@(if fallback? '("--fallback") '()) #$@(if fallback? '("--fallback") '())
#$@(if (null? load-path) '() #$@(if (null? load-path) '()
`("--load-path" ,(string-join load-path ":")))) `("--load-path" ,(string-join load-path ":"))))
#:environment-variables
(list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
(string-append "GIT_EXEC_PATH=" #$git
"/libexec/git-core"))
#:user #$user #:user #$user
#:group #$group #:group #$group
#:log-file #$log-file)) #:log-file #$log-file))

View File

@ -25,6 +25,7 @@
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module (gnu packages databases) #:use-module (gnu packages databases)
#:use-module (guix modules)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -33,6 +34,16 @@
postgresql-service postgresql-service
postgresql-service-type postgresql-service-type
memcached-service-type
<memcached-configuration>
memcached-configuration
memcached-configuration?
memcached-configuration-memecached
memcached-configuration-interfaces
memcached-configuration-tcp-port
memcached-configuration-udp-port
memcached-configuration-additional-options
mysql-service mysql-service
mysql-service-type mysql-service-type
mysql-configuration mysql-configuration
@ -176,6 +187,68 @@ and stores the database cluster in @var{data-directory}."
(config-file config-file) (config-file config-file)
(data-directory data-directory)))) (data-directory data-directory))))
;;;
;;; Memcached
;;;
(define-record-type* <memcached-configuration>
memcached-configuration make-memcached-configuration
memcached-configuration?
(memcached memcached-configuration-memcached ;<package>
(default memcached))
(interfaces memcached-configuration-interfaces
(default '("0.0.0.0")))
(tcp-port memcached-configuration-tcp-port
(default 11211))
(udp-port memcached-configuration-udp-port
(default 11211))
(additional-options memcached-configuration-additional-options
(default '())))
(define %memcached-accounts
(list (user-group (name "memcached") (system? #t))
(user-account
(name "memcached")
(group "memcached")
(system? #t)
(comment "Memcached server user")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))))
(define memcached-shepherd-service
(match-lambda
(($ <memcached-configuration> memcached interfaces tcp-port udp-port
additional-options)
(with-imported-modules (source-module-closure
'((gnu build shepherd)))
(list (shepherd-service
(provision '(memcached))
(documentation "Run the Memcached daemon.")
(requirement '(user-processes loopback))
(modules '((gnu build shepherd)))
(start #~(make-forkexec-constructor
`(#$(file-append memcached "/bin/memcached")
"-l" #$(string-join interfaces ",")
"-p" #$(number->string tcp-port)
"-U" #$(number->string udp-port)
"--daemon"
"-P" "/var/run/memcached.pid"
"-u" "memcached"
,#$@additional-options)
#:log-file "/var/log/memcached"
#:pid-file "/var/run/memcached.pid"))
(stop #~(make-kill-destructor))))))))
(define memcached-service-type
(service-type (name 'memcached)
(extensions
(list (service-extension shepherd-root-service-type
memcached-shepherd-service)
(service-extension account-service-type
(const %memcached-accounts))))
(default-value (memcached-configuration))))
;;; ;;;
;;; MySQL. ;;; MySQL.

View File

@ -334,10 +334,13 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
(service dhcp-client-service-type dhcp)) (service dhcp-client-service-type dhcp))
(define %ntp-servers (define %ntp-servers
;; Default set of NTP servers. ;; Default set of NTP servers. These URLs are managed by the NTP Pool project.
'("0.pool.ntp.org" ;; Within Guix, Leo Famulari <leo@famulari.name> is the administrative contact
"1.pool.ntp.org" ;; for this NTP pool "zone".
"2.pool.ntp.org")) '("0.guix.pool.ntp.org"
"1.guix.pool.ntp.org"
"2.guix.pool.ntp.org"
"3.guix.pool.ntp.org"))
;;; ;;;

View File

@ -28,6 +28,8 @@
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix modules)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (lsh-configuration #:export (lsh-configuration
@ -295,7 +297,11 @@ The other options should be self-descriptive."
(default #t)) (default #t))
;; list of two-element lists ;; list of two-element lists
(subsystems openssh-configuration-subsystems (subsystems openssh-configuration-subsystems
(default '(("sftp" "internal-sftp"))))) (default '(("sftp" "internal-sftp"))))
;; list of user-name/file-like tuples
(authorized-keys openssh-authorized-keys
(default '())))
(define %openssh-accounts (define %openssh-accounts
(list (user-group (name "sshd") (system? #t)) (list (user-group (name "sshd") (system? #t))
@ -309,14 +315,33 @@ The other options should be self-descriptive."
(define (openssh-activation config) (define (openssh-activation config)
"Return the activation GEXP for CONFIG." "Return the activation GEXP for CONFIG."
(with-imported-modules '((guix build utils))
#~(begin #~(begin
(use-modules (guix build utils)) (use-modules (guix build utils))
(mkdir-p "/etc/ssh")
(mkdir-p (dirname #$(openssh-configuration-pid-file config)))
(define (touch file-name) (define (touch file-name)
(call-with-output-file file-name (const #t))) (call-with-output-file file-name (const #t)))
;; Make sure /etc/ssh can be read by the 'sshd' user.
(mkdir-p "/etc/ssh")
(chmod "/etc/ssh" #o755)
(mkdir-p (dirname #$(openssh-configuration-pid-file config)))
;; 'sshd' complains if the authorized-key directory and its parents
;; are group-writable, which rules out /gnu/store. Thus we copy the
;; authorized-key directory to /etc.
(catch 'system-error
(lambda ()
(delete-file-recursively "/etc/authorized_keys.d"))
(lambda args
(unless (= ENOENT (system-error-errno args))
(apply throw args))))
(copy-recursively #$(authorized-key-directory
(openssh-authorized-keys config))
"/etc/ssh/authorized_keys.d")
(chmod "/etc/ssh/authorized_keys.d" #o555)
(let ((lastlog "/var/log/lastlog")) (let ((lastlog "/var/log/lastlog"))
(when #$(openssh-configuration-print-last-log? config) (when #$(openssh-configuration-print-last-log? config)
(unless (file-exists? lastlog) (unless (file-exists? lastlog)
@ -324,7 +349,30 @@ The other options should be self-descriptive."
;; Generate missing host keys. ;; Generate missing host keys.
(system* (string-append #$(openssh-configuration-openssh config) (system* (string-append #$(openssh-configuration-openssh config)
"/bin/ssh-keygen") "-A"))) "/bin/ssh-keygen") "-A"))))
(define (authorized-key-directory keys)
"Return a directory containing the authorized keys specified in KEYS, a list
of user-name/file-like tuples."
(define build
(with-imported-modules (source-module-closure '((guix build utils)))
#~(begin
(use-modules (ice-9 match) (srfi srfi-26)
(guix build utils))
(mkdir #$output)
(for-each (match-lambda
((user keys ...)
(let ((file (string-append #$output "/" user)))
(call-with-output-file file
(lambda (port)
(for-each (lambda (key)
(call-with-input-file key
(cut dump-port <> port)))
keys))))))
'#$keys))))
(computed-file "openssh-authorized-keys" build))
(define (openssh-config-file config) (define (openssh-config-file config)
"Return the sshd configuration file corresponding to CONFIG." "Return the sshd configuration file corresponding to CONFIG."
@ -367,6 +415,11 @@ The other options should be self-descriptive."
(format port "PrintLastLog ~a\n" (format port "PrintLastLog ~a\n"
#$(if (openssh-configuration-print-last-log? config) #$(if (openssh-configuration-print-last-log? config)
"yes" "no")) "yes" "no"))
;; Add '/etc/authorized_keys.d/%u', which we populate.
(format port "AuthorizedKeysFile \
.ssh/authorized_keys .ssh/authorized_keys2 /etc/ssh/authorized_keys.d/%u\n")
(for-each (for-each
(match-lambda (match-lambda
((name command) (format port "Subsystem\t~a\t~a\n" name command))) ((name command) (format port "Subsystem\t~a\t~a\n" name command)))
@ -398,6 +451,13 @@ The other options should be self-descriptive."
#:allow-empty-passwords? #:allow-empty-passwords?
(openssh-configuration-allow-empty-passwords? config)))) (openssh-configuration-allow-empty-passwords? config))))
(define (extend-openssh-authorized-keys config keys)
"Extend CONFIG with the extra authorized keys listed in KEYS."
(openssh-configuration
(inherit config)
(authorized-keys
(append (openssh-authorized-keys config) keys))))
(define openssh-service-type (define openssh-service-type
(service-type (name 'openssh) (service-type (name 'openssh)
(extensions (extensions
@ -409,6 +469,8 @@ The other options should be self-descriptive."
openssh-activation) openssh-activation)
(service-extension account-service-type (service-extension account-service-type
(const %openssh-accounts)))) (const %openssh-accounts))))
(compose concatenate)
(extend extend-openssh-authorized-keys)
(default-value (openssh-configuration)))) (default-value (openssh-configuration))))

View File

@ -112,7 +112,7 @@
boot-parameters-initrd boot-parameters-initrd
read-boot-parameters read-boot-parameters
read-boot-parameters-file read-boot-parameters-file
menu-entry->boot-parameters boot-parameters->menu-entry
local-host-aliases local-host-aliases
%setuid-programs %setuid-programs
@ -301,17 +301,15 @@ The object has its kernel-arguments extended in order to make it bootable."
root-device))) root-device)))
#f))) #f)))
(define (menu-entry->boot-parameters menu-entry) (define (boot-parameters->menu-entry conf)
"Convert a <menu-entry> instance to a corresponding <boot-parameters>." (menu-entry
(boot-parameters (label (boot-parameters-label conf))
(label (menu-entry-label menu-entry)) (device (boot-parameters-store-device conf))
(root-device #f) (device-mount-point (boot-parameters-store-mount-point conf))
(bootloader-name 'custom) (linux (boot-parameters-kernel conf))
(store-device #f) (linux-arguments (boot-parameters-kernel-arguments conf))
(store-mount-point #f) (initrd (boot-parameters-initrd conf))))
(kernel (menu-entry-linux menu-entry))
(kernel-arguments (menu-entry-linux-arguments menu-entry))
(initrd (menu-entry-initrd menu-entry))))
;;; ;;;
@ -872,15 +870,16 @@ listed in OS. The C library expects to find it under
(store-file-system (operating-system-file-systems os))) (store-file-system (operating-system-file-systems os)))
(define* (operating-system-bootcfg os #:optional (old-entries '())) (define* (operating-system-bootcfg os #:optional (old-entries '()))
"Return the bootloader configuration file for OS. Use OLD-ENTRIES to "Return the bootloader configuration file for OS. Use OLD-ENTRIES
populate the \"old entries\" menu." (which is a list of <menu-entry>) to populate the \"old entries\" menu."
(mlet* %store-monad (mlet* %store-monad
((system (operating-system-derivation os)) ((system (operating-system-derivation os))
(root-fs -> (operating-system-root-file-system os)) (root-fs -> (operating-system-root-file-system os))
(root-device -> (if (eq? 'uuid (file-system-title root-fs)) (root-device -> (if (eq? 'uuid (file-system-title root-fs))
(uuid->string (file-system-device root-fs)) (uuid->string (file-system-device root-fs))
(file-system-device root-fs))) (file-system-device root-fs)))
(entry (operating-system-boot-parameters os system root-device)) (params (operating-system-boot-parameters os system root-device))
(entry -> (boot-parameters->menu-entry params))
(bootloader-conf -> (operating-system-bootloader os))) (bootloader-conf -> (operating-system-bootloader os)))
((bootloader-configuration-file-generator ((bootloader-configuration-file-generator
(bootloader-configuration-bootloader bootloader-conf)) (bootloader-configuration-bootloader bootloader-conf))

128
gnu/tests/admin.scm 100644
View File

@ -0,0 +1,128 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Christopher Baines <mail@cbaines.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 tests admin)
#:use-module (gnu tests)
#:use-module (gnu system)
#:use-module (gnu system file-systems)
#:use-module (gnu system shadow)
#:use-module (gnu system vm)
#:use-module (gnu services)
#:use-module (gnu services admin)
#:use-module (gnu services networking)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:export (%test-tailon))
(define %tailon-os
;; Operating system under test.
(simple-operating-system
(dhcp-client-service)
(service tailon-service-type
(tailon-configuration
(config-file
(tailon-configuration-file
(bind "0.0.0.0:8080")))))))
(define* (run-tailon-test #:optional (http-port 8081))
"Run tests in %TAILON-OS, which has tailon running and listening on
HTTP-PORT."
(define os
(marionette-operating-system
%tailon-os
#:imported-modules '((gnu services herd)
(guix combinators))))
(define vm
(virtual-machine
(operating-system os)
(port-forwardings `((,http-port . 8080)))))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (srfi srfi-11) (srfi srfi-64)
(ice-9 match)
(gnu build marionette)
(web uri)
(web client)
(web response))
(define marionette
;; Forward the guest's HTTP-PORT, where tailon is listening, to
;; port 8080 in the host.
(make-marionette (list #$vm)))
(mkdir #$output)
(chdir #$output)
(test-begin "tailon")
(test-eq "service running"
'running!
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'tailon)
'running!)
marionette))
(define* (retry-on-error f #:key times delay)
(let loop ((attempt 1))
(match (catch
#t
(lambda ()
(cons #t
(f)))
(lambda args
(cons #f
args)))
((#t . return-value)
return-value)
((#f . error-args)
(if (>= attempt times)
error-args
(begin
(sleep delay)
(loop (+ 1 attempt))))))))
(test-equal "http-get"
200
(retry-on-error
(lambda ()
(let-values (((response text)
(http-get #$(format
#f
"http://localhost:~A/"
http-port)
#:decode-body? #t)))
(response-code response)))
#:times 10
#:delay 5))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "tailon-test" test))
(define %test-tailon
(system-test
(name "tailon")
(description "Connect to a running Tailon server.")
(value (run-tailon-test))))

View File

@ -0,0 +1,121 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Christopher Baines <mail@cbaines.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 tests databases)
#:use-module (gnu tests)
#:use-module (gnu system)
#:use-module (gnu system file-systems)
#:use-module (gnu system shadow)
#:use-module (gnu system vm)
#:use-module (gnu services)
#:use-module (gnu services databases)
#:use-module (gnu services networking)
#:use-module (guix gexp)
#:use-module (guix store)
#:export (%test-memcached))
(define %memcached-os
(simple-operating-system
(dhcp-client-service)
(service memcached-service-type)))
(define* (run-memcached-test #:optional (port 11211))
"Run tests in %MEMCACHED-OS, forwarding PORT."
(define os
(marionette-operating-system
%memcached-os
#:imported-modules '((gnu services herd)
(guix combinators))))
(define vm
(virtual-machine
(operating-system os)
(port-forwardings `((11211 . ,port)))))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (srfi srfi-11) (srfi srfi-64)
(gnu build marionette)
(ice-9 rdelim))
(define marionette
(make-marionette (list #$vm)))
(mkdir #$output)
(chdir #$output)
(test-begin "memcached")
;; Wait for memcached to be up and running.
(test-eq "service running"
'running!
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'memcached)
'running!)
marionette))
(let* ((ai (car (getaddrinfo "localhost"
#$(number->string port))))
(s (socket (addrinfo:fam ai)
(addrinfo:socktype ai)
(addrinfo:protocol ai)))
(key "testkey")
(value "guix"))
(connect s (addrinfo:addr ai))
(test-equal "set"
"STORED\r"
(begin
(simple-format s "set ~A 0 60 ~A\r\n~A\r\n"
key
(string-length value)
value)
(read-line s)))
(test-equal "get"
(simple-format #f "VALUE ~A 0 ~A\r~A\r"
key
(string-length value)
value)
(begin
(simple-format s "get ~A\r\n" key)
(string-append
(read-line s)
(read-line s))))
(close-port s))
;; There should be a log file in here.
(test-assert "log file"
(marionette-eval
'(file-exists? "/var/log/memcached")
marionette))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "memcached-test" test))
(define %test-memcached
(system-test
(name "memcached")
(description "Connect to a running MEMCACHED server.")
(value (run-memcached-test))))

View File

@ -191,7 +191,12 @@ absolute file name and STAT is the result of 'lstat'."
result))) result)))
vlist-null vlist-null
files)) files))
(prefix-length (+ 1 (string-length (canonicalize-path directory))))
;; Note: For this to work we must *not* call 'canonicalize-path' on
;; DIRECTORY or we would get discrepancies of the returned lambda is
;; called with a non-canonical file name.
(prefix-length (+ 1 (string-length directory)))
(status (close-pipe pipe))) (status (close-pipe pipe)))
(and (zero? status) (and (zero? status)
(lambda (file stat) (lambda (file stat)

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Roel Janssen <roel@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -22,6 +23,7 @@
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix sets) #:use-module (guix sets)
#:use-module (guix packages)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
@ -170,9 +172,9 @@ typically returned by 'node-edges' or 'node-back-edges'."
name)) name))
(define (emit-epilogue port) (define (emit-epilogue port)
(display "\n}\n" port)) (display "\n}\n" port))
(define (emit-node id label port) (define (emit-node id node port)
(format port " \"~a\" [label = \"~a\", shape = box, fontname = Helvetica];~%" (format port " \"~a\" [label = \"~a\", shape = box, fontname = Helvetica];~%"
id label)) id (package-full-name node)))
(define (emit-edge id1 id2 port) (define (emit-edge id1 id2 port)
(format port " \"~a\" -> \"~a\" [color = ~a];~%" (format port " \"~a\" -> \"~a\" [color = ~a];~%"
id1 id2 (pop-color id1))) id1 id2 (pop-color id1)))
@ -213,11 +215,11 @@ var nodes = {},
(format port "</script><script type=\"text/javascript\" src=\"~a\"></script></body></html>" (format port "</script><script type=\"text/javascript\" src=\"~a\"></script></body></html>"
(search-path %load-path "graph.js"))) (search-path %load-path "graph.js")))
(define (emit-d3js-node id label port) (define (emit-d3js-node id node port)
(format port "\ (format port "\
nodes[\"~a\"] = {\"id\": \"~a\", \"label\": \"~a\", \"index\": nodeArray.length}; nodes[\"~a\"] = {\"id\": \"~a\", \"label\": \"~a\", \"index\": nodeArray.length};
nodeArray.push(nodes[\"~a\"]);~%" nodeArray.push(nodes[\"~a\"]);~%"
id id label id)) id id (package-full-name node) id))
(define (emit-d3js-edge id1 id2 port) (define (emit-d3js-edge id1 id2 port)
(format port "links.push({\"source\": \"~a\", \"target\": \"~a\"});~%" (format port "links.push({\"source\": \"~a\", \"target\": \"~a\"});~%"
@ -241,9 +243,9 @@ nodeArray.push(nodes[\"~a\"]);~%"
(define (emit-cypher-epilogue port) (define (emit-cypher-epilogue port)
(format port "")) (format port ""))
(define (emit-cypher-node id label port) (define (emit-cypher-node id node port)
(format port "MERGE (p:Package { id: ~s }) SET p.name = ~s;~%" (format port "MERGE (p:Package { id: ~s }) SET p.name = ~s;~%"
id label )) id (package-name node)))
(define (emit-cypher-edge id1 id2 port) (define (emit-cypher-edge id1 id2 port)
(format port "MERGE (a:Package { id: ~s });~%" id1) (format port "MERGE (a:Package { id: ~s });~%" id1)
@ -296,7 +298,7 @@ true, draw reverse arrows."
(ids (mapm %store-monad (ids (mapm %store-monad
node-identifier node-identifier
dependencies))) dependencies)))
(emit-node id (node-label head) port) (emit-node id head port)
(for-each (lambda (dependency dependency-id) (for-each (lambda (dependency dependency-id)
(if reverse-edges? (if reverse-edges?
(emit-edge dependency-id id port) (emit-edge dependency-id id port)

View File

@ -878,24 +878,39 @@ move to the previous or next line")
#:key (reporters %formatting-reporters)) #:key (reporters %formatting-reporters))
"Report white-space issues in FILE starting from STARTING-LINE, and report "Report white-space issues in FILE starting from STARTING-LINE, and report
them for PACKAGE." them for PACKAGE."
(define last-line (define (sexp-last-line port)
;; Number of the presumed last line. ;; Return the last line of the sexp read from PORT or an estimate thereof.
;; XXX: Ideally we'd stop at the boundaries of the surrounding sexp, but (define &failure (list 'failure))
;; for now just use this simple heuristic.
(+ starting-line 60)) (let ((start (ftell port))
(start-line (port-line port))
(sexp (catch 'read-error
(lambda () (read port))
(const &failure))))
(let ((line (port-line port)))
(seek port start SEEK_SET)
(set-port-line! port start-line)
(if (eq? sexp &failure)
(+ start-line 60) ;conservative estimate
line))))
(call-with-input-file file (call-with-input-file file
(lambda (port) (lambda (port)
(let loop ((line-number 1)) (let loop ((line-number 1)
(last-line #f))
(let ((line (read-line port))) (let ((line (read-line port)))
(or (eof-object? line) (or (eof-object? line)
(> line-number last-line) (and last-line (> line-number last-line))
(if (and (= line-number starting-line)
(not last-line))
(loop (+ 1 line-number)
(+ 1 (sexp-last-line port)))
(begin (begin
(unless (< line-number starting-line) (unless (< line-number starting-line)
(for-each (lambda (report) (for-each (lambda (report)
(report package line line-number)) (report package line line-number))
reporters)) reporters))
(loop (+ 1 line-number))))))))) (loop (+ 1 line-number) last-line)))))))))
(define (check-formatting package) (define (check-formatting package)
"Check the formatting of the source code of PACKAGE." "Check the formatting of the source code of PACKAGE."

View File

@ -486,6 +486,11 @@ Install, remove, or upgrade packages in a single transaction.\n"))
arg-handler)))) arg-handler))))
(option '(#\u "upgrade") #f #t (option '(#\u "upgrade") #f #t
(lambda (opt name arg result arg-handler) (lambda (opt name arg result arg-handler)
(when (and arg (string-prefix? "-" arg))
(warning (G_ "upgrade regexp '~a' looks like a \
command-line option~%")
arg)
(warning (G_ "is this intended?~%")))
(let arg-handler ((arg arg) (result result)) (let arg-handler ((arg arg) (result result))
(values (alist-cons 'upgrade arg (values (alist-cons 'upgrade arg
;; Delete any prior "upgrade all" ;; Delete any prior "upgrade all"

View File

@ -113,7 +113,7 @@
(or (and=> (getenv "XDG_CACHE_HOME") (or (and=> (getenv "XDG_CACHE_HOME")
(cut string-append <> "/guix/substitute")) (cut string-append <> "/guix/substitute"))
(string-append %state-directory "/substitute/cache")) (string-append %state-directory "/substitute/cache"))
(string-append (cache-directory) "/substitute"))) (string-append (cache-directory #:ensure? #f) "/substitute")))
(define %allow-unauthenticated-substitutes? (define %allow-unauthenticated-substitutes?
;; Whether to allow unchecked substitutes. This is useful for testing ;; Whether to allow unchecked substitutes. This is useful for testing

View File

@ -431,8 +431,6 @@ generation as its default entry. STORE is an open connection to the store."
"Re-install bootloader for existing system profile generation NUMBER. "Re-install bootloader for existing system profile generation NUMBER.
STORE is an open connection to the store." STORE is an open connection to the store."
(let* ((generation (generation-file-name %system-profile number)) (let* ((generation (generation-file-name %system-profile number))
(params (unless-file-not-found
(read-boot-parameters-file generation)))
;; Detect the bootloader used in %system-profile. ;; Detect the bootloader used in %system-profile.
(bootloader (lookup-bootloader-by-name (system-bootloader-name))) (bootloader (lookup-bootloader-by-name (system-bootloader-name)))
@ -442,10 +440,12 @@ STORE is an open connection to the store."
(bootloader bootloader))) (bootloader bootloader)))
;; Make the specified system generation the default entry. ;; Make the specified system generation the default entry.
(entries (profile-boot-parameters %system-profile (list number))) (params (profile-boot-parameters %system-profile (list number)))
(old-generations (delv number (generation-numbers %system-profile))) (old-generations (delv number (generation-numbers %system-profile)))
(old-entries (profile-boot-parameters (old-params (profile-boot-parameters
%system-profile old-generations))) %system-profile old-generations))
(entries (map boot-parameters->menu-entry params))
(old-entries (map boot-parameters->menu-entry old-params)))
(run-with-store store (run-with-store store
(mlet* %store-monad (mlet* %store-monad
((bootcfg ((bootloader-configuration-file-generator bootloader) ((bootcfg ((bootloader-configuration-file-generator bootloader)
@ -657,7 +657,8 @@ output when building a system derivation, such as a disk image."
os os
(if (eq? 'init action) (if (eq? 'init action)
'() '()
(profile-boot-parameters))))) (map boot-parameters->menu-entry
(profile-boot-parameters))))))
(bootcfg-file -> (bootloader-configuration-file bootloader)) (bootcfg-file -> (bootloader-configuration-file bootloader))
(bootloader-installer (bootloader-installer
(let ((installer (bootloader-installer bootloader)) (let ((installer (bootloader-installer bootloader))

View File

@ -36,7 +36,6 @@
#:use-module (guix combinators) #:use-module (guix combinators)
#:use-module (guix build-system) #:use-module (guix build-system)
#:use-module (guix serialization) #:use-module (guix serialization)
#:use-module ((guix build utils) #:select (mkdir-p))
#:use-module ((guix licenses) #:select (license? license-name)) #:use-module ((guix licenses) #:select (license? license-name))
#:use-module ((guix build syscalls) #:use-module ((guix build syscalls)
#:select (free-disk-space terminal-columns)) #:select (free-disk-space terminal-columns))
@ -79,7 +78,6 @@
read/eval read/eval
read/eval-package-expression read/eval-package-expression
location->string location->string
config-directory
fill-paragraph fill-paragraph
texi->plain-text texi->plain-text
package-description-string package-description-string
@ -856,25 +854,6 @@ replacement if PORT is not Unicode-capable."
(($ <location> file line column) (($ <location> file line column)
(format #f "~a:~a:~a" file line column)))) (format #f "~a:~a:~a" file line column))))
(define* (config-directory #:key (ensure? #t))
"Return the name of the configuration directory, after making sure that it
exists if ENSURE? is true. Honor the XDG specs,
<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
(let ((dir (and=> (or (getenv "XDG_CONFIG_HOME")
(and=> (getenv "HOME")
(cut string-append <> "/.config")))
(cut string-append <> "/guix"))))
(catch 'system-error
(lambda ()
(when ensure?
(mkdir-p dir))
dir)
(lambda args
(let ((err (system-error-errno args)))
;; ERR is necessarily different from EEXIST.
(leave (G_ "failed to create configuration directory `~a': ~a~%")
dir (strerror err)))))))
(define* (fill-paragraph str width #:optional (column 0)) (define* (fill-paragraph str width #:optional (column 0))
"Fill STR such that each line contains at most WIDTH characters, assuming "Fill STR such that each line contains at most WIDTH characters, assuming
that the first character is at COLUMN. that the first character is at COLUMN.

View File

@ -33,7 +33,7 @@
#:autoload (rnrs io ports) (make-custom-binary-input-port) #:autoload (rnrs io ports) (make-custom-binary-input-port)
#:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!)) #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module ((guix build utils) #:select (dump-port)) #:use-module ((guix build utils) #:select (dump-port mkdir-p))
#:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync)) #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:autoload (ice-9 popen) (open-pipe*) #:autoload (ice-9 popen) (open-pipe*)
@ -81,7 +81,10 @@
call-with-temporary-output-file call-with-temporary-output-file
call-with-temporary-directory call-with-temporary-directory
with-atomic-file-output with-atomic-file-output
config-directory
cache-directory cache-directory
readlink* readlink*
edit-expression edit-expression
@ -598,13 +601,26 @@ output port, and PROC's result is returned."
(false-if-exception (delete-file template)) (false-if-exception (delete-file template))
(close-port out))))) (close-port out)))))
(define (cache-directory) (define* (xdg-directory variable suffix #:key (ensure? #t))
"Return the cache directory for Guix, by default ~/.cache/guix." "Return the name of the XDG directory that matches VARIABLE and SUFFIX,
(string-append (or (getenv "XDG_CACHE_HOME") after making sure that it exists if ENSURE? is true. VARIABLE is an
environment variable name like \"XDG_CONFIG_HOME\"; SUFFIX is a suffix like
\"/.config\". Honor the XDG specs,
<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
(let ((dir (and=> (or (getenv variable)
(and=> (or (getenv "HOME") (and=> (or (getenv "HOME")
(passwd:dir (getpwuid (getuid)))) (passwd:dir (getpwuid (getuid))))
(cut string-append <> "/.cache"))) (cut string-append <> suffix)))
"/guix")) (cut string-append <> "/guix"))))
(when ensure?
(mkdir-p dir))
dir))
(define config-directory
(cut xdg-directory "XDG_CONFIG_HOME" "/.config" <...>))
(define cache-directory
(cut xdg-directory "XDG_CACHE_HOME" "/.cache" <...>))
(define (readlink* file) (define (readlink* file)
"Call 'readlink' until the result is not a symlink." "Call 'readlink' until the result is not a symlink."