guix/guix
3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

Merge branch 'master' into gnome-updates

Browse source
This commit is contained in:
Mark H Weaver 2017-01-14 05:24:09 -05:00
commit 5827ea30ee
No known key found for this signature in database
GPG key ID: 7CEF29847562C516
38 changed files with 1541 additions and 304 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -128,3 +128,4 @@ stamp-h[0-9]
tmp
/doc/os-config-lightweight-desktop.texi
/nix/scripts/download
/etc/indent-code.el

5
configure.ac
View file

@ -232,6 +232,10 @@ AM_MISSING_PROG([DOT], [dot])
dnl Manual pages.
AM_MISSING_PROG([HELP2MAN], [help2man])
dnl Emacs (optional), for 'etc/indent-package.el'.
AC_PATH_PROG([EMACS], [emacs], [/usr/bin/emacs])
AC_SUBST([EMACS])
AC_CONFIG_FILES([Makefile
po/guix/Makefile.in
po/packages/Makefile.in
@ -241,5 +245,6 @@ AC_CONFIG_FILES([scripts/guix], [chmod +x scripts/guix])
AC_CONFIG_FILES([test-env:build-aux/test-env.in], [chmod +x test-env])
AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in],
[chmod +x pre-inst-env])
AC_CONFIG_FILES([etc/indent-code.el], [chmod +x etc/indent-code.el])
AC_OUTPUT

28
doc/contributing.texi
View file

@ -237,6 +237,8 @@ especially when matching lists.
@node Formatting Code
@subsection Formatting Code
@cindex formatting code
@cindex coding style
When writing Scheme code, we follow common wisdom among Scheme
programmers. In general, we follow the
@url{http://mumble.net/~campbell/scheme/style.txt, Riastradh's Lisp
@ -246,8 +248,25 @@ please do read it.
Some special forms introduced in Guix, such as the @code{substitute*}
macro, have special indentation rules. These are defined in the
@file{.dir-locals.el} file, which Emacs automatically uses. If you do
not use Emacs, please make sure to let your editor know the rules.
@file{.dir-locals.el} file, which Emacs automatically uses.
@cindex indentation, of code
@cindex formatting, of code
If you do not use Emacs, please make sure to let your editor knows these
rules. To automatically indent a package definition, you can also run:
@example
./etc/indent-code.el gnu/packages/@var{file}.scm @var{package}
@end example
@noindent
This automatically indents the definition of @var{package} in
@file{gnu/packages/@var{file}.scm} by running Emacs in batch mode. To
indent a whole file, omit the second argument:
@example
./etc/indent-code.el gnu/services/@var{file}.scm
@end example
We require all top-level procedures to carry a docstring. This
requirement can be relaxed for simple private procedures in the
@ -358,6 +377,11 @@ Bundling unrelated changes together makes reviewing harder and slower.
Examples of unrelated changes include the addition of several packages,
or a package update along with fixes to that package.
@item
Please follow our code formatting rules, possibly running the
@command{etc/indent-code.el} script to do that automatically for you
(@pxref{Formatting Code}).
@end enumerate
When posting a patch to the mailing list, use @samp{[PATCH] @dots{}} as

29
doc/guix.texi
View file

@ -6412,6 +6412,11 @@ The one option that matters is:
Consider @var{urls} the whitespace-separated list of substitute source
URLs to compare to.
@item --verbose
@itemx -v
Show details about matches (identical contents) in addition to
information about mismatches.
@end table
@node Invoking guix copy
@ -10331,6 +10336,30 @@ TCP port on which the database server listens for incoming connections.
@end table
@end deftp
@defvr {Scheme Variable} redis-service-type
This is the service type for the @uref{https://redis.io/, Redis}
key/value store, whose value is a @code{redis-configuration} object.
@end defvr
@deftp {Data Type} redis-configuration
Data type representing the configuration of redis.
@table @asis
@item @code{redis} (default: @code{redis})
The Redis package to use.
@item @code{bind} (default: @code{"127.0.0.1"})
Network interface on which to listen.
@item @code{port} (default: @code{6379})
Port on which to accept connections on, a value of 0 will disable
listining on a TCP socket.
@item @code{working-directory} (default: @code{"/var/lib/redis"})
Directory in which to store the database and related files.
@end table
@end deftp
@node Mail Services
@subsubsection Mail Services

3
doc/local.mk
View file

@ -1,6 +1,6 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2016 Eric Bavier <bavier@member.fsf.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 © 2013 Andreas Enge <andreas@enge.fr>
# Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
# Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
@ -37,7 +37,6 @@ DOT_VECTOR_GRAPHICS = \
EXTRA_DIST += \
%D%/htmlxref.cnf \
%D%/contributing.texi \
%D%/emacs.texi \
%D%/fdl-1.3.texi \
$(DOT_FILES) \
$(DOT_VECTOR_GRAPHICS) \

62
etc/indent-code.el.in Executable file
View file

@ -0,0 +1,62 @@
#!@EMACS@ --script
;;; indent-code.el --- Run Emacs to indent a package definition.
;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;; This file is part of GNU Guix.
;; GNU Guix is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Guix is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This scripts indents the given file or package definition in the specified
;; file using Emacs.
;;; Code:
;; Load Scheme indentation rules from the current directory.
(with-temp-buffer
(scheme-mode)
(let ((default-directory (file-name-as-directory "."))
(enable-local-variables :all))
(hack-dir-local-variables)
(hack-local-variables-apply)))
(pcase command-line-args-left
(`(,file-name ,package-name)
;; Indent the definition of PACKAGE-NAME in FILE-NAME.
(find-file file-name)
(goto-char (point-min))
(if (re-search-forward (concat "^(define\\(-public\\) +"
package-name)
nil t)
(let ((indent-tabs-mode nil))
(beginning-of-defun)
(indent-sexp)
(save-buffer)
(message "Done!"))
(error "Package '%s' not found in '%s'"
package-name file-name)))
(`(,file-name)
;; Indent all of FILE-NAME.
(find-file file-name)
(let ((indent-tabs-mode nil))
(indent-region (point-min) (point-max))
(save-buffer)
(message "Done!")))
(x
(error "Usage: indent-code.el FILE [PACKAGE]")))
;;; indent-code.el ends here

9
gnu/packages/abiword.scm
View file

@ -22,6 +22,7 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system glib-or-gtk)
#:use-module (gnu packages)
#:use-module (gnu packages autotools)
#:use-module (gnu packages boost)
@ -52,11 +53,17 @@
"/source/" name "-" version ".tar.gz"))
(sha256
(base32 "1ik591rx15nn3n1297cwykl8wvrlgj78i528id9wbidgy3xzd570"))
(modules '((guix build utils)))
(snippet
;; Ensure reproducibility.
'(substitute* "src/wp/main/xp/abi_ver.cpp"
(("__DATE__") "\"2017\"")
(("__TIME__") "\"00:00\"")))
(patches
(search-patches "abiword-wmf-version-lookup-fix.patch"
"abiword-explictly-cast-bools.patch"))))
(build-system gnu-build-system)
(build-system glib-or-gtk-build-system)
(arguments ;; NOTE: rsvg is disabled, since Abiword
`(#:configure-flags ;; supports it directly, and its BS is broken.
(list

4
gnu/packages/admin.scm
View file

@ -471,7 +471,7 @@ connection alive.")
(bind-minor-version "9")
(bind-patch-version "9")
(bind-release-type "-P") ; for patch release, use "-P"
(bind-release-version "4") ; for patch release, e.g. "4"
(bind-release-version "5") ; for patch release, e.g. "4"
(bind-version (string-append bind-major-version
"."
bind-minor-version
@ -587,7 +587,7 @@ connection alive.")
"/bind-" bind-version ".tar.gz"))
(sha256
(base32
"1qpi23lrs6jfxqx8dakbqfyg3hvrzq5ldchg6my19xcvx8515mgx"))))
"1yn15chkfqf4d7961ip2x10jm27a9wqymz2xqh0a2g89arrirkaw"))))
;; When cross-compiling, we need the cross Coreutils and sed.
;; Otherwise just use those from %FINAL-INPUTS.

14
gnu/packages/audacity.scm
View file

@ -24,6 +24,7 @@
#:use-module (gnu packages)
#:use-module (gnu packages audio)
#:use-module (gnu packages base)
#:use-module (gnu packages gettext)
#:use-module (gnu packages gtk)
#:use-module (gnu packages linux)
#:use-module (gnu packages mp3)
@ -38,20 +39,20 @@
(define-public audacity
(package
(name "audacity")
(version "2.1.0")
(version "2.1.2")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/audacity/audacity/" version
"/audacity-minsrc-" version ".tar.xz"))
(uri (string-append "https://github.com/audacity/audacity/archive"
"/Audacity-" version ".zip"))
(sha256
(base32 "1cs2w3fwqylpqmfwkvlgdx5lhclpckfil7pqibl37qlbnf4qvndh"))
(base32 "1642i9d5cdmqzj6r0qdl2ldnqsvpb08znnczncysi72x6zpvb5qq"))
(patches (search-patches "audacity-fix-ffmpeg-binding.patch"))))
(build-system gnu-build-system)
(inputs
;; TODO: Add portSMF and libwidgetextra once they're packaged. In-tree
;; versions shipping with Audacity are used for now.
`(("wxwidgets" ,wxwidgets-2)
`(("wxwidgets" ,wxwidgets-gtk2)
("gtk" ,gtk+-2)
("alsa-lib" ,alsa-lib)
("jack" ,jack-1)
@ -72,7 +73,8 @@
("lilv" ,lilv)
("portaudio" ,portaudio)))
(native-inputs
`(("pkg-config" ,pkg-config)
`(("gettext" ,gettext-minimal) ;for msgfmt
("pkg-config" ,pkg-config)
("python" ,python-2)
("which" ,which)))
(arguments

61
gnu/packages/bioinformatics.scm
View file

@ -7100,6 +7100,41 @@ musculus (Mouse) as provided by UCSC (mm10, December 2011) and stored
in Biostrings objects.")
(license license:artistic2.0)))
(define-public r-txdb-mmusculus-ucsc-mm10-knowngene
(package
(name "r-txdb-mmusculus-ucsc-mm10-knowngene")
(version "3.4.0")
(source (origin
(method url-fetch)
;; We cannot use bioconductor-uri here because this tarball is
;; located under "data/annotation/" instead of "bioc/".
(uri (string-append "http://www.bioconductor.org/packages/"
"release/data/annotation/src/contrib/"
"TxDb.Mmusculus.UCSC.mm10.knownGene_"
version ".tar.gz"))
(sha256
(base32
"08gava9wsvpcqz51k2sni3pj03n5155v32d9riqbf305nbirqbkb"))))
(properties
`((upstream-name . "TxDb.Mmusculus.UCSC.mm10.knownGene")))
(build-system r-build-system)
;; As this package provides little more than a very large data file it
;; doesn't make sense to build substitutes.
(arguments `(#:substitutable? #f))
(propagated-inputs
`(("r-bsgenome" ,r-bsgenome)
("r-genomicfeatures" ,r-genomicfeatures)
("r-annotationdbi" ,r-annotationdbi)))
(home-page
"http://bioconductor.org/packages/TxDb.Mmusculus.UCSC.mm10.knownGene/")
(synopsis "Annotation package for TxDb knownGene object(s) for Mouse")
(description
"This package loads a TxDb object, which is an R interface to
prefabricated databases contained in this package. This package provides
the TxDb object of Mouse data as provided by UCSC (mm10, December 2011)
based on the knownGene track.")
(license license:artistic2.0)))
(define-public r-bsgenome-celegans-ucsc-ce6
(package
(name "r-bsgenome-celegans-ucsc-ce6")
@ -7960,3 +7995,29 @@ immunoprecipitation and target enrichment on small gene panels. Thereby,
CopywriteR constitutes a widely applicable alternative to available copy
number detection tools.")
(license license:gpl2)))
(define-public r-sva
(package
(name "r-sva")
(version "3.22.0")
(source
(origin
(method url-fetch)
(uri (bioconductor-uri "sva" version))
(sha256
(base32
"1wc1fjm6dzlsqqagm43y57w8jh8nsh0r0m8z1p6ximcb5gxqh7hn"))))
(build-system r-build-system)
(propagated-inputs
`(("r-genefilter" ,r-genefilter)))
(home-page "http://bioconductor.org/packages/sva")
(synopsis "Surrogate variable analysis")
(description
"This package contains functions for removing batch effects and other
unwanted variation in high-throughput experiment. It also contains functions
for identifying and building surrogate variables for high-dimensional data
sets. Surrogate variables are covariates constructed directly from
high-dimensional data like gene expression/RNA sequencing/methylation/brain
imaging data that can be used in subsequent analyses to adjust for unknown,
unmodeled, or latent sources of noise.")
(license license:artistic2.0)))

4
gnu/packages/dns.scm
View file

@ -76,7 +76,7 @@ and BOOTP/TFTP for network booting of diskless machines.")
(define-public bind
(package
(name "bind")
(version "9.10.4-P4")
(version "9.10.4-P5")
(source (origin
(method url-fetch)
(uri (string-append
@ -84,7 +84,7 @@ and BOOTP/TFTP for network booting of diskless machines.")
version ".tar.gz"))
(sha256
(base32
"11lxkb7d79c75scrs28q4xmr0ii2li69zj1c650al3qxir8yf754"))))
"1sqg7wg05h66vdjc8j215r04f8pg7lphkb93nsqxvzhk6r0ppi49"))))
(build-system gnu-build-system)
(outputs `("out" "utils"))
(inputs

12
gnu/packages/freedesktop.scm
View file

@ -854,6 +854,18 @@ software.")
(base32
"05915i0bv7q62fqrs5diqwr8dz3pwqa1c1ivcgggkjyw0xk4ldp5"))))
(build-system gnu-build-system)
(arguments
'(#:phases (modify-phases %standard-phases
(add-before 'build 'set-sysconfdir
(lambda* (#:key outputs #:allow-other-keys)
;; Work around a bug whereby the 'SYSCONFDIR' macro
;; expands literally to '${prefix}/etc'.
(let ((out (assoc-ref outputs "out")))
(substitute* "src/main.c"
(("SYSCONFDIR, \"fprintd.conf\"")
(string-append "\"" out "/etc\", "
"\"fprintd.conf\"")))
#t))))))
(native-inputs
`(("pkg-config" ,pkg-config)
("intltool" ,intltool)))

3
gnu/packages/gimp.scm
View file

@ -38,8 +38,7 @@
#:use-module (gnu packages pdf)
#:use-module (gnu packages photo)
#:use-module (gnu packages python)
#:use-module (gnu packages xorg)
#:use-module (gnu packages imagemagick))
#:use-module (gnu packages xorg))
(define-public babl
(package

2
gnu/packages/gnucash.scm
View file

@ -165,7 +165,7 @@ applications and libraries. It is used by AqBanking.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1x0isvpk43rq2zlyyb9p0kgjmqv7yq07vgkiprw3f5sjkykvxw6d"))))
"08jbwmiv6f3v8iqdr44x4szna496fqcjfi6mlx04cnbx91m70lh6"))))
(build-system gnu-build-system)
(arguments
`(;; Parallel building fails because aqhbci is required before it's

37
gnu/packages/haskell.scm
View file

@ -3052,7 +3052,7 @@ use HUnit assertions as QuickCheck properties.")
(define-public ghc-quickcheck
(package
(name "ghc-quickcheck")
(version "2.8.1")
(version "2.8.2")
(outputs '("out" "doc"))
(source
(origin
@ -3063,7 +3063,7 @@ use HUnit assertions as QuickCheck properties.")
".tar.gz"))
(sha256
(base32
"0fvnfl30fxmj5q920l13641ar896d53z0z6z66m7c1366lvalwvh"))))
"1ai6k5v0bibaxq8xffcblc6rwmmk6gf8vjyd9p2h3y6vwbhlvilq"))))
(build-system haskell-build-system)
(arguments
`(#:tests? #f ; FIXME: currently missing libraries used for tests.
@ -4573,7 +4573,7 @@ just a @code{Semigroup} are added.")
(define-public ghc-semigroups
(package
(name "ghc-semigroups")
(version "0.17.0.1")
(version "0.18.2")
(source
(origin
(method url-fetch)
@ -4583,7 +4583,7 @@ just a @code{Semigroup} are added.")
".tar.gz"))
(sha256
(base32
"0gvpfi7s6ys4qha3y9a1zl1a15gf9cgg33wjb94ghg82ivcxnc3r"))))
"1r6hsn3am3dpf4rprrj4m04d9318v9iq02bin0pl29dg4a3gzjax"))))
(build-system haskell-build-system)
(inputs
`(("ghc-nats" ,ghc-nats)
@ -8133,4 +8133,33 @@ Rust syntax. It is intended to be useful for two different purposes:
@end enumerate\n")
(license license:gpl2+))))
(define-public ghc-wave
(package
(name "ghc-wave")
(version "0.1.4")
(source (origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/wave/wave-"
version
".tar.gz"))
(sha256
(base32
"1g5nmqfk6p25v9ismwz4i66ay91bd1qh39xwj0hm4z6a5mw8frk8"))))
(build-system haskell-build-system)
(inputs
`(("ghc-cereal" ,ghc-cereal)
("ghc-data-default-class"
,ghc-data-default-class)
("ghc-quickcheck" ,ghc-quickcheck)
("ghc-temporary" ,ghc-temporary)))
(native-inputs
`(("hspec-discover" ,hspec-discover)
("ghc-hspec" ,ghc-hspec)))
(home-page "https://github.com/mrkkrp/wave")
(synopsis "Work with WAVE and RF64 files in Haskell")
(description "This package allows you to work with WAVE and RF64
files in Haskell.")
(license license:bsd-3)))
;;; haskell.scm ends here

35
gnu/packages/linux.scm
View file

@ -7,7 +7,7 @@
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015, 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2016, 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Raymond Nicholson <rain1@openmailbox.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
@ -333,14 +333,14 @@ It has been modified to remove all non-free binary blobs.")
(define %intel-compatible-systems '("x86_64-linux" "i686-linux"))
(define-public linux-libre
(make-linux-libre "4.9.2"
"08gd5ja5gdhzpwzbjhipwmh4myp0hj13k1wsl1xvplszh3p9b076"
(make-linux-libre "4.9.3"
"1jd2rz58lcha9ac35glr26lc6hfi49fvpiwshgpd6ygf4irrs82w"
%intel-compatible-systems
#:configuration-file kernel-config))
(define-public linux-libre-4.4
(make-linux-libre "4.4.41"
"1kl1m0riq90xldcf7lvjzdyz57w1wmnm93j0r0v8xz7n66m5nkp8"
(make-linux-libre "4.4.42"
"1jd43yvycizgqdmwp9rpj7gpjy37mah8jlqaiskjb0hivyk495yz"
%intel-compatible-systems
#:configuration-file kernel-config))
@ -351,8 +351,8 @@ It has been modified to remove all non-free binary blobs.")
#:configuration-file kernel-config))
;; Avoid rebuilding kernel variants when there is a minor version bump.
(define %linux-libre-version "4.9.2")
(define %linux-libre-hash "08gd5ja5gdhzpwzbjhipwmh4myp0hj13k1wsl1xvplszh3p9b076")
(define %linux-libre-version "4.9.3")
(define %linux-libre-hash "1jd2rz58lcha9ac35glr26lc6hfi49fvpiwshgpd6ygf4irrs82w")
(define-public linux-libre-arm-generic
(make-linux-libre %linux-libre-version
@ -597,7 +597,7 @@ slabtop, and skill.")
(build-system gnu-build-system)
(inputs
`(("libusb" ,libusb)
("eudev" ,eudev)))
("eudev" ,eudev-with-hwdb)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "http://www.linux-usb.org/")
@ -1740,6 +1740,21 @@ device nodes from /dev/, handles hotplug events and loads drivers at boot
time.")
(license license:gpl2+)))
(define-public eudev-with-hwdb
;; TODO: Merge with 'eudev'.
(package
(inherit eudev)
(name "eudev-with-hwdb")
(arguments
'(#:phases (modify-phases %standard-phases
(add-after 'install 'build-hwdb
(lambda* (#:key outputs #:allow-other-keys)
;; Build OUT/etc/udev/hwdb.bin. This allows 'lsusb' and
;; similar tools to display product names.
(let ((out (assoc-ref outputs "out")))
(zero? (system* (string-append out "/bin/udevadm")
"hwdb" "--update"))))))))))
(define-public lvm2
(package
(name "lvm2")
@ -3101,14 +3116,14 @@ the default @code{nsswitch} and the experimental @code{umich_ldap}.")
(define-public mcelog
(package
(name "mcelog")
(version "146")
(version "147")
(source (origin
(method url-fetch)
(uri (string-append "https://git.kernel.org/cgit/utils/cpu/mce/"
"mcelog.git/snapshot/v" version ".tar.gz"))
(sha256
(base32
"0jjx4q1mfa380319cqz86nw5wv6jnbpvq2r8n0dyh87mhvrgb4wi"))
"10xxmqpd348ifbs7w8j0m53agp28r6imv237ha3kmhp632hmyf1d"))
(file-name (string-append name "-" version ".tar.gz"))
(modules '((guix build utils)))
(snippet

4
gnu/packages/nano.scm
View file

@ -29,7 +29,7 @@
(define-public nano
(package
(name "nano")
(version "2.7.3")
(version "2.7.4")
(source
(origin
(method url-fetch)
@ -37,7 +37,7 @@
version ".tar.gz"))
(sha256
(base32
"123si2acvfhnl2kip08bqm413yv36zy3pmj75ibkn7q59mcx8x1m"))))
"135wzlv77p9za8679j2jpfkpvainvyagrhkdxngp71ynabgc5zr3"))))
(build-system gnu-build-system)
(inputs
`(("gettext" ,gettext-minimal)

8
gnu/packages/package-management.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
@ -224,9 +224,9 @@ the Nix package manager.")
;;
;; Note: use a very short commit id; with a longer one, the limit on
;; hash-bang lines would be exceeded while running the tests.
(let ((commit "b291b3271a025dfe41e1a7fdfadd393373b0128d"))
(let ((commit "eefd042e60d9fc1d092b44bf80ecbfe65b291e46"))
(package (inherit guix-0.12.0)
(version (string-append "0.12.0-2." (string-take commit 4)))
(version (string-append "0.12.0-3." (string-take commit 4)))
(source (origin
(method git-fetch)
(uri (git-reference
@ -236,7 +236,7 @@ the Nix package manager.")
(commit commit)))
(sha256
(base32
"1hris387xn2wk4lcl20x1zyhiz96060w34xs1x13b4vmvkkvcpg4"))
"1g0042x80q73pb9y39aqbkajl4bacls5c0im9aljmjnsb80fsh8d"))
(file-name (string-append "guix-" version "-checkout"))))
(arguments
(substitute-keyword-arguments (package-arguments guix-0.12.0)

25
gnu/packages/perl.scm
View file

@ -12,6 +12,7 @@
;;; Copyright © 2016 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017 Raoul J.P. Bonnal <ilpuccio.febo@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -5014,6 +5015,30 @@ show those variables which are in scope at the point of the call. PadWalker
is particularly useful for debugging.")
(license (package-license perl))))
(define-public perl-parallel-forkmanager
(package
(name "perl-parallel-forkmanager")
(version "1.19")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://cpan/authors/id/Y/YA/YANICK/Parallel-ForkManager-"
version
".tar.gz"))
(sha256
(base32
"0wm4wp6p3ah5z212jl12728z68nmxmfr0f03z1jpvdzffnc2xppi"))))
(build-system perl-build-system)
(native-inputs
`(("perl-test-warn" ,perl-test-warn)))
(home-page "http://search.cpan.org/dist/Parallel-ForkManager")
(synopsis "Simple parallel processing fork manager")
(description "@code{Parallel::ForkManager} is intended for use in
operations that can be done in parallel where the number of
processes to be forked off should be limited.")
(license (package-license perl))))
(define-public perl-params-util
(package
(name "perl-params-util")

46
gnu/packages/python.scm
View file

@ -1321,7 +1321,7 @@ Python 3.3+.")
(arguments `(#:python ,python-2
#:tests? #f)) ; invalid command "test"
(home-page "https://fedorahosted.org/dogtail/")
(synopsis "GUI test tool and automation framework written in ​Python")
(synopsis "GUI test tool and automation framework written in Python")
(description
"Dogtail is a GUI test tool and automation framework written in Python.
It uses Accessibility (a11y) technologies to communicate with desktop
@ -12331,3 +12331,47 @@ possible on all supported Python versions.")
(define-public python2-xopen
(package-with-python2 python-xopen))
(define-public python2-cheetah
(package
(name "python2-cheetah")
(version "2.4.4")
(source
(origin
(method url-fetch)
(uri (pypi-uri "Cheetah" version))
(sha256
(base32
"0l5mm4lnysjkzpjr95q5ydm9xc8bv43fxmr79ypybrf1y0lq4c5y"))))
(build-system python-build-system)
(arguments
`(#:python ,python-2))
(propagated-inputs
`(("python2-markdown" ,python2-markdown)))
(home-page "https://pythonhosted.org/Cheetah/")
(synopsis "Template engine")
(description "Cheetah is a text-based template engine and Python code
generator.
Cheetah can be used as a standalone templating utility or referenced as
a library from other Python applications. It has many potential uses,
but web developers looking for a viable alternative to ASP, JSP, PHP and
PSP are expected to be its principle user group.
Features:
@enumerate
@item Generates HTML, SGML, XML, SQL, Postscript, form email, LaTeX, or any other
text-based format.
@item Cleanly separates content, graphic design, and program code.
@item Blends the power and flexibility of Python with a simple template language
that non-programmers can understand.
@item Gives template writers full access to any Python data structure, module,
function, object, or method in their templates.
@item Makes code reuse easy by providing an object-orientated interface to
templates that is accessible from Python code or other Cheetah templates.
One template can subclass another and selectively reimplement sections of it.
@item Provides a simple, yet powerful, caching mechanism that can dramatically
improve the performance of a dynamic website.
@item Compiles templates into optimized, yet readable, Python code.
@end enumerate")
(license (license:x11-style "file://LICENSE"))))

233
gnu/packages/qt.scm
View file

@ -2,7 +2,7 @@
;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2015, 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017 ng0 <ng0@libertad.pw>
;;; Copyright © 2016 Thomas Danckaert <post@thomasdanckaert.be>
;;;
@ -55,6 +55,7 @@
#:use-module (gnu packages pulseaudio)
#:use-module (gnu packages python)
#:use-module (gnu packages ruby)
#:use-module (gnu packages sdl)
#:use-module (gnu packages tls)
#:use-module (gnu packages xdisorg)
#:use-module (gnu packages xorg)
@ -553,14 +554,22 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(zero? (system* "qmake" (string-append "PREFIX=" out))))))
;; Valid QT_BUILD_PARTS variables are:
;; libs tools tests examples demos docs translations
(zero? (system* "qmake" "QT_BUILD_PARTS = libs tools tests"
(string-append "PREFIX=" out))))))
(add-before 'install 'fix-Makefiles
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(qtbase (assoc-ref inputs "qtbase")))
(substitute* (find-files "." "Makefile")
(((string-append "INSTALL_ROOT)" qtbase))
(string-append "INSTALL_ROOT)" out)))))))))))
(string-append "INSTALL_ROOT)" out)))
#t)))
(add-before 'check 'set-display
(lambda _
(setenv "QT_QPA_PLATFORM" "offscreen")
#t)))))))
(define-public qtimageformats
(package (inherit qtsvg)
@ -602,6 +611,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(sha256
(base32
"09z49jm70f5i0gcdz9a16z00pg96x8pz7vri5wpirh3fqqn0qnjz"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(native-inputs `(("perl" ,perl)))
(inputs
`(("mesa" ,mesa)
@ -620,6 +632,15 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(sha256
(base32
"1rgqnpg64gn5agmvjwy0am8hp5fpxl3cdkixr1yrsdxi5a6961d8"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:phases phases)
`(modify-phases ,phases
(add-after 'unpack 'disable-network-tests
(lambda _ (substitute* "tests/auto/auto.pro"
(("qxmlquery") "# qxmlquery")
(("xmlpatterns") "# xmlpatterns"))
#t))))))
(native-inputs `(("perl" ,perl)))
(inputs `(("qtbase" ,qtbase)))))
@ -636,6 +657,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(sha256
(base32
"0mjxfwnplpx60jc6y94krg00isddl9bfwc7dayl981njb4qds4zx"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(native-inputs
`(("perl" ,perl)
("pkg-config" ,pkg-config)
@ -680,6 +704,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(sha256
(base32
"1laj0slwibs0bg69kgrdhc9k1s6yisq3pcsr0r9rhbkzisv7aajw"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(native-inputs
`(("perl" ,perl)
("qtdeclarative" ,qtdeclarative)))
@ -720,7 +747,13 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(snippet
'(begin
(delete-file-recursively
"examples/multimedia/spectrum/3rdparty")))))
"examples/multimedia/spectrum/3rdparty")
;; We also prevent the spectrum example from being built.
(substitute* "examples/multimedia/multimedia.pro"
(("spectrum") "#"))))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(native-inputs
`(("perl" ,perl)
("pkg-config" ,pkg-config)
@ -781,6 +814,23 @@ developers using C++ or QML, a CSS & JavaScript like language.")
`(("qtbase" ,qtbase)
("eudev" ,eudev)))))
(define-public qtserialbus
(package (inherit qtsvg)
(name "qtserialbus")
(version "5.7.1")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
(version-major+minor version) "/" version
"/submodules/" name "-opensource-src-"
version ".tar.xz"))
(sha256
(base32
"0mxi43l2inpbar8rmg21qjg33bv3f1ycxjgvzjf12ncnybhdnzkj"))))
(inputs
`(("qtbase" ,qtbase)
("qtserialport" ,qtserialport)))))
(define-public qtwebchannel
(package (inherit qtsvg)
(name "qtwebchannel")
@ -813,6 +863,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(sha256
(base32
"17zkzffzwbg6aqhsggs23cmwzq4y45m938842lsc423hfm7fdsgr"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(native-inputs
`(("perl" ,perl)
("qtdeclarative" ,qtdeclarative)
@ -833,6 +886,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(sha256
(base32
"1b6zqa5690b8lqms7rrhb8rcq0xg5hp117v3m08qngbcd0i706b4"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(native-inputs
`(("perl" ,perl)
("qtdeclarative" ,qtdeclarative)))
@ -872,6 +928,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(sha256
(base32
"17cyfyqzjbm9dhq9pjscz36y84y16rmxwk6h826gjfprddrimsvg"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(inputs
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))
@ -889,6 +948,9 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(sha256
(base32
"1v77ydy4k15lksp3bi2kgha2h7m79g4n7c2qhbr09xnvpb8ars7j"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(inputs
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))
@ -906,6 +968,169 @@ developers using C++ or QML, a CSS & JavaScript like language.")
(sha256
(base32
"1j2drnx7zp3w6cgvy7bn00fyk5v7vw1j1hidaqcg78lzb6zgls1c"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(inputs
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))
(define-public qtdeclarative-render2d
(package (inherit qtsvg)
(name "qtdeclarative-render2d")
(version "5.7.1")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
(version-major+minor version) "/" version
"/submodules/" name "-opensource-src-"
version ".tar.xz"))
(sha256
(base32
"0zwch9vn17f3bpy300jcfxx6cx9qymk5j7khx0x9k1xqid4166c3"))
(modules '((guix build utils)))
(snippet
'(delete-file-recursively "tools/opengldummy/3rdparty"))))
(native-inputs `())
(inputs
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))
(define-public qtgamepad
(package (inherit qtsvg)
(name "qtgamepad")
(version "5.7.1")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
(version-major+minor version) "/" version
"/submodules/" name "-opensource-src-"
version ".tar.xz"))
(sha256
(base32
"10lijbsg9xx5ddbbjymdgl41nxz99yn1qgiww2kkggxwwdjj2axv"))))
(native-inputs
`(("perl" ,perl)
("pkg-config" ,pkg-config)))
(inputs
`(("fontconfig" ,fontconfig)
("freetype" ,freetype)
("libxrender" ,libxrender)
("sdl2" ,sdl2)
("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))
(define-public qtscxml
(package (inherit qtsvg)
(name "qtscxml")
(version "5.7.1")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
(version-major+minor version) "/" version
"/submodules/" name "-opensource-src-"
version ".tar.xz"))
(sha256
(base32
"135kknqdmib2cjryfmvfgv7a2qx9pyba3m7i7nkbc5d742r4mbcx"))
(modules '((guix build utils)))
(snippet
'(begin
(delete-file-recursively "tests/3rdparty")
;; the scion test refers to the bundled 3rd party test code.
(substitute* "tests/auto/auto.pro"
(("scion") "#"))))))
(inputs
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))
(define-public qtpurchasing
(package (inherit qtsvg)
(name "qtpurchasing")
(version "5.7.1")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
(version-major+minor version) "/" version
"/submodules/" name "-opensource-src-"
version ".tar.xz"))
(sha256
(base32
"0hkvrgafz1hx9q4yc3nskv3pd3fszghvvd5a7mj33ynf55wpb57n"))))
(inputs
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))
(define-public qtcanvas3d
(package (inherit qtsvg)
(name "qtcanvas3d")
(version "5.7.1")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
(version-major+minor version) "/" version
"/submodules/" name "-opensource-src-"
version ".tar.xz"))
(sha256
(base32
"1d5xpq3mhjg4ipxzap7s2vnlfcd02d3yq720npv10xxp2ww0i1x8"))
(modules '((guix build utils)))
(snippet
'(delete-file-recursively "examples/canvas3d/3rdparty"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
;; Building the tests depends on the bundled 3rd party javascript files,
;; and the test phase fails to import QtCanvas3D, causing the phase to
;; fail, so we skip building them for now.
((#:phases phases)
`(modify-phases ,phases
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(zero? (system* "qmake" "QT_BUILD_PARTS = libs tools"
(string-append "PREFIX=" out))))))))
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(native-inputs `())
(inputs
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))
(define-public qtcharts
(package (inherit qtsvg)
(name "qtcharts")
(version "5.7.1")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
(version-major+minor version) "/" version
"/submodules/" name "-opensource-src-"
version ".tar.xz"))
(sha256
(base32
"1qrzcddwff2hxsbxrraff16j4abah2zkra2756s1mvydj9lyxzl5"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(inputs
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))
(define-public qtdatavis3d
(package (inherit qtsvg)
(name "qtdatavis3d")
(version "5.7.1")
(source (origin
(method url-fetch)
(uri (string-append "https://download.qt.io/official_releases/qt/"
(version-major+minor version) "/" version
"/submodules/" name "-opensource-src-"
version ".tar.xz"))
(sha256
(base32
"1y00p0wyj5cw9c2925y537vpmmg9q3kpf7qr1s7sv67dvvf8bzqv"))))
(arguments
(substitute-keyword-arguments (package-arguments qtsvg)
((#:tests? _ #f) #f))) ; TODO: Enable the tests
(inputs
`(("qtbase" ,qtbase)
("qtdeclarative" ,qtdeclarative)))))

4
gnu/packages/shells.scm
View file

@ -299,14 +299,14 @@ ksh, and tcsh.")
(define-public xonsh
(package
(name "xonsh")
(version "0.5.1")
(version "0.5.2")
(source
(origin
(method url-fetch)
(uri (pypi-uri "xonsh" version))
(sha256
(base32
"1a3jkvfh1xc6aw557y8zjn498q89bapyx4dxc3md7qwrmnj9pkv3"))
"13ndyq9cal2j93qqbjyp2jn3cshiavdxsaj2qjzm6mas0gzywmf0"))
(modules '((guix build utils)))
(snippet
`(begin

25
gnu/packages/statistics.scm
View file

@ -3954,6 +3954,31 @@ such that the arrangement of points within a category reflects the density of
data at that region, and avoids over-plotting.")
(license license:gpl2+)))
(define-public r-ggthemes
(package
(name "r-ggthemes")
(version "3.3.0")
(source (origin
(method url-fetch)
(uri (cran-uri "ggthemes" version))
(sha256
(base32
"1qdxg2siwsiq32fmgcxn4vihgxad9v8q0aqigl7a94c26bwxs7y2"))))
(build-system r-build-system)
(propagated-inputs
`(("r-assertthat" ,r-assertthat)
("r-colorspace" ,r-colorspace)
("r-ggplot2" ,r-ggplot2)
("r-scales" ,r-scales)))
(home-page "https://cran.rstudio.com/web/packages/ggthemes")
(synopsis "Extra themes, scales and geoms for @code{ggplot2}")
(description "This package provides extra themes and scales for
@code{ggplot2} that replicate the look of plots by Edward Tufte and
Stephen Few in Fivethirtyeight, The Economist, Stata, Excel, and The
Wall Street Journal, among others. This package also provides
@code{geoms} for Tufte's box plot and range frame.")
(license license:gpl2)))
(define-public r-statmod
(package
(name "r-statmod")

420
gnu/packages/suckless.scm
View file

@ -2,7 +2,7 @@
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2015 Amirouche Boubekki <amirouche@hypermove.net>
;;; Copyright © 2016 Al McElrath <hello@yrns.org>
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016, 2017 ng0 <ng0@libertad.pw>
;;; Copyright © 2015 Dmitry Bogatov <KAction@gnu.org>
;;; Copyright © 2015 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
@ -27,6 +27,7 @@
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system glib-or-gtk)
#:use-module (gnu packages)
@ -36,7 +37,15 @@
#:use-module (gnu packages fonts)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages webkit)
#:use-module (gnu packages fontutils))
#:use-module (gnu packages fontutils)
#:use-module (gnu packages mpd)
#:use-module (gnu packages linux)
#:use-module (gnu packages compression)
#:use-module (gnu packages cups)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages gawk)
#:use-module (gnu packages base)
#:use-module (gnu packages libbsd))
(define-public dwm
(package
@ -114,6 +123,34 @@ optimising the environment for the application in use and the task performed.")
numbers of user-defined menu items efficiently.")
(license license:x11)))
(define-public spoon
(package
(name "spoon")
(version "0.3")
(source
(origin
(method url-fetch)
(uri (string-append "http://dl.2f30.org/releases/"
name "-" version ".tar.gz"))
(sha256
(base32
"10c5i7ykpy7inzzfiw1dh0srpkljycr3blxhvd8160wsvplbws48"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" %output))))
(inputs
`(("libx11" ,libx11)
("libxkbfile" ,libxkbfile)
("alsa-lib" ,alsa-lib)
("libmpdclient" ,libmpdclient)))
(home-page "http://git.2f30.org/spoon/")
(synopsis "Set dwm status")
(description
"Spoon can be used to set the dwm status.")
(license license:isc)))
(define-public slock
(package
(name "slock")
@ -257,3 +294,382 @@ allows you to write down the presentation for a quick lightning talk within a
few minutes.")
(home-page "http://tools.suckless.org/sent")
(license license:x11)))
(define-public xbattmon
(package
(name "xbattmon")
(version "0.9")
(source
(origin
(method url-fetch)
(uri (string-append "http://dl.2f30.org/releases/"
name "-" version ".tar.gz"))
(sha256
(base32
"0n2rrjq03pgqrdkl7cz5snsfdanf4s58w9h6dbvnl7p8bbd3j2kn"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" %output))))
(inputs
`(("libx11" ,libx11)))
(home-page "http://git.2f30.org/xbattmon/")
(synopsis "Simple battery monitor for X")
(description
"Xbattmon is a simple battery monitor for X.")
(license license:isc)))
(define-public wificurse
(package
(name "wificurse")
(version "0.3.9")
(source
(origin
(method url-fetch)
(uri (string-append "http://dl.2f30.org/releases/"
name "-" version ".tar.gz"))
(sha256
(base32
"067ghr1xly5ca41kc83xila1p5hpq0bxfcmc8jvxi2ggm6wrhavn"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list
(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure)))) ; No configure script
(home-page "http://git.2f30.org/wificurse/")
(synopsis "Wifi DoS attack tool")
(description
"Wificurses listens for beacons sent from wireless access points
in the range of your wireless station. Once received the program
extracts the BSSID of the AP and transmits deauthentication packets
using the broadcast MAC address. This results to the disconnection
of all clients connected to the AP at the time of the attack. This
is essencially a WiFi DoS attack tool created for educational
purposes only. It works only in Linux and requires wireless card
drivers capable of injecting packets in wireless networks.")
(license license:gpl3+)))
(define-public skroll
(package
(name "skroll")
(version "0.6")
(source
(origin
(method url-fetch)
(uri (string-append "http://dl.2f30.org/releases/"
name "-" version ".tar.gz"))
(sha256
(base32
"0km6bjfz4ssb1z0xwld6iiixnn7d255ax8yjs3zkdm42z8q9yl0f"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure)))) ; No configure script
(home-page "http://2f30.org")
(synopsis "Commandline utility which scrolls text")
(description
"Skroll is a small utility that you can use to make a text scroll.
Pipe text to it, and it will scroll a given number of letters from right to
left.")
(license license:wtfpl2)))
(define-public sbm
(package
(name "sbm")
(version "0.9")
(source
(origin
(method url-fetch)
(uri (string-append "http://dl.2f30.org/releases/"
name "-" version ".tar.gz"))
(sha256
(base32
"1nks5mkh5wn30kyjzlkjlgi31bv1wq52kbp0r6nzbyfnvfdlywik"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure)))) ; No configure script
(home-page "http://git.2f30.org/sbm/")
(synopsis "Simple bandwidth monitor")
(description
"Sbm is a simple bandwidth monitor.")
(license license:isc)))
(define-public prout
(package
(name "prout")
(version "0.2")
(source
(origin
(method url-fetch)
(uri (string-append "http://dl.2f30.org/releases/"
name "-" version ".tar.gz"))
(sha256
(base32
"1s6c3ygg1h1fyxkh8gd7nzjk6qhnwsb4535d2k780kxnwns5fzas"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure)))) ; No configure script
(inputs
`(("cups-minimal" ,cups-minimal)
("zlib" ,zlib)))
(home-page "http://git.2f30.org/prout/")
(synopsis "Smaller lp command")
(description
"Prout (PRint OUT) is a small utility one can use to send
documents to a printer.
It has no feature, and does nothing else. Just set your default
printer in client.conf(5) and start printing. No need for a local
cups server to be installed.")
(license license:wtfpl2)))
(define-public noice
(package
(name "noice")
(version "0.6")
(source
(origin
(method url-fetch)
(uri (string-append "http://dl.2f30.org/releases/"
name "-" version ".tar.gz"))
(sha256
(base32
"0ldkbb71z6k4yzj4kpg3s94ijj1c1kx9dfcjz393py09scfyg5hr"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure) ; No configure script
(add-before 'build 'curses
(lambda _
(substitute* "Makefile"
(("lcurses") "lncurses")))))))
(inputs
`(("ncurses" ,ncurses)))
(home-page "http://git.2f30.org/noice/")
(synopsis "Small file browser")
(description
"Noice is a small curses-based file browser.")
(license license:bsd-2)))
;;; We want some commits that are more recent than the latest release, 0.2
(define-public human
(let ((commit "50c80e6ba12823184b6866e06b955dbd2ccdc5d7")
(revision "1"))
(package
(name "human")
(version (string-append "0.2-" revision "." (string-take commit 7)))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "git://git.2f30.org/human.git")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"18xngm4h9vsyip52zwd79rrp1irzg6rs462lpbp61amf7hj955gn"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure)))) ; No configure script
(home-page "http://git.2f30.org/human/")
(synopsis "Convert bytes to human readable formats")
(description
"Human is a small program which translate numbers into a
human readable format. By default, it tries to detect the best
factorisation, but you can force its output.
You can adjust the number of decimals with the @code{SCALE}
environment variable.")
(license license:wtfpl2))))
(define-public fortify-headers
(package
(name "fortify-headers")
(version "0.8")
(source
(origin
(method url-fetch)
(uri (string-append "http://dl.2f30.org/releases/"
name "-" version ".tar.gz"))
(sha256
(base32
"1cacdczpjb49c4i1168g541wnl3i3gbpv2m2wbnmw5wddlyhgkdg"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure)))) ; No configure script
(home-page "http://git.2f30.org/fortify-headers/")
(synopsis "Standalone fortify-source implementation")
(description
"This is a standalone implementation of fortify source. It provides
compile time buffer checks. It is libc-agnostic and simply overlays the
system headers by using the @code{#include_next} extension found in GCC. It was
initially intended to be used on musl based Linux distributions.
@itemize
@item It is portable, works on *BSD, Linux, Solaris and possibly others.
@item It will only trap non-conformant programs. This means that fortify
level 2 is treated in the same way as level 1.
@item Avoids making function calls when undefined behaviour has already been
invoked. This is handled by using __builtin_trap().
@item Support for out-of-bounds read interfaces, such as send(), write(),
fwrite() etc.
@item No ABI is enforced. All of the fortify check functions are inlined
into the resulting binary.
@end itemize\n")
(license license:isc)))
(define-public colors
(package
(name "colors")
(version "0.3")
(source
(origin
(method url-fetch)
(uri (string-append "http://dl.2f30.org/releases/"
name "-" version ".tar.gz"))
(sha256
(base32
"1lckmqpgj89841splng0sszbls2ag71ggkgr1wsv9y3v6y87589z"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure)))) ; No configure script
(inputs
`(("libpng" ,libpng)))
(home-page "http://git.2f30.org/colors/")
(synopsis "Extract colors from pictures")
(description
"Extract colors from PNG files. It is similar to
strings(1) but for pictures. For a given input file it outputs a
colormap to stdout.")
(license license:isc)))
;; No new releases were made at github, this repository is more active than
;; the one at http://git.suckless.org/libutf/ and it is
;; done by the same developer.
(define-public libutf
(let ((revision "1")
(commit "ff4c60635e1f455b0a0b4200f8183fbd5a88225b"))
(package
(name "libutf")
(version (string-append "0.0.0-" revision "." (string-take commit 7)))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/cls/libutf")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"1ih5vjavilzggyr1j1z6w1z12c2fs5fg77cfnv7ami5ivsy3kg3d"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure)))) ; No configure script
(inputs
`(("gawk" ,gawk)))
(home-page "https://github.com/cls/libutf")
(synopsis "Plan 9 compatible UTF-8 library")
(description
"This is a C89 UTF-8 library, with an API compatible with that of
Plan 9's libutf, but with a number of improvements:
@itemize
@item Support for runes beyond the Basic Multilingual Plane.
@item utflen and utfnlen cannot overflow on 32- or 64-bit machines.
@item chartorune treats all invalid codepoints as though Runeerror.
@item fullrune, utfecpy, and utfnlen do not overestimate the length
of malformed runes.
@item An extra function, charntorune(p,s,n), equivalent to
fullrune(s,n) ? chartorune(p,s): 0.
@item Runeerror may be set to an alternative replacement value, such
as -1, to be used instead of U+FFFD.
@end itemize\n")
(license license:expat))))
;; No release tarballs so far.
(define-public lchat
(let ((revision "1")
(commit "bbde23732f8c7769b982f0c1bda9b99fbf93f932"))
(package
(name "lchat")
(version (string-append "0.0.0-" revision "." (string-take commit 7)))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/younix/lchat")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"00q3rc0aa5416jvjvrj71x1wnr0331kxhvjjs7pyxgnq4xf36k63"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests
#:make-flags (list "CC=gcc"
(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure) ; No configure script
(add-before 'build 'libbsd
(lambda _
(substitute* "Makefile"
(("-lutf") "-lutf -lbsd"))))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin")))
(install-file "lchat" bin)
#t))))))
(inputs
`(("grep" ,grep)
("ncurses" ,ncurses)
("libutf" ,libutf)
("libbsd" ,libbsd)))
(home-page "https://github.com/younix/lchat")
(synopsis "Line chat is a frontend for the irc client ii from suckless")
(description
"Lchat (line chat) is the little and small brother of cii.
It is a front end for ii-like chat programs. It uses tail(1) -f to get the
chat output in background.")
(license license:isc))))

11
gnu/packages/upnp.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2016, 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -28,15 +28,14 @@
(define-public miniupnpc
(package
(name "miniupnpc")
(version "2.0")
(version "2.0.20161216")
(source
(origin
(method url-fetch)
(uri (string-append
"http://miniupnp.tuxfamily.org/files/miniupnpc-"
version ".tar.gz"))
(uri (string-append "https://miniupnp.tuxfamily.org/files/"
name "-" version ".tar.gz"))
(sha256
(base32 "0fzrc6fs8vzb2yvk01bd3q5jkarysl7gjlyaqncy3yvfk2wcwd6l"))))
(base32 "0gpxva9jkjvqwawff5y51r6bmsmdhixl3i5bmzlqsqpwsq449q81"))))
(build-system gnu-build-system)
(native-inputs
`(("python" ,python-2)))

5
gnu/packages/vpn.scm
View file

@ -5,6 +5,7 @@
;;; Copyright © 2015 Jeff Mickey <j@codemac.net>
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@ -152,7 +153,7 @@ and probably others.")
(define-public openvpn
(package
(name "openvpn")
(version "2.3.14")
(version "2.4.0")
(source (origin
(method url-fetch)
(uri (string-append
@ -160,7 +161,7 @@ and probably others.")
version ".tar.xz"))
(sha256
(base32
"167frlmmg2raffn9h7ww3agdwgfdl0wa5wm9fsgl0i6mz3md187k"))))
"0zpqnbhjaifdalyxwmvk5kcyd7cpxbcigbn7967nbsyvl54vl8vg"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--enable-iproute2=yes")))

155
gnu/packages/xfig.scm
View file

@ -34,12 +34,12 @@
(version "3.2.5c")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/mcj/mcj-source/xfig."
version ".full.tar.gz"))
(sha256
(base32
"1yd1jclvw5w3ja4jjzr1ysbn8iklh88wq84jn9d1gavrbfbqyqpa"))))
(method url-fetch)
(uri (string-append "mirror://sourceforge/mcj/mcj-source/xfig."
version ".full.tar.gz"))
(sha256
(base32
"1yd1jclvw5w3ja4jjzr1ysbn8iklh88wq84jn9d1gavrbfbqyqpa"))))
(build-system gnu-build-system)
(native-inputs
`(("imake" ,imake)
@ -59,51 +59,54 @@
(arguments
`(#:tests? #f
#:phases
(alist-replace
'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((imake (assoc-ref inputs "imake"))
(out (assoc-ref outputs "out")))
(substitute* "Imakefile"
(("XCOMM (BINDIR = )[[:graph:]]*" _ front)
(string-append front out "/bin"))
(("(PNGLIBDIR = )[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libpng") "/lib"))
(("(PNGINC = -I)[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libpng") "/include"))
(("(JPEGLIBDIR = )[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libjpeg") "/lib"))
(("(JPEGINC = -I)[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libjpeg") "/include"))
(("(ZLIBDIR = )[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "zlib") "/lib"))
(("(XPMLIBDIR = )[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libxpm") "/lib"))
(("(XPMINC = -I)[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libxpm") "/include"))
(("(XFIGLIBDIR = )[[:graph:]]*" _ front)
(string-append front out "/lib"))
(("(XFIGDOCDIR = )[[:graph:]]*" _ front)
(string-append front out "/share/doc"))
(("XCOMM USEINLINE") "USEINLINE"))
;; The -a argument is required in order to pick up the correct paths
;; to several X header files.
(zero? (system* "xmkmf" "-a"))
;; Reset some variables that are inherited from imake templates
(substitute* "Makefile"
;; These imake variables somehow remain undefined
(("DefaultGcc2[[:graph:]]*Opt") "-O2")
;; Reset a few variable defaults that are set in imake templates
((imake) out)
(("(MANPATH = )[[:graph:]]*" _ front)
(string-append front out "/share/man"))
(("(CONFDIR = )([[:graph:]]*)" _ front default)
(string-append front out default)))))
(alist-cons-after
'install 'install/libs
(lambda _
(zero? (system* "make" "install.libs")))
(alist-cons-after
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((imake (assoc-ref inputs "imake"))
(out (assoc-ref outputs "out")))
(substitute* "Imakefile"
(("XCOMM XAPPLOADDIR = /home/user/xfig *")
(string-append "XAPPLOADDIR = " out ,%app-defaults-dir))
(("XCOMM (BINDIR = )[[:graph:]]*" _ front)
(string-append front out "/bin"))
(("(PNGLIBDIR = )[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libpng") "/lib"))
(("(PNGINC = -I)[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libpng") "/include"))
(("(JPEGLIBDIR = )[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libjpeg") "/lib"))
(("(JPEGINC = -I)[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libjpeg") "/include"))
(("(ZLIBDIR = )[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "zlib") "/lib"))
(("(XPMLIBDIR = )[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libxpm") "/lib"))
(("(XPMINC = -I)[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libxpm") "/include"))
(("(XFIGLIBDIR = )[[:graph:]]*" _ front)
(string-append front out "/lib"))
(("(XFIGDOCDIR = )[[:graph:]]*" _ front)
(string-append front out "/share/doc"))
(("XCOMM USEINLINE") "USEINLINE"))
;; The -a argument is required in order to pick up the correct paths
;; to several X header files.
(zero? (system* "xmkmf" "-a"))
;; Reset some variables that are inherited from imake templates
(substitute* "Makefile"
;; These imake variables somehow remain undefined
(("DefaultGcc2[[:graph:]]*Opt") "-O2")
;; Reset a few variable defaults that are set in imake templates
((imake) out)
(("(MANPATH = )[[:graph:]]*" _ front)
(string-append front out "/share/man"))
(("(CONFDIR = )([[:graph:]]*)" _ front default)
(string-append front out default))))
#t))
(add-after
'install 'install/libs
(lambda _
(zero? (system* "make" "install.libs"))))
(add-after
'install 'install/doc
(lambda _
(begin
@ -118,15 +121,7 @@
(dump-port in out)
(close-pipe in)
(close-port out)))
(zero? (system* "make" "install.doc"))))
(alist-cons-after
'install 'wrap-xfig
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(wrap-program (string-append out "/bin/xfig")
`("XAPPLRESDIR" suffix
(,(string-append out "/etc/X11/app-defaults"))))))
%standard-phases))))))
(zero? (system* "make" "install.doc"))))))))
(home-page "http://xfig.org/")
(synopsis "Interactive drawing tool")
(description
@ -144,12 +139,12 @@ selected in various ways. For text, 35 fonts are available.")
(version "3.2.5e")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/mcj/mcj-source/transfig."
version ".tar.gz"))
(sha256
(base32
"0i3p7qmg2w8qrad3pn42b0miwarql7yy0gpd49b1bpal6bqsiicf"))))
(method url-fetch)
(uri (string-append "mirror://sourceforge/mcj/mcj-source/transfig."
version ".tar.gz"))
(sha256
(base32
"0i3p7qmg2w8qrad3pn42b0miwarql7yy0gpd49b1bpal6bqsiicf"))))
(build-system gnu-build-system)
(native-inputs
`(("imake" ,imake)
@ -183,20 +178,20 @@ selected in various ways. For text, 35 fonts are available.")
(("(XPMINC = -I)[[:graph:]]*" _ front)
(string-append front (assoc-ref inputs "libxpm") "/include/X11"))
(("/usr/local/lib/fig2dev") (string-append out "/lib")))
;; The -a argument is required in order to pick up the correct paths
;; to several X header files.
(zero? (system* "xmkmf" "-a"))
(substitute* '("Makefile"
"fig2dev/Makefile"
"transfig/Makefile")
;; These imake variables somehow remain undefined
(("DefaultGcc2[[:graph:]]*Opt") "-O2")
;; Reset a few variable defaults that are set in imake templates
((imake) out)
(("(MANPATH = )[[:graph:]]*" _ front)
(string-append front out "/share/man"))
(("(CONFDIR = )([[:graph:]]*)" _ front default)
(string-append front out default)))))
;; The -a argument is required in order to pick up the correct paths
;; to several X header files.
(zero? (system* "xmkmf" "-a"))
(substitute* '("Makefile"
"fig2dev/Makefile"
"transfig/Makefile")
;; These imake variables somehow remain undefined
(("DefaultGcc2[[:graph:]]*Opt") "-O2")
;; Reset a few variable defaults that are set in imake templates
((imake) out)
(("(MANPATH = )[[:graph:]]*" _ front)
(string-append front out "/share/man"))
(("(CONFDIR = )([[:graph:]]*)" _ front default)
(string-append front out default)))))
(alist-cons-after
'install 'install/doc
(lambda _

127
gnu/packages/xorg.scm
View file

@ -10,7 +10,7 @@
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2016, 2017 John Darrington <jmd@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -335,6 +335,7 @@ provided.")
(license (license:x11-style "file://dri3proto.h"
"See 'dri3proto.h' in the distribution."))))
(define-public %app-defaults-dir "/lib/X11/app-defaults")
(define-public editres
(package
@ -354,7 +355,7 @@ provided.")
(arguments
`(#:configure-flags
(list (string-append "--with-appdefaultdir="
%output "/lib/X11/app-defaults"))))
%output ,%app-defaults-dir))))
(inputs
`(("libxaw" ,libxaw)
("libxmu" ,libxmu)
@ -3982,23 +3983,9 @@ protocol.")
"1grir464hy52a71r3mpm9mzvkf7nwr3vk0b1vc27pd3gp588a38p"))))
(build-system gnu-build-system)
(arguments
;; By default, it tries to install XFontSel file in
;; "/gnu/store/<libxt>/share/X11/app-defaults": it defines this
;; directory from 'libxt' (using 'pkg-config'). To put this file
;; inside output dir and to use it properly, we need to configure
;; --with-appdefaultdir and to wrap 'xfontsel' binary.
(let ((app-defaults-dir "/share/X11/app-defaults"))
`(#:configure-flags
(list (string-append "--with-appdefaultdir="
%output ,app-defaults-dir))
#:phases
(modify-phases %standard-phases
(add-after 'install 'wrap-xfontsel
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(wrap-program (string-append out "/bin/xfontsel")
`("XAPPLRESDIR" =
(,(string-append out ,app-defaults-dir)))))))))))
`(#:configure-flags
(list (string-append "--with-appdefaultdir="
%output ,%app-defaults-dir))))
(inputs
`(("libx11" ,libx11)
("libxaw" ,libxaw)
@ -4028,19 +4015,9 @@ Font Description (XLFD) full name for a font.")
"0n97iqqap9wyxjan2n520vh4rrf5bc0apsw2k9py94dqzci258y1"))))
(build-system gnu-build-system)
(arguments
;; The same 'app-defaults' problem as with 'xfontsel' package.
(let ((app-defaults-dir "/share/X11/app-defaults"))
`(#:configure-flags
(list (string-append "--with-appdefaultdir="
%output ,app-defaults-dir))
#:phases
(modify-phases %standard-phases
(add-after 'install 'wrap-xfd
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(wrap-program (string-append out "/bin/xfd")
`("XAPPLRESDIR" =
(,(string-append out ,app-defaults-dir)))))))))))
%output ,%app-defaults-dir))))
(inputs
`(("fontconfig" ,fontconfig)
("libx11" ,libx11)
@ -5358,6 +5335,36 @@ draggable titlebars and borders.")
Intrinsics (Xt) Library.")
(license license:x11)))
(define-public twm
(package
(name "twm")
(version "1.0.9")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://xorg/individual/app/" name "-"
version
".tar.gz"))
(sha256
(base32
"1s1r00x8add3f27xjqxg6q7mwplwrb72gakbh4y6j052as25wchw"))))
(build-system gnu-build-system)
(inputs
`(("libxt" ,libxt)
("libxmu" ,libxmu)
("libxext" ,libxext)
("xproto" ,xproto)))
(native-inputs
`(("bison" ,bison)
("pkg-config" ,pkg-config)))
(home-page "https://www.x.org/wiki/")
(synopsis "Tab Window Manager for the X Window System")
(description "Twm is a window manager for the X Window System.
It provides titlebars, shaped windows, several forms of icon management,
user-defined macro functions, click-to-type and pointer-driven
keyboard focus, and user-specified key and pointer button bindings.")
(license license:x11)))
(define-public xcb-util
(package
@ -5617,6 +5624,66 @@ user-friendly mechanism to start the X server.")
Intrinsics (Xt) Library.")
(license license:x11)))
(define-public xmag
(package
(name "xmag")
(version "1.0.6")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://xorg/individual/app/" name "-"
version
".tar.gz"))
(sha256
(base32
"19bsg5ykal458d52v0rvdx49v54vwxwqg8q36fdcsv9p2j8yri87"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
(list (string-append "--with-appdefaultdir="
%output ,%app-defaults-dir))))
(inputs
`(("libxaw" ,libxaw)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "https://www.x.org/wiki/")
(synopsis "Display or capture a magnified part of a X11 screen")
(description "Xmag displays and captures a magnified snapshot of a portion
of an X11 screen.")
(license license:x11)))
(define-public xmessage
(package
(name "xmessage")
(version "1.0.4")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://xorg/individual/app/" name "-"
version
".tar.gz"))
(sha256
(base32
"1jmcac1xbwplbxfl75sr6w3zqhx1khpdzlqippjsr31cjp1rjc48"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
(list (string-append "--with-appdefaultdir="
%output ,%app-defaults-dir))))
(inputs
`(("libxaw" ,libxaw)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "https://www.x.org/wiki/")
(synopsis "Displays a message or query in a window")
(description
"Xmessage displays a message or query in a window. The user can click
on a button to dismiss it or can select one of several buttons
to answer a question. Xmessage can also exit after a specified time.")
(license license:x11)))
(define-public xterm
(package
(name "xterm")

81
gnu/services/databases.scm
View file

@ -2,6 +2,7 @@
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -35,7 +36,11 @@
mysql-service
mysql-service-type
mysql-configuration
mysql-configuration?))
mysql-configuration?
redis-configuration
redis-configuration?
redis-service-type))
;;; Commentary:
;;;
@ -287,3 +292,77 @@ database server.
The optional @var{config} argument specifies the configuration for
@command{mysqld}, which should be a @code{<mysql-configuration>} object."
(service mysql-service-type config))
;;;
;;; Redis
;;;
(define-record-type* <redis-configuration>
redis-configuration make-redis-configuration
redis-configuration?
(redis redis-configuration-redis ;<package>
(default redis))
(bind redis-configuration-bind
(default "127.0.0.1"))
(port redis-configuration-port
(default 6379))
(working-directory redis-configuration-working-directory
(default "/var/lib/redis"))
(config-file redis-configuration-config-file
(default #f)))
(define (default-redis.conf bind port working-directory)
(mixed-text-file "redis.conf"
"bind " bind "\n"
"port " (number->string port) "\n"
"dir " working-directory "\n"
"daemonize no\n"))
(define %redis-accounts
(list (user-group (name "redis") (system? #t))
(user-account
(name "redis")
(group "redis")
(system? #t)
(comment "Redis server user")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))))
(define redis-activation
(match-lambda
(($ <redis-configuration> redis bind port working-directory config-file)
#~(begin
(use-modules (guix build utils)
(ice-9 match))
(let ((user (getpwnam "redis")))
(mkdir-p #$working-directory)
(chown #$working-directory (passwd:uid user) (passwd:gid user)))))))
(define redis-shepherd-service
(match-lambda
(($ <redis-configuration> redis bind port working-directory config-file)
(let ((config-file
(or config-file
(default-redis.conf bind port working-directory))))
(list (shepherd-service
(provision '(redis))
(documentation "Run the Redis daemon.")
(requirement '(user-processes syslogd))
(start #~(make-forkexec-constructor
'(#$(file-append redis "/bin/redis-server")
#$config-file)
#:user "redis"
#:group "redis"))
(stop #~(make-kill-destructor))))))))
(define redis-service-type
(service-type (name 'redis)
(extensions
(list (service-extension shepherd-root-service-type
redis-shepherd-service)
(service-extension activation-service-type
redis-activation)
(service-extension account-service-type
(const %redis-accounts))))))

17
guix/derivations.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -120,7 +121,7 @@
;;; Nix derivations, as implemented in Nix's `derivations.cc'.
;;;
(define-record-type <derivation>
(define-immutable-record-type <derivation>
(make-derivation outputs inputs sources system builder args env-vars
file-name)
derivation?
@ -817,14 +818,6 @@ output should not be used."
e
outputs)))
(define (set-file-name drv file)
;; Set FILE as the 'file-name' field of DRV.
(match drv
(($ <derivation> outputs inputs sources system builder
args env-vars)
(make-derivation outputs inputs sources system builder
args env-vars file))))
(define input->derivation-input
(match-lambda
(((? derivation? drv))
@ -872,9 +865,9 @@ output should not be used."
(let* ((file (add-text-to-store store (string-append name ".drv")
(derivation->string drv)
(map derivation-input-path inputs)))
(drv (set-file-name drv file)))
(hash-set! %derivation-cache file drv)
drv)))
(drv* (set-field drv (derivation-file-name) file)))
(hash-set! %derivation-cache file drv*)
drv*)))
(define* (map-derivation store drv mapping
#:key (system (%current-system)))

3
guix/git-download.scm
View file

@ -109,8 +109,7 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
#:hash-algo hash-algo
#:hash hash
#:recursive? #t
#:guile-for-build guile
#:local-build? #t)))
#:guile-for-build guile)))
(define (git-version version revision commit)
"Return the version string for packages using git-download."

26
guix/http-client.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; 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 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
;;;
@ -223,13 +223,14 @@ or if EOF is reached."
'shutdown (const #f))
(define* (http-fetch uri #:key port (text? #f) (buffered? #t)
keep-alive? (verify-certificate? #t))
keep-alive? (verify-certificate? #t)
(headers '((user-agent . "GNU Guile"))))
"Return an input port containing the data at URI, and the expected number of
bytes available or #f. If TEXT? is true, the data at URI is considered to be
textual. Follow any HTTP redirection. When BUFFERED? is #f, return an
unbuffered port, suitable for use in `filtered-port'. When KEEP-ALIVE? is
true, send a 'Connection: keep-alive' HTTP header, in which case PORT may be
reused for future HTTP requests.
reused for future HTTP requests. HEADERS is an alist of extra HTTP headers.
When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates.
@ -240,13 +241,14 @@ Raise an '&http-get-error' condition if downloading fails."
(let ((port (or port (open-connection-for-uri uri
#:verify-certificate?
verify-certificate?)))
(auth-header (match (uri-userinfo uri)
((? string? str)
(list (cons 'Authorization
(string-append "Basic "
(base64-encode
(string->utf8 str))))))
(_ '()))))
(headers (match (uri-userinfo uri)
((? string? str)
(cons (cons 'Authorization
(string-append "Basic "
(base64-encode
(string->utf8 str))))
headers))
(_ headers))))
(unless (or buffered? (not (file-port? port)))
(setvbuf port _IONBF))
(let*-values (((resp data)
@ -254,10 +256,10 @@ Raise an '&http-get-error' condition if downloading fails."
(if (guile-version>? "2.0.7")
(http-get uri #:streaming? #t #:port port
#:keep-alive? #t
#:headers auth-header) ; 2.0.9+
#:headers headers) ; 2.0.9+
(http-get* uri #:decode-body? text? ; 2.0.7
#:keep-alive? #t
#:port port #:headers auth-header)))
#:port port #:headers headers)))
((code)
(response-code resp)))
(case code

17
guix/import/github.scm
View file

@ -19,16 +19,29 @@
(define-module (guix import github)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (json)
#:use-module (guix utils)
#:use-module ((guix download) #:prefix download:)
#:use-module (guix import utils)
#:use-module (guix import json)
#:use-module (guix packages)
#:use-module (guix upstream)
#:use-module (guix http-client)
#:use-module (web uri)
#:export (%github-updater))
(define (json-fetch* url)
"Return a representation of the JSON resource URL (a list or hash table), or
#f if URL returns 404."
(guard (c ((and (http-get-error? c)
(= 404 (http-get-error-code c)))
#f)) ;"expected" if package is unknown
;; Note: github.com returns 403 if we omit a 'User-Agent' header.
(let* ((port (http-fetch url))
(result (json->scm port)))
(close-port port)
result)))
(define (find-extension url)
"Return the extension of the archive e.g. '.tar.gz' given a URL, or
false if none is recognized"
@ -125,7 +138,7 @@ the package e.g. 'bedtools2'. Return #f if there is no releases"
"https://api.github.com/repos/"
(github-user-slash-repository url)
"/releases"))
(json (json-fetch
(json (json-fetch*
(if token
(string-append api-url "?access_token=" token)
api-url))))

10
guix/licenses.scm
View file

@ -8,7 +8,7 @@
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016 Fabian Harfert <fhmgufs@web.de>
;;; Copyright © 2016 Rene Saavedra <rennes@openmailbox.org>
;;; Copyright © 2016 ng0 <ngillmann@runbox.com>
;;; Copyright © 2016, 2017 ng0 <ng0@libertad.pw>
;;;
;;; This file is part of GNU Guix.
;;;
@ -74,7 +74,8 @@
x11 x11-style
zpl2.1
zlib
fsf-free))
fsf-free
wtfpl2))
(define-record-type <license>
(license name uri comment)
@ -450,6 +451,11 @@ at URI, which may be a file:// URI pointing the package's tree."
"https://unlicense.org/"
"https://www.gnu.org/licenses/license-list.html#Unlicense"))
(define wtfpl2
(license "WTFPL 2"
"http://www.wtfpl.net"
"http://www.wtfpl.net/about/"))
(define x11
(license "X11"
"http://directory.fsf.org/wiki/License:X11"

181
guix/scripts/challenge.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -37,12 +37,17 @@
#:use-module (ice-9 vlist)
#:use-module (ice-9 format)
#:use-module (web uri)
#:export (discrepancies
#:export (compare-contents
discrepancy?
discrepancy-item
discrepancy-local-sha256
discrepancy-narinfos
comparison-report?
comparison-report-item
comparison-report-result
comparison-report-local-sha256
comparison-report-narinfos
comparison-report-match?
comparison-report-mismatch?
comparison-report-inconclusive?
guix-challenge))
@ -61,13 +66,38 @@
(define ensure-store-item ;XXX: move to (guix ui)?
(@@ (guix scripts size) ensure-store-item))
;; Representation of a hash mismatch for ITEM.
(define-record-type <discrepancy>
(discrepancy item local-sha256 narinfos)
discrepancy?
(item discrepancy-item) ;string, /gnu/store/… item
(local-sha256 discrepancy-local-sha256) ;bytevector | #f
(narinfos discrepancy-narinfos)) ;list of <narinfo>
;; Representation of a comparison report for ITEM.
(define-record-type <comparison-report>
(%comparison-report item result local-sha256 narinfos)
comparison-report?
(item comparison-report-item) ;string, /gnu/store/… item
(result comparison-report-result) ;'match | 'mismatch | 'inconclusive
(local-sha256 comparison-report-local-sha256) ;bytevector | #f
(narinfos comparison-report-narinfos)) ;list of <narinfo>
(define-syntax comparison-report
;; Some sort of a an enum to make sure 'result' is correct.
(syntax-rules (match mismatch inconclusive)
((_ item 'match rest ...)
(%comparison-report item 'match rest ...))
((_ item 'mismatch rest ...)
(%comparison-report item 'mismatch rest ...))
((_ item 'inconclusive rest ...)
(%comparison-report item 'inconclusive rest ...))))
(define (comparison-report-predicate result)
"Return a predicate that returns true when pass a REPORT that has RESULT."
(lambda (report)
(eq? (comparison-report-result report) result)))
(define comparison-report-mismatch?
(comparison-report-predicate 'mismatch))
(define comparison-report-match?
(comparison-report-predicate 'match))
(define comparison-report-inconclusive?
(comparison-report-predicate 'inconclusive))
(define (locally-built? store item)
"Return true if ITEM was built locally."
@ -88,10 +118,10 @@ Otherwise return #f."
(define-syntax-rule (report args ...)
(format (current-error-port) args ...))
(define (discrepancies items servers)
(define (compare-contents items servers)
"Challenge the substitute servers whose URLs are listed in SERVERS by
comparing the hash of the substitutes of ITEMS that they serve. Return the
list of discrepancies.
list of <comparison-report> objects.
This procedure does not authenticate narinfos from SERVERS, nor does it verify
that they are signed by an authorized public keys. The reason is that, by
@ -100,11 +130,7 @@ taken since we do not import the archives."
(define (compare item reference)
;; Return a procedure to compare the hash of ITEM with REFERENCE.
(lambda (narinfo url)
(if (not narinfo)
(begin
(warning (_ "~a: no substitute at '~a'~%")
item url)
#t)
(or (not narinfo)
(let ((value (narinfo-hash->sha256 (narinfo-hash narinfo))))
(bytevector=? reference value)))))
@ -116,9 +142,7 @@ taken since we do not import the archives."
((url urls ...)
(if (not first)
(select-reference item narinfos urls)
(narinfo-hash->sha256 (narinfo-hash first))))))
(()
(leave (_ "no substitutes for '~a'~%") item))))
(narinfo-hash->sha256 (narinfo-hash first))))))))
(mlet* %store-monad ((local (mapm %store-monad
query-locally-built-hash items))
@ -130,42 +154,61 @@ taken since we do not import the archives."
vhash))
vlist-null
remote)))
(return (filter-map (lambda (item local)
(let ((narinfos (vhash-fold* cons '() item narinfos)))
(define reference
(or local
(begin
(warning (_ "no local build for '~a'~%") item)
(select-reference item narinfos servers))))
(return (map (lambda (item local)
(match (vhash-fold* cons '() item narinfos)
(() ;no substitutes
(comparison-report item 'inconclusive local '()))
((narinfo)
(if local
(if ((compare item local) narinfo (first servers))
(comparison-report item 'match
local (list narinfo))
(comparison-report item 'mismatch
local (list narinfo)))
(comparison-report item 'inconclusive
local (list narinfo))))
((narinfos ...)
(let ((reference
(or local (select-reference item narinfos
servers))))
(if (every (compare item reference) narinfos servers)
(comparison-report item 'match
local narinfos)
(comparison-report item 'mismatch
local narinfos))))))
items
local))))
(if (every (compare item reference)
narinfos servers)
#f
(discrepancy item local narinfos))))
items
local))))
(define* (summarize-report comparison-report
#:key
(hash->string bytevector->nix-base32-string)
verbose?)
"Write to the current error port a summary of REPORT, a <comparison-report>
object. When VERBOSE?, display matches in addition to mismatches and
inconclusive reports."
(define (report-hashes item local narinfos)
(if local
(report (_ " local hash: ~a~%") (hash->string local))
(report (_ " no local build for '~a'~%") item))
(for-each (lambda (narinfo)
(report (_ " ~50a: ~a~%")
(uri->string (narinfo-uri narinfo))
(hash->string
(narinfo-hash->sha256 (narinfo-hash narinfo)))))
narinfos))
(define* (summarize-discrepancy discrepancy
#:key (hash->string
bytevector->nix-base32-string))
"Write to the current error port a summary of DISCREPANCY, a <discrepancy>
object that denotes a hash mismatch."
(match discrepancy
(($ <discrepancy> item local (narinfos ...))
(match comparison-report
(($ <comparison-report> item 'mismatch local (narinfos ...))
(report (_ "~a contents differ:~%") item)
(if local
(report (_ " local hash: ~a~%") (hash->string local))
(warning (_ "no local build for '~a'~%") item))
(for-each (lambda (narinfo)
(if narinfo
(report (_ " ~50a: ~a~%")
(uri->string (narinfo-uri narinfo))
(hash->string
(narinfo-hash->sha256 (narinfo-hash narinfo))))
(report (_ " ~50a: unavailable~%")
(uri->string (narinfo-uri narinfo)))))
narinfos))))
(report-hashes item local narinfos))
(($ <comparison-report> item 'inconclusive #f narinfos)
(warning (_ "could not challenge '~a': no local build~%") item))
(($ <comparison-report> item 'inconclusive locals ())
(warning (_ "could not challenge '~a': no substitutes~%") item))
(($ <comparison-report> item 'match local (narinfos ...))
(when verbose?
(report (_ "~a contents match:~%") item)
(report-hashes item local narinfos)))))
;;;
@ -178,6 +221,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
(display (_ "
--substitute-urls=URLS
compare build results with those at URLS"))
(display (_ "
-v, --verbose show details about successful comparisons"))
(newline)
(display (_ "
-h, --help display this help and exit"))
@ -201,6 +246,11 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
(alist-cons 'substitute-urls
(string-tokenize arg)
(alist-delete 'substitute-urls result))
rest)))
(option '("verbose" #\v) #f #f
(lambda (opt name arg result . rest)
(apply values
(alist-cons 'verbose? #t result)
rest)))))
(define %default-options
@ -220,7 +270,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
(_ #f))
opts))
(system (assoc-ref opts 'system))
(urls (assoc-ref opts 'substitute-urls)))
(urls (assoc-ref opts 'substitute-urls))
(verbose? (assoc-ref opts 'verbose?)))
(leave-on-EPIPE
(with-store store
;; Disable grafts since substitute servers normally provide only
@ -236,13 +287,15 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
#:use-substitutes? #f)
(run-with-store store
(mlet* %store-monad ((items (mapm %store-monad
ensure-store-item files))
(issues (discrepancies items urls)))
(for-each summarize-discrepancy issues)
(unless (null? issues)
(exit 2))
(return (null? issues)))
(mlet* %store-monad ((items (mapm %store-monad
ensure-store-item files))
(reports (compare-contents items urls)))
(for-each (cut summarize-report <> #:verbose? verbose?)
reports)
(exit (cond ((any comparison-report-mismatch? reports) 2)
((every comparison-report-match? reports) 0)
(else 1))))
#:system system))))))))
;;; challenge.scm ends here

24
guix/scripts/perform-download.scm
View file

@ -41,20 +41,23 @@
(module-use! module (resolve-interface '(guix base32)))
module))
(define (perform-download drv output)
(define* (perform-download drv #:optional output)
"Perform the download described by DRV, a fixed-output derivation, to
OUTPUT.
Note: We don't read the value of 'out' in DRV since the actual output is
different from that when we're doing a 'bmCheck' or 'bmRepair' build."
Note: Unless OUTPUT is #f, we don't read the value of 'out' in DRV since the
actual output is different from that when we're doing a 'bmCheck' or
'bmRepair' build."
(derivation-let drv ((url "url")
(output* "out")
(executable "executable")
(mirrors "mirrors")
(content-addressed-mirrors "content-addressed-mirrors"))
(unless url
(leave (_ "~a: missing URL~%") (derivation-file-name drv)))
(let* ((url (call-with-input-string url read))
(let* ((output (or output output*))
(url (call-with-input-string url read))
(drv-output (assoc-ref (derivation-outputs drv) "out"))
(algo (derivation-output-hash-algo drv-output))
(hash (derivation-output-hash drv-output)))
@ -94,17 +97,20 @@ the daemon and not explicitly described as an input of the derivation. This
allows us to sidestep bootstrapping problems, such downloading the source code
of GnuTLS over HTTPS, before we have built GnuTLS. See
<http://bugs.gnu.org/22774>."
;; This program must be invoked by guix-daemon under an unprivileged UID to
;; prevent things downloading from 'file:///etc/shadow' or arbitrary code
;; execution via the content-addressed mirror procedures. (That means we
;; exclude users who did not pass '--build-users-group'.)
(with-error-handling
(match args
(((? derivation-path? drv) (? store-path? output))
;; This program must be invoked by guix-daemon under an unprivileged
;; UID to prevent things downloading from 'file:///etc/shadow' or
;; arbitrary code execution via the content-addressed mirror
;; procedures. (That means we exclude users who did not pass
;; '--build-users-group'.)
(assert-low-privileges)
(perform-download (call-with-input-file drv read-derivation)
output))
(((? derivation-path? drv)) ;backward compatibility
(assert-low-privileges)
(perform-download (call-with-input-file drv read-derivation)))
(("--version")
(show-version-and-exit))
(x

52
guix/ui.scm
View file

@ -332,39 +332,39 @@ Report bugs to: ~a.") %guix-bug-report-address)
General help using GNU software: <http://www.gnu.org/gethelp/>"))
(newline))
(define (augmented-system-error-handler file)
"Return a 'system-error' handler that mentions FILE in its message."
(lambda (key proc fmt args errno)
;; Augment the FMT and ARGS with information about TARGET (this
;; information is missing as of Guile 2.0.11, making the exception
;; uninformative.)
(apply throw key proc "~A: ~S"
(list (strerror (car errno)) file)
(list errno))))
(define-syntax-rule (error-reporting-wrapper proc (args ...) file)
"Wrap PROC such that its 'system-error' exceptions are augmented to mention
FILE."
(let ((real-proc (@ (guile) proc)))
(lambda (args ...)
(catch 'system-error
(lambda ()
(real-proc args ...))
(augmented-system-error-handler file)))))
(set! symlink
;; We 'set!' the global binding because (gnu build ...) modules and similar
;; typically don't use (guix ui).
(let ((real-symlink (@ (guile) symlink)))
(lambda (target link)
"This is a 'symlink' replacement that provides proper error reporting."
(catch 'system-error
(lambda ()
(real-symlink target link))
(lambda (key proc fmt args errno)
;; Augment the FMT and ARGS with information about LINK (this
;; information is missing as of Guile 2.0.11, making the exception
;; uninformative.)
(apply throw key proc "~A: ~S"
(list (strerror (car errno)) link)
(list errno)))))))
(error-reporting-wrapper symlink (source target) target))
(set! copy-file
;; Note: here we use 'set!', not #:replace, because UIs typically use
;; 'copy-recursively', which doesn't use (guix ui).
(let ((real-copy-file (@ (guile) copy-file)))
(lambda (source target)
"This is a 'copy-file' replacement that provides proper error reporting."
(catch 'system-error
(lambda ()
(real-copy-file source target))
(lambda (key proc fmt args errno)
;; Augment the FMT and ARGS with information about TARGET (this
;; information is missing as of Guile 2.0.11, making the exception
;; uninformative.)
(apply throw key proc "~A: ~S"
(list (strerror (car errno)) target)
(list errno)))))))
(error-reporting-wrapper copy-file (source target) target))
(set! canonicalize-path
(error-reporting-wrapper canonicalize-path (file) file))
(define (make-regexp* regexp . flags)
"Like 'make-regexp' but error out if REGEXP is invalid, reporting the error

62
tests/challenge.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -69,8 +69,15 @@
(built-derivations (list drv))
(mlet %store-monad ((hash (query-path-hash* out)))
(with-derivation-narinfo* drv (sha256 => hash)
(>>= (discrepancies (list out) (%test-substitute-urls))
(lift1 null? %store-monad))))))))
(>>= (compare-contents (list out) (%test-substitute-urls))
(match-lambda
((report)
(return
(and (string=? out (comparison-report-item report))
(bytevector=?
(comparison-report-local-sha256 report)
hash)
(comparison-report-match? report))))))))))))
(test-assertm "one discrepancy"
(let ((text (random-text)))
@ -90,20 +97,57 @@
(modulo (+ b 1) 128))
w)))
(with-derivation-narinfo* drv (sha256 => wrong-hash)
(>>= (discrepancies (list out) (%test-substitute-urls))
(>>= (compare-contents (list out) (%test-substitute-urls))
(match-lambda
((discrepancy)
((report)
(return
(and (string=? out (discrepancy-item discrepancy))
(and (string=? out (comparison-report-item (pk report)))
(eq? 'mismatch (comparison-report-result report))
(bytevector=? hash
(discrepancy-local-sha256
discrepancy))
(match (discrepancy-narinfos discrepancy)
(comparison-report-local-sha256
report))
(match (comparison-report-narinfos report)
((bad)
(bytevector=? wrong-hash
(narinfo-hash->sha256
(narinfo-hash bad))))))))))))))))
(test-assertm "inconclusive: no substitutes"
(mlet* %store-monad ((drv (gexp->derivation "foo" #~(mkdir #$output)))
(out -> (derivation->output-path drv))
(_ (built-derivations (list drv)))
(hash (query-path-hash* out)))
(>>= (compare-contents (list out) (%test-substitute-urls))
(match-lambda
((report)
(return
(and (string=? out (comparison-report-item report))
(comparison-report-inconclusive? report)
(null? (comparison-report-narinfos report))
(bytevector=? (comparison-report-local-sha256 report)
hash))))))))
(test-assertm "inconclusive: no local build"
(let ((text (random-text)))
(mlet* %store-monad ((drv (gexp->derivation "something"
#~(list #$output #$text)))
(out -> (derivation->output-path drv))
(hash -> (sha256 #vu8())))
(with-derivation-narinfo* drv (sha256 => hash)
(>>= (compare-contents (list out) (%test-substitute-urls))
(match-lambda
((report)
(return
(and (string=? out (comparison-report-item report))
(comparison-report-inconclusive? report)
(not (comparison-report-local-sha256 report))
(match (comparison-report-narinfos report)
((narinfo)
(bytevector=? (narinfo-hash->sha256
(narinfo-hash narinfo))
hash))))))))))))
(test-end)
;;; Local Variables: