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

Merge branch 'master' into core-updates

This commit is contained in:
Marius Bakke 2019-07-22 18:58:48 +02:00
parent d478cc0435 2698654446
commit ccad0e4d69
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
42 changed files with 1493 additions and 287 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.am
View File

@ -375,6 +375,7 @@ SCM_TESTS = \
tests/modules.scm \ tests/modules.scm \
tests/gnu-maintenance.scm \ tests/gnu-maintenance.scm \
tests/substitute.scm \ tests/substitute.scm \
tests/swh.scm \
tests/builders.scm \ tests/builders.scm \
tests/derivations.scm \ tests/derivations.scm \
tests/glob.scm \ tests/glob.scm \

2
doc/guix.texi
View File

@ -8674,7 +8674,7 @@ example package definition in JSON format:
"synopsis": "Hello, GNU world: An example GNU package", "synopsis": "Hello, GNU world: An example GNU package",
"description": "GNU Hello prints a greeting.", "description": "GNU Hello prints a greeting.",
"license": "GPL-3.0+", "license": "GPL-3.0+",
"native-inputs": ["gcc@@6"] "native-inputs": ["gettext"]
@} @}
@end example @end example

1
gnu/local.mk
View File

@ -747,6 +747,7 @@ dist_patch_DATA = \
%D%/packages/patches/cube-nocheck.patch \ %D%/packages/patches/cube-nocheck.patch \
%D%/packages/patches/cursynth-wave-rand.patch \ %D%/packages/patches/cursynth-wave-rand.patch \
%D%/packages/patches/cvs-CVE-2017-12836.patch \ %D%/packages/patches/cvs-CVE-2017-12836.patch \
%D%/packages/patches/darkice-workaround-fpermissive-error.patch \
%D%/packages/patches/dbus-helper-search-path.patch \ %D%/packages/patches/dbus-helper-search-path.patch \
%D%/packages/patches/dealii-mpi-deprecations.patch \ %D%/packages/patches/dealii-mpi-deprecations.patch \
%D%/packages/patches/deja-dup-use-ref-keyword-for-iter.patch \ %D%/packages/patches/deja-dup-use-ref-keyword-for-iter.patch \

33
gnu/packages/audio.scm
View File

@ -3743,3 +3743,36 @@ binaural beat tracks of different frequencies and exporting of tracks into
different audio formats. Gnaural can also be linked over the internet with different audio formats. Gnaural can also be linked over the internet with
other Gnaural instances, allowing synchronous sessions between many users.") other Gnaural instances, allowing synchronous sessions between many users.")
(license license:gpl2+))) (license license:gpl2+)))
(define-public darkice
(package
(name "darkice")
(version "1.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/darkice/darkice/"
version "/darkice-" version ".tar.gz"))
(sha256
(base32 "1rlxds7ssq7nk2in4s46xws7xy9ylxsqgcz85hxjgh17lsm0y39c"))
(patches
(search-patches "darkice-workaround-fpermissive-error.patch"))))
(build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config)))
(inputs `(("lame" ,lame)
("libvorbis" ,libvorbis)
("opus" ,opus)
("twolame" ,twolame)
("alsa-lib" ,alsa-lib)
("pulseaudio" ,pulseaudio)
("jack" ,jack-1)
("libsamplerate" ,libsamplerate)))
(arguments
`(#:configure-flags
(list (string-append "--with-lame-prefix="
(assoc-ref %build-inputs "lame")))))
(home-page "http://www.darkice.org/")
(synopsis "Live audio streamer")
(description "DarkIce is a live audio streamer. It takes audio input from
a sound card, encodes it into Ogg Vorbis and/or mp3, and sends the audio
stream to one or more IceCast and/or ShoutCast servers.")
(license license:gpl3+)))

2
gnu/packages/backup.scm
View File

@ -607,7 +607,7 @@ detection, and lossless compression.")
;; transitional package for now: ;; transitional package for now:
;; <https://bugs.gnu.org/30662> ;; <https://bugs.gnu.org/30662>
("python-msgpack" ,python-msgpack-transitional) ("python-msgpack" ,python-msgpack-transitional)
("zstd" ,zstd))) ("zstd" ,zstd "lib")))
(synopsis "Deduplicated, encrypted, authenticated and compressed backups") (synopsis "Deduplicated, encrypted, authenticated and compressed backups")
(description "Borg is a deduplicating backup program. Optionally, it (description "Borg is a deduplicating backup program. Optionally, it
supports compression and authenticated encryption. The main goal of Borg is to supports compression and authenticated encryption. The main goal of Borg is to

8
gnu/packages/bioinformatics.scm
View File

@ -4035,9 +4035,11 @@ performance.")
"16ljv43sc3fxmv63w7b2ff8m1s7h89xhazwmbm1bicz8axq8fjz0")))) "16ljv43sc3fxmv63w7b2ff8m1s7h89xhazwmbm1bicz8axq8fjz0"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("openssl" ,openssl) `(("curl" ,curl)
("curl" ,curl) ("openssl" ,openssl)))
("zlib" ,zlib))) ;; This is referred to in the pkg-config file as a required library.
(propagated-inputs
`(("zlib" ,zlib)))
(native-inputs (native-inputs
`(("perl" ,perl))) `(("perl" ,perl)))
(home-page "http://www.htslib.org") (home-page "http://www.htslib.org")

6
gnu/packages/chromium.scm
View File

@ -408,9 +408,6 @@ from forcing GEXP-PROMISE."
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f `(#:tests? #f
;; Chromiums build processes may consume up to 8GiB of memory per core.
;; Disable parallel builds to avoid thrashing end user systems.
#:parallel-build? #f
;; FIXME: Chromiums RUNPATH lacks entries for some libraries, so ;; FIXME: Chromiums RUNPATH lacks entries for some libraries, so
;; we have to disable validation and add a wrapper below. ;; we have to disable validation and add a wrapper below.
#:validate-runpath? #f #:validate-runpath? #f
@ -467,6 +464,9 @@ from forcing GEXP-PROMISE."
;; Optimize for building everything at once, as opposed to ;; Optimize for building everything at once, as opposed to
;; incrementally for development. See "docs/jumbo.md". ;; incrementally for development. See "docs/jumbo.md".
"use_jumbo_build=true" "use_jumbo_build=true"
;; The default file merge limit of 50 requires huge amounts of RAM.
;; Cap it to make sure the build succeeds on commodity hardware.
"jumbo_file_merge_limit=8"
;; Prefer system libraries. ;; Prefer system libraries.
"use_system_freetype=true" "use_system_freetype=true"

34
gnu/packages/compression.scm
View File

@ -1387,22 +1387,50 @@ or junctions, and always follows hard links.")
(define-public zstd (define-public zstd
(package (package
(name "zstd") (name "zstd")
(version "1.3.8") (version "1.4.1")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://github.com/facebook/zstd/releases/download/" (uri (string-append "https://github.com/facebook/zstd/releases/download/"
"v" version "/zstd-" version ".tar.gz")) "v" version "/zstd-" version ".tar.gz"))
(sha256 (sha256
(base32 "13nlsqhkn276frxrzjdn7wz0j9zz414lf336885ykyxcvw2a0gr9")))) (base32 "180sfl0iz5hy43xcr0gh8kz2vxgpb8rh5d7wmpxn3bxkgs320l2k"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" ;1.1MiB executables and documentation
"lib" ;1MiB shared library and headers
"static")) ;1MiB static library
(arguments (arguments
`(#:phases `(#:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(delete 'configure)) ; no configure script (delete 'configure) ;no configure script
(add-after 'install 'adjust-library-locations
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(lib (assoc-ref outputs "lib"))
(static (assoc-ref outputs "static"))
(shared-libs (string-append lib "/lib"))
(static-libs (string-append static "/lib")))
;; Move the static library to its own output to save ~1MiB.
(mkdir-p static-libs)
(for-each (lambda (ar)
(link ar (string-append static-libs "/"
(basename ar)))
(delete-file ar))
(find-files shared-libs "\\.a$"))
;; While here, remove prefix= from the pkg-config file because it
;; is unused, and because it contains a needless reference to $out.
;; XXX: It would be great if #:disallow-references worked between
;; outputs.
(substitute* (string-append shared-libs "/pkgconfig/libzstd.pc")
(("^prefix=.*") ""))
#t))))
#:make-flags #:make-flags
(list "CC=gcc" (list "CC=gcc"
(string-append "PREFIX=" (assoc-ref %outputs "out")) (string-append "PREFIX=" (assoc-ref %outputs "out"))
(string-append "LIBDIR=" (assoc-ref %outputs "lib") "/lib")
(string-append "INCLUDEDIR=" (assoc-ref %outputs "lib") "/include")
;; Skip auto-detection of, and creating a dependency on, the build ;; Skip auto-detection of, and creating a dependency on, the build
;; environment's ‘xz’ for what amounts to a dubious feature anyway. ;; environment's ‘xz’ for what amounts to a dubious feature anyway.
"HAVE_LZMA=0" "HAVE_LZMA=0"

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

@ -49,6 +49,7 @@
;;; Copyright © 2019 LaFreniere, Joseph <joseph@lafreniere.xyz> ;;; Copyright © 2019 LaFreniere, Joseph <joseph@lafreniere.xyz>
;;; Copyright © 2019 Amar Singh <nly@disroot.org> ;;; Copyright © 2019 Amar Singh <nly@disroot.org>
;;; Copyright © 2019 Baptiste Strazzulla <bstrazzull@hotmail.fr> ;;; Copyright © 2019 Baptiste Strazzulla <bstrazzull@hotmail.fr>
;;; Copyright © 2019 Giacomo Leidi <goodoldpaul@autitici.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -4577,7 +4578,7 @@ automatically.")
(define-public emacs-ivy (define-public emacs-ivy
(package (package
(name "emacs-ivy") (name "emacs-ivy")
(version "0.11.0") (version "0.12.0")
(source (source
(origin (origin
(method git-fetch) (method git-fetch)
@ -4587,7 +4588,7 @@ automatically.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"009n8zjycs62cv4i1k9adbb284wz2w3r13xki2740sj34k683v13")))) "0xgngn3jhmyn6mlkk9kmgfgh0w5i50b27syr4cgfgarg6p77j05w"))))
(build-system emacs-build-system) (build-system emacs-build-system)
(arguments (arguments
`(#:phases `(#:phases
@ -16720,3 +16721,29 @@ directories, direct visualisation of image files, jumping directly to links by
name (with autocompletion), a simple bookmark management system and name (with autocompletion), a simple bookmark management system and
connections using TLS encryption.") connections using TLS encryption.")
(license license:gpl3+))) (license license:gpl3+)))
(define-public emacs-zerodark-theme
(package
(name "emacs-zerodark-theme")
(version "4.5")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://gitlab.petton.fr/nico/zerodark-theme.git")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"0nnlxzsmhsbszqigcyxak9i1a0digrd13gv6v18ck4h760mihh1m"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-all-the-icons" ,emacs-all-the-icons)))
(home-page
"https://gitlab.petton.fr/nico/zerodark-theme")
(synopsis
"Dark, medium contrast theme for Emacs")
(description
"Zerodark is a dark theme inspired from One Dark and Niflheim.
An optional mode-line format can be enabled with @code{zerodark-setup-modeline-format}.")
(license license:gpl3+)))

19
gnu/packages/geo.scm
View File

@ -607,6 +607,25 @@ utilities for data translation and processing.")
;; frmts/mrf/libLERC ;; frmts/mrf/libLERC
license:asl2.0)))) license:asl2.0))))
(define-public python-gdal
(package (inherit gdal)
(name "python-gdal")
(build-system python-build-system)
(arguments
'(#:tests? #f ; no tests
#:phases
(modify-phases %standard-phases
(add-before 'build 'chdir
(lambda _
(chdir "swig/python")
#t)))))
(native-inputs '())
(propagated-inputs
`(("python-numpy" ,python-numpy)))
(inputs
`(("gdal" ,gdal)))
(synopsis "GDAL (Geospatial Data Abstraction Library) python bindings")))
(define-public postgis (define-public postgis
(package (package
(name "postgis") (name "postgis")

416
gnu/packages/haskell.scm
View File

@ -42,6 +42,7 @@
#:use-module (gnu packages check) #:use-module (gnu packages check)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages elf) #:use-module (gnu packages elf)
#:use-module (gnu packages emacs)
#:use-module (gnu packages gcc) #:use-module (gnu packages gcc)
#:use-module (gnu packages ghostscript) #:use-module (gnu packages ghostscript)
#:use-module (gnu packages gl) #:use-module (gnu packages gl)
@ -11347,6 +11348,421 @@ stand for certain ASCII character sequences, i.e. → instead of @code{->},
∀ instead of @code{forall} and many others.") ∀ instead of @code{forall} and many others.")
(license license:bsd-3))) (license license:bsd-3)))
(define-public ghc-genvalidity
(package
(name "ghc-genvalidity")
(version "0.5.1.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/genvalidity/genvalidity-"
version
".tar.gz"))
(sha256
(base32
"17ykq38j9a2lzir6dqz5jgy6ndaafrpkhqhcg96c5ppg7wcxaaj0"))))
(build-system haskell-build-system)
(inputs
`(("ghc-quickcheck" ,ghc-quickcheck)
("ghc-validity" ,ghc-validity)))
(native-inputs
`(("ghc-hspec" ,ghc-hspec)
("hspec-discover" ,hspec-discover)
("ghc-hspec-core" ,ghc-hspec-core)))
(home-page
"https://github.com/NorfairKing/validity")
(synopsis
"Testing utilities for the @code{validity} library")
(description
"This package provides testing utilities that are useful in conjunction
with the @code{Validity} typeclass.")
(license license:expat)))
(define-public ghc-genvalidity-property
(package
(name "ghc-genvalidity-property")
(version "0.2.1.1")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/"
"genvalidity-property/genvalidity-property-"
version
".tar.gz"))
(sha256
(base32
"0cjw5i2pydidda9bnp6x37ylhxdk9g874x5sadr6sscg5kq85a1b"))))
(build-system haskell-build-system)
(inputs
`(("ghc-quickcheck" ,ghc-quickcheck)
("ghc-genvalidity" ,ghc-genvalidity)
("ghc-hspec" ,ghc-hspec)
("hspec-discover" ,hspec-discover)
("ghc-validity" ,ghc-validity)))
(native-inputs `(("ghc-doctest" ,ghc-doctest)))
(home-page
"https://github.com/NorfairKing/validity")
(synopsis
"Standard properties for functions on @code{Validity} types")
(description
"This package supplements the @code{Validity} typeclass with standard
properties for functions operating on them.")
(license license:expat)))
(define-public ghc-validity
(package
(name "ghc-validity")
(version "0.7.0.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/validity/validity-"
version
".tar.gz"))
(sha256
(base32
"0xribw98amafihw87ddajk6vlirp7w9b26lrnjgq7jfm4710j95f"))))
(build-system haskell-build-system)
(native-inputs `(("ghc-hspec" ,ghc-hspec)
("hspec-discover" ,hspec-discover)))
(home-page
"https://github.com/NorfairKing/validity")
(synopsis "Validity typeclass")
(description
"Values of custom types usually have invariants imposed upon them. This
package provides the @code{Validity} type class, which makes these invariants
explicit by providing a function to check whether the invariants hold.")
(license license:expat)))
(define-public ghc-path
(package
(name "ghc-path")
(version "0.6.1")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/path/path-"
version
".tar.gz"))
(sha256
(base32
"0nayla4k1gb821k8y5b9miflv1bi8f0czf9rqr044nrr2dddi2sb"))))
(build-system haskell-build-system)
(arguments
;; TODO: There are some Windows-related tests and modules that need to be
;; danced around.
`(#:tests? #f
#:cabal-revision
("1" "05b1zwx2a893h4h5wvgpc5g5pyx71hfmx409rqisd8s1bq1hn463")))
(inputs
`(("ghc-aeson" ,ghc-aeson)
("ghc-exceptions" ,ghc-exceptions)
("ghc-hashable" ,ghc-hashable)))
(native-inputs
`(("ghc-hspec" ,ghc-hspec)
("ghc-quickcheck" ,ghc-quickcheck)
("ghc-genvalidity" ,ghc-genvalidity)
("ghc-genvalidity-property" ,ghc-genvalidity-property)
("ghc-hspec" ,ghc-hspec)
("ghc-validity" ,ghc-validity)))
(home-page
"http://hackage.haskell.org/package/path")
(synopsis "Support for well-typed paths")
(description "This package introduces a type for paths upholding useful
invariants.")
(license license:bsd-3)))
(define-public ghc-path-io
(package
(name "ghc-path-io")
(version "1.3.3")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/path-io/path-io-"
version
".tar.gz"))
(sha256
(base32
"1g9m3qliqjk1img894wsb89diym5zrq51qkkrwhz4sbm9a8hbv1a"))))
(build-system haskell-build-system)
(inputs
`(("ghc-dlist" ,ghc-dlist)
("ghc-exceptions" ,ghc-exceptions)
("ghc-path" ,ghc-path)
("ghc-transformers-base" ,ghc-transformers-base)
("ghc-unix-compat" ,ghc-unix-compat)
("ghc-temporary" ,ghc-temporary)))
(native-inputs
`(("ghc-hspec" ,ghc-hspec)))
(arguments
`(#:cabal-revision
("3" "1h9hsibbflkxpjl2fqamqiv3x3gasf51apnmklrs9l9x8r32hzcc")))
(home-page
"https://github.com/mrkkrp/path-io")
(synopsis "Functions for manipulating well-typed paths")
(description "This package provides an interface to the @code{directory}
package for users of @code{path}. It also implements some missing stuff like
recursive scanning and copying of directories, working with temporary
files/directories, and more.")
(license license:bsd-3)))
(define-public ghc-hindent
(package
(name "ghc-hindent")
(version "5.3.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/hindent/hindent-"
version
".tar.gz"))
(sha256
(base32
"0wkfik7mvqskk23kyh7ybgnlh3j9j1ym7d3ncahsbli9w654b7xg"))))
(build-system haskell-build-system)
(arguments
`(#:modules ((guix build haskell-build-system)
(guix build utils)
(guix build emacs-utils))
#:imported-modules (,@%haskell-build-system-modules
(guix build emacs-utils))
#:phases
(modify-phases %standard-phases
(add-after 'install 'emacs-install
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(elisp-file "elisp/hindent.el")
(dest (string-append out "/share/emacs/site-lisp"
"/guix.d/hindent-" ,version))
(emacs (string-append (assoc-ref inputs "emacs")
"/bin/emacs")))
(make-file-writable elisp-file)
(emacs-substitute-variables elisp-file
("hindent-process-path"
(string-append out "/bin/hindent")))
(install-file elisp-file dest)
(emacs-generate-autoloads "hindent" dest)))))))
(inputs
`(("ghc-haskell-src-exts" ,ghc-haskell-src-exts)
("ghc-monad-loops" ,ghc-monad-loops)
("ghc-utf8-string" ,ghc-utf8-string)
("ghc-exceptions" ,ghc-exceptions)
("ghc-yaml" ,ghc-yaml)
("ghc-unix-compat" ,ghc-unix-compat)
("ghc-path" ,ghc-path)
("ghc-path-io" ,ghc-path-io)
("ghc-optparse-applicative" ,ghc-optparse-applicative)))
(native-inputs
`(("ghc-hspec" ,ghc-hspec)
("ghc-diff" ,ghc-diff)
("emacs" ,emacs-minimal)))
(home-page
"https://github.com/commercialhaskell/hindent")
(synopsis "Extensible Haskell pretty printer")
(description
"This package provides automatic formatting for Haskell files. Both a
library and an executable.")
(license license:bsd-3)))
(define-public ghc-descriptive
(package
(name "ghc-descriptive")
(version "0.9.5")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/descriptive/descriptive-"
version
".tar.gz"))
(sha256
(base32
"0y5693zm2kvqjilybbmrcv1g6n6x2p6zjgi0k0axjw1sdhh1g237"))))
(build-system haskell-build-system)
(inputs
`(("ghc-aeson" ,ghc-aeson)
("ghc-bifunctors" ,ghc-bifunctors)
("ghc-scientific" ,ghc-scientific)
("ghc-vector" ,ghc-vector)))
(native-inputs
`(("ghc-hunit" ,ghc-hunit)
("ghc-hspec" ,ghc-hspec)))
(home-page
"https://github.com/chrisdone/descriptive")
(synopsis
"Self-describing consumers/parsers: forms, cmd-line args, JSON, etc.")
(description
"This package provides datatypes and functions for creating consumers
and parsers with useful semantics.")
(license license:bsd-3)))
(define-public ghc-exactprint
(package
(name "ghc-exactprint")
(version "0.5.6.1")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/"
"ghc-exactprint/ghc-exactprint-" version ".tar.gz"))
(sha256
(base32
"141k6qiys0m0r4br7ikp4i546vs3xcil9cwglzcdfcbnb5nj1z87"))))
(build-system haskell-build-system)
(inputs
`(("ghc-paths" ,ghc-paths)
("ghc-syb" ,ghc-syb)
("ghc-free" ,ghc-free)))
(native-inputs
`(("ghc-hunit" ,ghc-hunit)
("ghc-diff" ,ghc-diff)
("ghc-silently" ,ghc-silently)
("ghc-filemanip" ,ghc-filemanip)))
(home-page
"http://hackage.haskell.org/package/ghc-exactprint")
(synopsis "ExactPrint for GHC")
(description
"Using the API Annotations available from GHC 7.10.2, this library
provides a means to round-trip any code that can be compiled by GHC, currently
excluding @file{.lhs} files.")
(license license:bsd-3)))
(define-public ghc-microlens-mtl
(package
(name "ghc-microlens-mtl")
(version "0.1.11.1")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/microlens-mtl/microlens-mtl-"
version
".tar.gz"))
(sha256
(base32
"0l6z1gkzwcpv89bxf5vgfrjb6gq2pj7sjjc53nvi5b9alx34zryk"))))
(build-system haskell-build-system)
(inputs
`(("ghc-microlens" ,ghc-microlens)
("ghc-transformers-compat" ,ghc-transformers-compat)))
(home-page "https://github.com/monadfix/microlens")
(synopsis
"@code{microlens} support for Reader/Writer/State from mtl")
(description
"This package contains functions (like @code{view} or @code{+=}) which
work on @code{MonadReader}, @code{MonadWriter}, and @code{MonadState} from the
mtl package. This package is a part of the
@uref{http://hackage.haskell.org/package/microlens, microlens} family; see the
readme @uref{https://github.com/aelve/microlens#readme, on Github}.")
(license license:bsd-3)))
(define-public ghc-microlens-ghc
(package
(name "ghc-microlens-ghc")
(version "0.4.9.1")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/microlens-ghc/microlens-ghc-"
version
".tar.gz"))
(sha256
(base32
"03iwgg8zww9irv59l70c8yy7vzxir1zf66y12210xk91k5hq6jrj"))))
(build-system haskell-build-system)
(inputs `(("ghc-microlens" ,ghc-microlens)))
(home-page "https://github.com/monadfix/microlens")
(synopsis "Use @code{microlens} with GHC libraries like @code{array}")
(description "This library provides everything that @code{microlens}
provides plus instances to make @code{each}, @code{at}, and @code{ix}
usable with arrays, @code{ByteString}, and containers. This package is
a part of the @uref{http://hackage.haskell.org/package/microlens,
microlens} family; see the readme
@uref{https://github.com/aelve/microlens#readme, on Github}.")
(license license:bsd-3)))
(define-public ghc-microlens-platform
(package
(name "ghc-microlens-platform")
(version "0.3.10")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/"
"microlens-platform/microlens-platform-" version ".tar.gz"))
(sha256
(base32
"1d4nhmgf9jq0ixc7qhwm7aaw3xdr0nalw58d0ydsydgf02cyazwv"))))
(build-system haskell-build-system)
(inputs
`(("ghc-hashable" ,ghc-hashable)
("ghc-microlens" ,ghc-microlens)
("ghc-microlens-ghc" ,ghc-microlens-ghc)
("ghc-microlens-mtl" ,ghc-microlens-mtl)
("ghc-microlens-th" ,ghc-microlens-th)
("ghc-unordered-containers" ,ghc-unordered-containers)
("ghc-vector" ,ghc-vector)))
(home-page "https://github.com/monadfix/microlens")
(synopsis "Feature-complete microlens")
(description
"This package exports a module which is the recommended starting point
for using @uref{http://hackage.haskell.org/package/microlens, microlens} if
you aren't trying to keep your dependencies minimal. By importing
@code{Lens.Micro.Platform} you get all functions and instances from
@uref{http://hackage.haskell.org/package/microlens, microlens},
@uref{http://hackage.haskell.org/package/microlens-th, microlens-th},
@uref{http://hackage.haskell.org/package/microlens-mtl, microlens-mtl},
@uref{http://hackage.haskell.org/package/microlens-ghc, microlens-ghc}, as
well as instances for @code{Vector}, @code{Text}, and @code{HashMap}. The
minor and major versions of @code{microlens-platform} are incremented whenever
the minor and major versions of any other @code{microlens} package are
incremented, so you can depend on the exact version of
@code{microlens-platform} without specifying the version of @code{microlens}
you need. This package is a part of the
@uref{http://hackage.haskell.org/package/microlens, microlens} family; see the
readme @uref{https://github.com/aelve/microlens#readme, on Github}.")
(license license:bsd-3)))
(define-public ghc-hasktags
(package
(name "ghc-hasktags")
(version "0.71.2")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/hasktags/hasktags-"
version
".tar.gz"))
(sha256
(base32
"1s2k9qrgy1jily96img2pmn7g35mwnnfiw6si3aw32jfhg5zsh1c"))))
(build-system haskell-build-system)
(inputs
`(("ghc-system-filepath" ,ghc-system-filepath)
("ghc-optparse-applicative" ,ghc-optparse-applicative)))
(native-inputs
`(("ghc-json" ,ghc-json)
("ghc-utf8-string" ,ghc-utf8-string)
("ghc-microlens-platform" ,ghc-microlens-platform)
("ghc-hunit" ,ghc-hunit)))
(home-page "http://github.com/MarcWeber/hasktags")
(synopsis "Make @code{Ctags} and @code{Etags} files for Haskell programs")
(description
"This package provides a means of generating tag files for Emacs and
Vim.")
(license license:bsd-3)))
(define-public ghc-stylish-haskell (define-public ghc-stylish-haskell
(package (package
(name "ghc-stylish-haskell") (name "ghc-stylish-haskell")

10
gnu/packages/libreoffice.scm
View File

@ -11,6 +11,7 @@
;;; Copyright © 2017 Rutger Helling <rhelling@mykolab.com> ;;; Copyright © 2017 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Jonathan Brielmaier <jonathan.brielmaier@web.de> ;;; Copyright © 2018 Jonathan Brielmaier <jonathan.brielmaier@web.de>
;;; Copyright © 2019 Chris Marusich <cmmarusich@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -53,6 +54,7 @@
#:use-module (gnu packages documentation) #:use-module (gnu packages documentation)
#:use-module (gnu packages flex) #:use-module (gnu packages flex)
#:use-module (gnu packages fontutils) #:use-module (gnu packages fontutils)
#:use-module (gnu packages freedesktop)
#:use-module (gnu packages ghostscript) #:use-module (gnu packages ghostscript)
#:use-module (gnu packages gl) #:use-module (gnu packages gl)
#:use-module (gnu packages glib) #:use-module (gnu packages glib)
@ -1051,6 +1053,7 @@ converting QuarkXPress file format. It supports versions 3.1 to 4.1.")
("unixodbc" ,unixodbc) ("unixodbc" ,unixodbc)
("unzip" ,unzip) ("unzip" ,unzip)
("vigra" ,vigra) ("vigra" ,vigra)
("xdg-utils" ,xdg-utils)
("xmlsec" ,xmlsec-nss) ("xmlsec" ,xmlsec-nss)
("zip" ,zip))) ("zip" ,zip)))
(arguments (arguments
@ -1083,6 +1086,13 @@ converting QuarkXPress file format. It supports versions 3.1 to 4.1.")
(assoc-ref inputs "gpgme") (assoc-ref inputs "gpgme")
"/include/gpgme++"))) "/include/gpgme++")))
;; /usr/bin/xdg-open doesn't exist on Guix System.
(substitute* '("shell/source/unix/exec/shellexec.cxx"
"shell/source/unix/misc/senddoc.sh")
(("/usr/bin/xdg-open")
(string-append (assoc-ref inputs "xdg-utils")
"/bin/xdg-open")))
#t)) #t))
(add-after 'install 'bin-and-desktop-install (add-after 'install 'bin-and-desktop-install
;; Create 'soffice' and 'libreoffice' symlinks to the executable ;; Create 'soffice' and 'libreoffice' symlinks to the executable

477
gnu/packages/linux.scm
View File

@ -127,6 +127,9 @@
#:use-module (guix git-download) #:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-2) #:use-module (srfi srfi-2)
@ -155,6 +158,174 @@ defconfig. Return the appropriate make target if applicable, otherwise return
((string-prefix? "powerpc64le-" system) "ppc64_defconfig") ((string-prefix? "powerpc64le-" system) "ppc64_defconfig")
(else "defconfig"))) (else "defconfig")))
;;;
;;; Kernel source code deblobbing.
;;;
(define (linux-libre-deblob-scripts version
deblob-hash
deblob-check-hash)
(list (version-major+minor version)
(origin
(method url-fetch)
(uri (string-append "https://linux-libre.fsfla.org"
"/pub/linux-libre/releases/" version "-gnu/"
"deblob-" (version-major+minor version)))
(sha256 deblob-hash))
(origin
(method url-fetch)
(uri (string-append "https://linux-libre.fsfla.org"
"/pub/linux-libre/releases/" version "-gnu/"
"deblob-check"))
(sha256 deblob-check-hash))))
(define deblob-scripts-5.2
(linux-libre-deblob-scripts
"5.2.1"
(base32 "076fwxlm6jq6z4vg1xq3kr474zz7qk71r90sf9dnfia3rw2pb4fa")
(base32 "030cccchli7vnzvxcw261spyzsgnq0m113bjsz8y4vglf6gaz4n9")))
(define deblob-scripts-4.19
(linux-libre-deblob-scripts
"4.19.59"
(base32 "02zs405awaxydbapka4nz8h6lmnc0dahgczqsrs5s2bmzjyyqkcy")
(base32 "07z1bsyny8lldncfh27lb16mgx9r38nswx4vmd24c7n4xva12k2s")))
(define deblob-scripts-4.14
(linux-libre-deblob-scripts
"4.14.133"
(base32 "091jk9jkn9jf39bxpc7395bhcb7p96nkg3a8047380ki06lnfxh6")
(base32 "0x9nd3hnyrm753cbgdqmy92mbnyw86w64g4hvyibnkpq5n7s3z9n")))
(define deblob-scripts-4.9
(linux-libre-deblob-scripts
"4.9.185"
(base32 "1wvldzlv7q2xdbadas87dh593nxr4a8p5n0f8zpm72lja6w18hmg")
(base32 "1gmjn5cwxydg6qb47wcmahwkv37npsjx4papynzkkdxyidmrccya")))
(define deblob-scripts-4.4
(linux-libre-deblob-scripts
"4.4.185"
(base32 "0x2j1i88am54ih2mk7gyl79g25l9zz4r08xhl482l3fvjj2irwbw")
(base32 "1x40lbiaizksy8z38ax7wpqr9ldgq7qvkxbb0ca98vd1axpklb10")))
(define* (computed-origin-method gexp-promise hash-algo hash
#:optional (name "source")
#:key (system (%current-system))
(guile (default-guile)))
"Return a derivation that executes the G-expression that results
from forcing GEXP-PROMISE."
(mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "computed-origin")
(force gexp-promise)
#:graft? #f ;nothing to graft
#:system system
#:guile-for-build guile)))
(define (make-linux-libre-source version
upstream-source
deblob-scripts)
"Return a 'computed' origin that generates a Linux-libre tarball from the
corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
(match deblob-scripts
((deblob-version (? origin? deblob) (? origin? deblob-check))
(unless (string=? deblob-version (version-major+minor version))
;; The deblob script cannot be expected to work properly on a
;; different version (major+minor) of Linux, even if no errors
;; are signaled during execution.
(error "deblob major+minor version mismatch"))
(origin
(method computed-origin-method)
(file-name (string-append "linux-libre-" version "-guix.tar.xz"))
(sha256 #f)
(uri
(delay
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(srfi srfi-1)
(ice-9 match)
(ice-9 ftw))
(let ((dir (string-append "linux-" #$version)))
(mkdir "/tmp/bin")
(set-path-environment-variable
"PATH" '("bin")
(list "/tmp"
#+(canonical-package bash)
#+(canonical-package coreutils)
#+(canonical-package diffutils)
#+(canonical-package findutils)
#+(canonical-package patch)
#+(canonical-package xz)
#+(canonical-package sed)
#+(canonical-package grep)
#+(canonical-package bzip2)
#+(canonical-package gzip)
#+(canonical-package tar)
;; The comments in the 'deblob-check' script
;; claim that it supports Python 2 and 3, but
;; in fact it fails when run in Python 3 as
;; of version 5.1.3.
#+python-2))
(with-directory-excursion "/tmp/bin"
(copy-file #+deblob "deblob")
(chmod "deblob" #o755)
(substitute* "deblob"
(("/bin/sh") (which "sh")))
(copy-file #+deblob-check "deblob-check")
(chmod "deblob-check" #o755)
(substitute* "deblob-check"
(("/bin/sh") (which "sh"))
(("/bin/sed") (which "sed"))
(("/usr/bin/python") (which "python"))))
(if (file-is-directory? #+upstream-source)
(begin
(format #t "Copying upstream linux source...~%")
(force-output)
(invoke "cp" "--archive" #+upstream-source dir)
(invoke "chmod" "--recursive" "u+w" dir))
(begin
(format #t "Unpacking upstream linux tarball...~%")
(force-output)
(invoke "tar" "xf" #$upstream-source)
(match (scandir "."
(lambda (name)
(and (not (member name '("." "..")))
(file-is-directory? name))))
((unpacked-dir)
(unless (string=? dir unpacked-dir)
(rename-file unpacked-dir dir)))
(dirs
(error "multiple directories found" dirs)))))
(with-directory-excursion dir
(setenv "PYTHON" (which "python"))
(format #t "Running deblob script...~%")
(force-output)
(invoke "/tmp/bin/deblob"))
(format #t "~%Packing new Linux-libre tarball...~%")
(force-output)
(invoke "tar" "cfa" #$output
;; Avoid non-determinism in the archive.
"--mtime=@0"
"--owner=root:0"
"--group=root:0"
"--sort=name"
"--hard-dereference"
dir))))))))))
;;;
;;; Kernel sources.
;;;
(define (linux-libre-urls version) (define (linux-libre-urls version)
"Return a list of URLs for Linux-Libre VERSION." "Return a list of URLs for Linux-Libre VERSION."
(list (string-append (list (string-append
@ -171,14 +342,121 @@ defconfig. Return the appropriate make target if applicable, otherwise return
"mirror://gnu/linux-libre/" version "-gnu/linux-libre-" "mirror://gnu/linux-libre/" version "-gnu/linux-libre-"
version "-gnu.tar.xz"))) version "-gnu.tar.xz")))
(define (make-linux-libre-headers version hash) (define (%upstream-linux-source version hash)
(origin
(method url-fetch)
(uri (string-append "mirror://kernel.org"
"/linux/kernel/v" (version-major version) ".x/"
"linux-" version ".tar.xz"))
(sha256 hash)))
(define-public linux-libre-5.2-version "5.2.2")
(define-public linux-libre-5.2-pristine-source
(let ((version linux-libre-5.2-version)
(hash (base32 "173da67d51qcjwrczqsfd6g9phzazqzr11xfxwlf54ckd6117ng5")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-5.2)))
(define-public linux-libre-4.19-version "4.19.60")
(define-public linux-libre-4.19-pristine-source
(let ((version linux-libre-4.19-version)
(hash (base32 "0ibayrvrnw2lw7si78vdqnr20mm1d3z0g6a0ykndvgn5vdax5x9a")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-4.19)))
(define-public linux-libre-4.14-version "4.14.134")
(define-public linux-libre-4.14-pristine-source
(let ((version linux-libre-4.14-version)
(hash (base32 "0b9xj1rwr5fpw2giirfghzxxc0wp1hwf4nqvalx314pxxysyf88b")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-4.14)))
(define-public linux-libre-4.9-version "4.9.186")
(define-public linux-libre-4.9-pristine-source
(let ((version linux-libre-4.9-version)
(hash (base32 "0sjbp7m6d625rw06wv34a0805d1lgldii4pxiqfpja871m1q8914")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-4.9)))
(define-public linux-libre-4.4-version "4.4.186")
(define-public linux-libre-4.4-pristine-source
(let ((version linux-libre-4.4-version)
(hash (base32 "113rjf8842glzi23y1g1yrwncihv2saah6wz0r726r06bk9p64hb")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-4.4)))
(define %boot-logo-patch
;; Linux-Libre boot logo featuring Freedo and a gnu.
(origin
(method url-fetch)
(uri (string-append "http://www.fsfla.org/svn/fsfla/software/linux-libre/"
"lemote/gnewsense/branches/3.16/100gnu+freedo.patch"))
(sha256
(base32
"1hk9swxxc80bmn2zd2qr5ccrjrk28xkypwhl4z0qx4hbivj7qm06"))))
(define %linux-libre-arm-export-__sync_icache_dcache-patch
(origin
(method url-fetch)
(uri (string-append
"https://salsa.debian.org/kernel-team/linux"
"/raw/34a7d9011fcfcfa38b68282fd2b1a8797e6834f0"
"/debian/patches/bugfix/arm/"
"arm-mm-export-__sync_icache_dcache-for-xen-privcmd.patch"))
(file-name "linux-libre-arm-export-__sync_icache_dcache.patch")
(sha256
(base32 "1ifnfhpakzffn4b8n7x7w5cps9mzjxlkcfz9zqak2vaw8nzvl39f"))))
(define (source-with-patches source patches)
(origin
(inherit source)
(patches (append (origin-patches source)
patches))))
(define-public linux-libre-5.2-source
(source-with-patches linux-libre-5.2-pristine-source
(list %boot-logo-patch
%linux-libre-arm-export-__sync_icache_dcache-patch)))
(define-public linux-libre-4.19-source
(source-with-patches linux-libre-4.19-pristine-source
(list %boot-logo-patch
%linux-libre-arm-export-__sync_icache_dcache-patch)))
(define-public linux-libre-4.14-source
(source-with-patches linux-libre-4.14-pristine-source
(list %boot-logo-patch)))
(define-public linux-libre-4.9-source
(source-with-patches linux-libre-4.9-pristine-source
(list %boot-logo-patch)))
(define-public linux-libre-4.4-source
(source-with-patches linux-libre-4.4-pristine-source
(list %boot-logo-patch)))
;;;
;;; Kernel headers.
;;;
(define (make-linux-libre-headers version hash-string)
(make-linux-libre-headers* version
(origin
(method url-fetch)
(uri (linux-libre-urls version))
(sha256 (base32 hash-string)))))
(define (make-linux-libre-headers* version source)
(package (package
(name "linux-libre-headers") (name "linux-libre-headers")
(version version) (version version)
(source (origin (source source)
(method url-fetch)
(uri (linux-libre-urls version))
(sha256 (base32 hash))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("perl" ,perl) (native-inputs `(("perl" ,perl)
,@(if (version>=? version "4.16") ,@(if (version>=? version "4.16")
@ -232,27 +510,38 @@ defconfig. Return the appropriate make target if applicable, otherwise return
(description "Headers of the Linux-Libre kernel.") (description "Headers of the Linux-Libre kernel.")
(license license:gpl2))) (license license:gpl2)))
(define %boot-logo-patch (define-public linux-libre-headers-5.2
;; Linux-Libre boot logo featuring Freedo and a gnu. (make-linux-libre-headers* linux-libre-5.2-version
(origin linux-libre-5.2-source))
(method url-fetch)
(uri (string-append "http://www.fsfla.org/svn/fsfla/software/linux-libre/"
"lemote/gnewsense/branches/3.16/100gnu+freedo.patch"))
(sha256
(base32
"1hk9swxxc80bmn2zd2qr5ccrjrk28xkypwhl4z0qx4hbivj7qm06"))))
(define %linux-libre-arm-export-__sync_icache_dcache-patch (define-public linux-libre-headers-4.19
(origin (make-linux-libre-headers* linux-libre-4.19-version
(method url-fetch) linux-libre-4.19-source))
(uri (string-append
"https://salsa.debian.org/kernel-team/linux" (define-public linux-libre-headers-4.14
"/raw/34a7d9011fcfcfa38b68282fd2b1a8797e6834f0" (make-linux-libre-headers* linux-libre-4.14-version
"/debian/patches/bugfix/arm/" linux-libre-4.14-source))
"arm-mm-export-__sync_icache_dcache-for-xen-privcmd.patch"))
(file-name "linux-libre-arm-export-__sync_icache_dcache.patch") (define-public linux-libre-headers-4.9
(sha256 (make-linux-libre-headers* linux-libre-4.9-version
(base32 "1ifnfhpakzffn4b8n7x7w5cps9mzjxlkcfz9zqak2vaw8nzvl39f")))) linux-libre-4.9-source))
(define-public linux-libre-headers-4.4
(make-linux-libre-headers* linux-libre-4.4-version
linux-libre-4.4-source))
;; The following package is used in the early bootstrap, and thus must be kept
;; stable and with minimal build requirements.
(define-public linux-libre-headers-4.19.56
(make-linux-libre-headers "4.19.56"
"1zqiic55viy065lhnkmhn33sz3bbbr2ykbm5f92yzd8lpc9zl7yx"))
(define-public linux-libre-headers linux-libre-headers-4.19.56)
;;;
;;; Kernel configurations.
;;;
(define* (kernel-config arch #:key variant) (define* (kernel-config arch #:key variant)
"Return the absolute file name of the Linux-Libre build configuration file "Return the absolute file name of the Linux-Libre build configuration file
@ -295,7 +584,12 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
options) options)
"\n")) "\n"))
(define* (make-linux-libre version hash supported-systems
;;;
;;; Kernel package utilities.
;;;
(define* (make-linux-libre version hash-string supported-systems
#:key #:key
;; A function that takes an arch and a variant. ;; A function that takes an arch and a variant.
;; See kernel-config for an example. ;; See kernel-config for an example.
@ -304,16 +598,32 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
(defconfig "defconfig") (defconfig "defconfig")
(extra-options %default-extra-linux-options) (extra-options %default-extra-linux-options)
(patches (list %boot-logo-patch))) (patches (list %boot-logo-patch)))
(make-linux-libre* version
(origin
(method url-fetch)
(uri (linux-libre-urls version))
(sha256 (base32 hash-string))
(patches patches))
supported-systems
#:extra-version extra-version
#:configuration-file configuration-file
#:defconfig defconfig
#:extra-options extra-options))
(define* (make-linux-libre* version source supported-systems
#:key
;; A function that takes an arch and a variant.
;; See kernel-config for an example.
(extra-version #f)
(configuration-file #f)
(defconfig "defconfig")
(extra-options %default-extra-linux-options))
(package (package
(name (if extra-version (name (if extra-version
(string-append "linux-libre-" extra-version) (string-append "linux-libre-" extra-version)
"linux-libre")) "linux-libre"))
(version version) (version version)
(source (origin (source source)
(method url-fetch)
(uri (linux-libre-urls version))
(sha256 (base32 hash))
(patches patches)))
(supported-systems supported-systems) (supported-systems supported-systems)
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
@ -421,64 +731,43 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
It has been modified to remove all non-free binary blobs.") It has been modified to remove all non-free binary blobs.")
(license license:gpl2))) (license license:gpl2)))
(define %linux-libre-version "5.2.1")
(define %linux-libre-hash "1qj3zsjynz45p97n6sngdbh4xfd1jks3hbn85nmhzds6sxgg4c54") ;;;
;;; Generic kernel packages.
(define %linux-libre-5.2-patches ;;;
(list %boot-logo-patch
%linux-libre-arm-export-__sync_icache_dcache-patch))
(define-public linux-libre-5.2 (define-public linux-libre-5.2
(make-linux-libre %linux-libre-version (make-linux-libre* linux-libre-5.2-version
%linux-libre-hash linux-libre-5.2-source
'("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux") '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux")
#:patches %linux-libre-5.2-patches
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define-public linux-libre-headers-5.2 (define-public linux-libre-version linux-libre-5.2-version)
(make-linux-libre-headers %linux-libre-version (define-public linux-libre-pristine-source linux-libre-5.2-pristine-source)
%linux-libre-hash)) (define-public linux-libre-source linux-libre-5.2-source)
(define-public linux-libre linux-libre-5.2)
(define %linux-libre-4.19-version "4.19.59")
(define %linux-libre-4.19-hash "1c9qfw1mnz68ki48kg1brmv47wmsdvq41ip6202rlnmwgncj5yrw")
(define %linux-libre-4.19-patches
(list %boot-logo-patch
%linux-libre-arm-export-__sync_icache_dcache-patch))
(define-public linux-libre-4.19 (define-public linux-libre-4.19
(make-linux-libre %linux-libre-4.19-version (make-linux-libre* linux-libre-4.19-version
%linux-libre-4.19-hash linux-libre-4.19-source
'("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux") '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux")
#:patches %linux-libre-4.19-patches
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define-public linux-libre-headers-4.19
(make-linux-libre-headers %linux-libre-4.19-version
%linux-libre-4.19-hash))
(define %linux-libre-4.14-version "4.14.133")
(define %linux-libre-4.14-hash "16ay2x0r5i96lg4rgcg151352igvwxa7wh98kwdsjbckiw7fhn08")
(define-public linux-libre-4.14 (define-public linux-libre-4.14
(make-linux-libre %linux-libre-4.14-version (make-linux-libre* linux-libre-4.14-version
%linux-libre-4.14-hash linux-libre-4.14-source
'("x86_64-linux" "i686-linux" "armhf-linux") '("x86_64-linux" "i686-linux" "armhf-linux")
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define-public linux-libre-headers-4.14
(make-linux-libre-headers %linux-libre-4.14-version
%linux-libre-4.14-hash))
(define-public linux-libre-4.9 (define-public linux-libre-4.9
(make-linux-libre "4.9.185" (make-linux-libre* linux-libre-4.9-version
"1byz9cxvslm45nv01abhzvrm2isdskx5k11gi5rpa39r7lx6bmjp" linux-libre-4.9-source
'("x86_64-linux" "i686-linux") '("x86_64-linux" "i686-linux")
#:configuration-file kernel-config)) #:configuration-file kernel-config))
(define-public linux-libre-4.4 (define-public linux-libre-4.4
(make-linux-libre "4.4.185" (make-linux-libre* linux-libre-4.4-version
"0df22wqj1nwqp60v8341qcmjhwmdr0hgfraishpc7hic8aqdr4p7" linux-libre-4.4-source
'("x86_64-linux" "i686-linux") '("x86_64-linux" "i686-linux")
#:configuration-file kernel-config #:configuration-file kernel-config
#:extra-options #:extra-options
@ -488,63 +777,56 @@ It has been modified to remove all non-free binary blobs.")
("CONFIG_DEVPTS_MULTIPLE_INSTANCES" . #t)) ("CONFIG_DEVPTS_MULTIPLE_INSTANCES" . #t))
%default-extra-linux-options))) %default-extra-linux-options)))
;;;
;;; Specialized kernel variants.
;;;
(define-public linux-libre-arm-veyron (define-public linux-libre-arm-veyron
(make-linux-libre %linux-libre-version (make-linux-libre* linux-libre-version
%linux-libre-hash linux-libre-source
'("armhf-linux") '("armhf-linux")
#:patches %linux-libre-5.2-patches
#:configuration-file kernel-config-veyron #:configuration-file kernel-config-veyron
#:extra-version "arm-veyron")) #:extra-version "arm-veyron"))
(define-public linux-libre-headers-4.19.56
(make-linux-libre-headers "4.19.56"
"1zqiic55viy065lhnkmhn33sz3bbbr2ykbm5f92yzd8lpc9zl7yx"))
(define-public linux-libre-headers linux-libre-headers-4.19.56)
(define-public linux-libre linux-libre-5.2)
(define-public linux-libre-arm-generic (define-public linux-libre-arm-generic
(make-linux-libre %linux-libre-version (make-linux-libre* linux-libre-version
%linux-libre-hash linux-libre-source
'("armhf-linux") '("armhf-linux")
#:patches %linux-libre-5.2-patches
#:defconfig "multi_v7_defconfig" #:defconfig "multi_v7_defconfig"
#:extra-version "arm-generic")) #:extra-version "arm-generic"))
(define-public linux-libre-arm-generic-4.19 (define-public linux-libre-arm-generic-4.19
(make-linux-libre %linux-libre-4.19-version (make-linux-libre* linux-libre-4.19-version
%linux-libre-4.19-hash linux-libre-4.19-source
'("armhf-linux") '("armhf-linux")
#:patches %linux-libre-4.19-patches
#:defconfig "multi_v7_defconfig" #:defconfig "multi_v7_defconfig"
#:extra-version "arm-generic")) #:extra-version "arm-generic"))
(define-public linux-libre-arm-generic-4.14 (define-public linux-libre-arm-generic-4.14
(make-linux-libre %linux-libre-4.14-version (make-linux-libre* linux-libre-4.14-version
%linux-libre-4.14-hash linux-libre-4.14-source
'("armhf-linux") '("armhf-linux")
#:defconfig "multi_v7_defconfig" #:defconfig "multi_v7_defconfig"
#:extra-version "arm-generic")) #:extra-version "arm-generic"))
(define-public linux-libre-arm-omap2plus (define-public linux-libre-arm-omap2plus
(make-linux-libre %linux-libre-version (make-linux-libre* linux-libre-version
%linux-libre-hash linux-libre-source
'("armhf-linux") '("armhf-linux")
#:patches %linux-libre-5.2-patches
#:defconfig "omap2plus_defconfig" #:defconfig "omap2plus_defconfig"
#:extra-version "arm-omap2plus")) #:extra-version "arm-omap2plus"))
(define-public linux-libre-arm-omap2plus-4.19 (define-public linux-libre-arm-omap2plus-4.19
(make-linux-libre %linux-libre-4.19-version (make-linux-libre* linux-libre-4.19-version
%linux-libre-4.19-hash linux-libre-4.19-source
'("armhf-linux") '("armhf-linux")
#:patches %linux-libre-4.19-patches
#:defconfig "omap2plus_defconfig" #:defconfig "omap2plus_defconfig"
#:extra-version "arm-omap2plus")) #:extra-version "arm-omap2plus"))
(define-public linux-libre-arm-omap2plus-4.14 (define-public linux-libre-arm-omap2plus-4.14
(make-linux-libre %linux-libre-4.14-version (make-linux-libre* linux-libre-4.14-version
%linux-libre-4.14-hash linux-libre-4.14-source
'("armhf-linux") '("armhf-linux")
#:defconfig "omap2plus_defconfig" #:defconfig "omap2plus_defconfig"
#:extra-version "arm-omap2plus")) #:extra-version "arm-omap2plus"))
@ -3582,7 +3864,8 @@ and copy/paste text in the console and in xterm.")
("lzo" ,lzo) ("lzo" ,lzo)
("zlib" ,zlib) ("zlib" ,zlib)
("zlib:static" ,zlib "static") ("zlib:static" ,zlib "static")
("zstd" ,zstd))) ("zstd" ,zstd "lib")
("zstd:static" ,zstd "static")))
(native-inputs `(("pkg-config" ,pkg-config) (native-inputs `(("pkg-config" ,pkg-config)
("asciidoc" ,asciidoc) ("asciidoc" ,asciidoc)
("python" ,python) ("python" ,python)

10
gnu/packages/logging.scm
View File

@ -75,6 +75,16 @@ staying as close to their API as is reasonable.")
"1xd3maiipfbxmhc9rrblc5x52nxvkwxp14npg31y5njqvkvzax9b")) "1xd3maiipfbxmhc9rrblc5x52nxvkwxp14npg31y5njqvkvzax9b"))
(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
`(#:phases (modify-phases %standard-phases
(add-before 'check 'disable-signal-tests
(lambda _
;; XXX: This test fails on non x86_64. See e.g.
;; https://github.com/google/glog/issues/219 and
;; https://github.com/google/glog/issues/256.
(substitute* "Makefile"
(("\tsignalhandler_unittest_sh") "\t$(EMPTY)"))
#t)))))
(native-inputs (native-inputs
`(("perl" ,perl) ;for tests `(("perl" ,perl) ;for tests
("autoconf" ,autoconf-wrapper) ("autoconf" ,autoconf-wrapper)

4
gnu/packages/networking.scm
View File

@ -548,7 +548,7 @@ and up to 1 Mbit/s downstream.")
(define-public whois (define-public whois
(package (package
(name "whois") (name "whois")
(version "5.4.3") (version "5.5.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -556,7 +556,7 @@ and up to 1 Mbit/s downstream.")
name "_" version ".tar.xz")) name "_" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1hqg14k0q4979a1amgms4sa1d2iiid51rra3jyqmv63hkw189ypy")))) "0gbg9fis05zf2fl4264jplbphy75l50k3g92cz6mkmbsklrn7v34"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:tests? #f ; no test suite `(#:tests? #f ; no test suite

62
gnu/packages/patches/darkice-workaround-fpermissive-error.patch Normal file
View File

@ -0,0 +1,62 @@
Copied from Debian:
<https://sources.debian.org/data/main/d/darkice/1.3-0.2/debian/patches/0001-Cast-float-in-SRC-lib-calls-to-delete-fpermissive-co.patch>
From 1e2eb18d349f205c70cb2836232825442359b6e3 Mon Sep 17 00:00:00 2001
From: belette <ouack23@yahoo.fr>
Date: Wed, 26 Oct 2016 02:43:43 +0200
Subject: Cast float* in SRC lib calls to delete fpermissive compilation error
---
darkice/trunk/src/FaacEncoder.cpp | 2 +-
darkice/trunk/src/OpusLibEncoder.cpp | 2 +-
darkice/trunk/src/VorbisLibEncoder.cpp | 2 +-
darkice/trunk/src/aacPlusEncoder.cpp | 2 +-
4 files changed, 4 insertions(+), 4 deletions(-)
--- a/src/FaacEncoder.cpp
+++ b/src/FaacEncoder.cpp
@@ -164,7 +164,7 @@ FaacEncoder :: write ( const void * buf,
if ( converter ) {
unsigned int converted;
#ifdef HAVE_SRC_LIB
- src_short_to_float_array ((short *) b, converterData.data_in, samples);
+ src_short_to_float_array ((short *) b, (float *) converterData.data_in, samples);
converterData.input_frames = nSamples;
converterData.data_out = resampledOffset + (resampledOffsetSize * channels);
int srcError = src_process (converter, &converterData);
--- a/src/OpusLibEncoder.cpp
+++ b/src/OpusLibEncoder.cpp
@@ -403,7 +403,7 @@ OpusLibEncoder :: write ( const void * buf,
#ifdef HAVE_SRC_LIB
(void)inCount;
converterData.input_frames = processed;
- src_short_to_float_array (shortBuffer, converterData.data_in, totalSamples);
+ src_short_to_float_array (shortBuffer, (float *) converterData.data_in, totalSamples);
int srcError = src_process (converter, &converterData);
if (srcError)
throw Exception (__FILE__, __LINE__, "libsamplerate error: ", src_strerror (srcError));
--- a/src/VorbisLibEncoder.cpp
+++ b/src/VorbisLibEncoder.cpp
@@ -337,7 +337,7 @@ VorbisLibEncoder :: write ( const void * buf,
int converted;
#ifdef HAVE_SRC_LIB
converterData.input_frames = nSamples;
- src_short_to_float_array (shortBuffer, converterData.data_in, totalSamples);
+ src_short_to_float_array (shortBuffer, (float *) converterData.data_in, totalSamples);
int srcError = src_process (converter, &converterData);
if (srcError)
throw Exception (__FILE__, __LINE__, "libsamplerate error: ", src_strerror (srcError));
--- a/src/aacPlusEncoder.cpp
+++ b/src/aacPlusEncoder.cpp
@@ -155,7 +155,7 @@ aacPlusEncoder :: write ( const void * buf,
if ( converter ) {
unsigned int converted;
#ifdef HAVE_SRC_LIB
- src_short_to_float_array ((short *) b, converterData.data_in, samples);
+ src_short_to_float_array ((short *) b, (float *) converterData.data_in, samples);
converterData.input_frames = nSamples;
converterData.data_out = resampledOffset + (resampledOffsetSize * channels);
int srcError = src_process (converter, &converterData);
--
2.11.0

4
gnu/packages/perl-check.scm
View File

@ -1240,14 +1240,14 @@ makes fork(2) safe to use in test cases.")
(define-public perl-test-simple (define-public perl-test-simple
(package (package
(name "perl-test-simple") (name "perl-test-simple")
(version "1.302162") (version "1.302164")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://cpan/authors/id/E/EX/EXODIST/" (uri (string-append "mirror://cpan/authors/id/E/EX/EXODIST/"
"Test-Simple-" version ".tar.gz")) "Test-Simple-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1i0zsgp5ypygsfbl5gdsgnzlqv57bx69yl6sh440cpkk7my1k83k")))) "05b61ndlf2d6xphq13caps001f0p0p76jb5hhzmm5k897xhpn9sh"))))
(build-system perl-build-system) (build-system perl-build-system)
(synopsis "Basic utilities for writing tests") (synopsis "Basic utilities for writing tests")
(description (description

14
gnu/packages/perl.scm
View File

@ -1266,14 +1266,14 @@ arrays for their internal representation.")
(define-public perl-clone (define-public perl-clone
(package (package
(name "perl-clone") (name "perl-clone")
(version "0.41") (version "0.42")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://cpan/authors/id/G/GA/GARU/" (uri (string-append "mirror://cpan/authors/id/G/GA/GARU/"
"Clone-" version ".tar.gz")) "Clone-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"060mlm31lacirpnp5fl9jqk4m9cl07vjlh89k83qk25wykf5dh78")))) "1r87rdm0nilfayxwlzvylwc8r3hr5m24180x437j30qpizdk1aal"))))
(build-system perl-build-system) (build-system perl-build-system)
(synopsis "Recursively copy Perl datatypes") (synopsis "Recursively copy Perl datatypes")
(description (description
@ -4072,7 +4072,7 @@ relic support.")
(define-public perl-hash-merge (define-public perl-hash-merge
(package (package
(name "perl-hash-merge") (name "perl-hash-merge")
(version "0.200") (version "0.300")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -4080,8 +4080,10 @@ relic support.")
"Hash-Merge-" version ".tar.gz")) "Hash-Merge-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0r1a2axz85wn6573zrl9rk8mkfl2cvf1gp9vwya5qndp60rz1ya7")))) "0h3wfnpv5d4d3f9xzmwkchay6251nhzngdv3f6xia56mj4hxabs0"))))
(build-system perl-build-system) (build-system perl-build-system)
(inputs
`(("perl-clone-choose" ,perl-clone-choose)))
(home-page "https://metacpan.org/release/Hash-Merge") (home-page "https://metacpan.org/release/Hash-Merge")
(synopsis "Merge arbitrarily deep hashes into a single hash") (synopsis "Merge arbitrarily deep hashes into a single hash")
(description "Hash::Merge merges two arbitrarily deep hashes into a single (description "Hash::Merge merges two arbitrarily deep hashes into a single
@ -9516,7 +9518,7 @@ grammars to generate Perl object oriented parser modules.")
(define-public perl-cpan-meta (define-public perl-cpan-meta
(package (package
(name "perl-cpan-meta") (name "perl-cpan-meta")
(version "2.143240") (version "2.150010")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -9524,7 +9526,7 @@ grammars to generate Perl object oriented parser modules.")
"CPAN-Meta-" version ".tar.gz")) "CPAN-Meta-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"1d80bxphpp5dq7fx5ipxszn7j8q9d85w6fnapdrbym21k1vsmlf6")))) "1mm3dfw3ffyzb2ikpqn9l6zyqrxijb4vyywmbx2l21ryqwp0zy74"))))
(build-system perl-build-system) (build-system perl-build-system)
(propagated-inputs (propagated-inputs
`(("perl-cpan-meta-requirements" ,perl-cpan-meta-requirements) `(("perl-cpan-meta-requirements" ,perl-cpan-meta-requirements)

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

@ -3156,6 +3156,13 @@ and is very extensible.")
(base32 (base32
"0crland0kmpsyjfmnflcw7gaqy5b87b6ah17cmr9d5z1kyazf54n")))) "0crland0kmpsyjfmnflcw7gaqy5b87b6ah17cmr9d5z1kyazf54n"))))
(build-system python-build-system) (build-system python-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
(with-directory-excursion "tests"
(invoke "sh" "runtests")))))))
(home-page "http://projectmallard.org") (home-page "http://projectmallard.org")
(synopsis "Convert Ducktype to Mallard documentation markup") (synopsis "Convert Ducktype to Mallard documentation markup")
(description (description
@ -5175,7 +5182,19 @@ without using the configuration machinery.")
;; Tests fail because of missing native python kernel which I assume is ;; Tests fail because of missing native python kernel which I assume is
;; provided by the ipython package, which we cannot use because it would ;; provided by the ipython package, which we cannot use because it would
;; cause a dependency cycle. ;; cause a dependency cycle.
(arguments `(#:tests? #f)) (arguments
`(#:tests? #f
#:phases (modify-phases %standard-phases
(add-after 'unpack 'set-tool-file-names
(lambda* (#:key inputs #:allow-other-keys)
(let ((iproute (assoc-ref inputs "iproute")))
(substitute* "jupyter_client/localinterfaces.py"
(("'ip'")
(string-append "'" iproute "/sbin/ip'")))
#t))))))
(inputs
`(("iproute" ,iproute)))
(propagated-inputs (propagated-inputs
`(("python-pyzmq" ,python-pyzmq) `(("python-pyzmq" ,python-pyzmq)
("python-traitlets" ,python-traitlets) ("python-traitlets" ,python-traitlets)

4
gnu/packages/qt.scm
View File

@ -2151,7 +2151,7 @@ different kinds of sliders, and much more.")
(define-public qtwebkit (define-public qtwebkit
(package (package
(name "qtwebkit") (name "qtwebkit")
(version "5.212.0-alpha2") (version "5.212.0-alpha3")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -2159,7 +2159,7 @@ different kinds of sliders, and much more.")
name "-" version "/" name "-" version ".tar.xz")) name "-" version "/" name "-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"12lg7w00d8wsj672s1y5z5gm0xdcgs16nas0b5bgq4byavg03ygq")) "05syvwi3jw9abwsc93rmjkna0vyh6bkfrsqhwir48ms54icfwzim"))
(patches (search-patches "qtwebkit-pbutils-include.patch")))) (patches (search-patches "qtwebkit-pbutils-include.patch"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(native-inputs (native-inputs

4
gnu/packages/serialization.scm
View File

@ -296,7 +296,7 @@ that implements both the msgpack and msgpack-rpc specifications.")
(define-public jsoncpp (define-public jsoncpp
(package (package
(name "jsoncpp") (name "jsoncpp")
(version "1.9.0") (version "1.9.1")
(home-page "https://github.com/open-source-parsers/jsoncpp") (home-page "https://github.com/open-source-parsers/jsoncpp")
(source (origin (source (origin
(method git-fetch) (method git-fetch)
@ -304,7 +304,7 @@ that implements both the msgpack and msgpack-rpc specifications.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"10wnwlq92gp32f5p55kjcc12jfsl0yq6f2y4abb0si6wym12krw9")))) "00g356iv3kcp0gadj7gbyzf9jn9avvx9vxbxc7c2i5nnry8z72wj"))))
(build-system cmake-build-system) (build-system cmake-build-system)
(arguments (arguments
`(#:configure-flags '("-DBUILD_SHARED_LIBS:BOOL=YES"))) `(#:configure-flags '("-DBUILD_SHARED_LIBS:BOOL=YES")))

4
gnu/packages/shells.scm
View File

@ -749,14 +749,14 @@ Shell (pdksh).")
(define-public oil-shell (define-public oil-shell
(package (package
(name "oil-shell") (name "oil-shell")
(version "0.6.pre22") (version "0.6.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "https://www.oilshell.org/download/oil-" (uri (string-append "https://www.oilshell.org/download/oil-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1kslycqa8rrzk9p2265dy045xd88q675w4baqiygcrnvxwn588c5")))) "1dw4mgnlmaxlfygasfihgvbj32d3m9w6k5j7azb9d9lp35f3l7hl"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
'(#:tests? #f ; the tests are not distributed in the tarballs '(#:tests? #f ; the tests are not distributed in the tarballs

2
gnu/packages/sync.scm
View File

@ -227,7 +227,7 @@ and does not hamper local file system performance.")
("rsync" ,rsync))) ;for tests ("rsync" ,rsync))) ;for tests
(inputs (inputs
`(("xz" ,xz) ;for liblzma `(("xz" ,xz) ;for liblzma
("zstd" ,zstd) ("zstd" ,zstd "lib")
("curl" ,curl) ("curl" ,curl)
("acl" ,acl) ("acl" ,acl)
("libselinux" ,libselinux) ("libselinux" ,libselinux)

2
gnu/packages/tor.scm
View File

@ -67,7 +67,7 @@
("libevent" ,libevent) ("libevent" ,libevent)
("libseccomp" ,libseccomp) ("libseccomp" ,libseccomp)
("xz" ,xz) ("xz" ,xz)
("zstd" ,zstd))) ("zstd" ,zstd "lib")))
(home-page "https://www.torproject.org/") (home-page "https://www.torproject.org/")
(synopsis "Anonymous network router to improve privacy on the Internet") (synopsis "Anonymous network router to improve privacy on the Internet")
(description (description

14
gnu/packages/video.scm
View File

@ -473,7 +473,7 @@ and creating Matroska files from other media files (@code{mkvmerge}).")
(define-public x265 (define-public x265
(package (package
(name "x265") (name "x265")
(version "3.0") (version "3.1.1")
(outputs '("out" "static")) (outputs '("out" "static"))
(source (source
(origin (origin
@ -482,7 +482,7 @@ and creating Matroska files from other media files (@code{mkvmerge}).")
"x265_" version ".tar.gz")) "x265_" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0qh65wdpasrspkm1y0dlfa123myax568yi0sas0lmg5b1hkgrff5")) "1l68lgdbsi4wjz5vad98ggx7mf92rnvzlq34m6w0a08ark3h0yc2"))
(patches (search-patches "x265-arm-flags.patch")) (patches (search-patches "x265-arm-flags.patch"))
(modules '((guix build utils))) (modules '((guix build utils)))
(snippet '(begin (snippet '(begin
@ -756,14 +756,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 "4.1.3") (version "4.1.4")
(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
"0gdnprc7gk4b7ckq8wbxbrj7i00r76r9a5g9mj7iln40512j0c0c")))) "1qd7a10gs12ifcp31gramcgqjl77swskjfp7cijibgyg5yl4kw7i"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("fontconfig" ,fontconfig) `(("fontconfig" ,fontconfig)
@ -1073,7 +1073,7 @@ videoformats depend on the configuration flags of ffmpeg.")
("libva" ,libva) ("libva" ,libva)
("libvdpau" ,libvdpau) ("libvdpau" ,libvdpau)
("libvorbis" ,libvorbis) ("libvorbis" ,libvorbis)
("libvpx" ,libvpx-1.7) ("libvpx" ,libvpx)
("libtheora" ,libtheora) ("libtheora" ,libtheora)
("libx264" ,libx264) ("libx264" ,libx264)
("libxext" ,libxext) ("libxext" ,libxext)
@ -1388,7 +1388,7 @@ access to mpv's powerful playback capabilities.")
(define-public libvpx (define-public libvpx
(package (package
(name "libvpx") (name "libvpx")
(version "1.8.0") (version "1.8.1")
(source (origin (source (origin
;; XXX: Upstream does not provide tarballs for > 1.6.1. ;; XXX: Upstream does not provide tarballs for > 1.6.1.
(method git-fetch) (method git-fetch)
@ -1398,7 +1398,7 @@ access to mpv's powerful playback capabilities.")
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(sha256 (sha256
(base32 (base32
"079pb80am08lj8y5rx99vdr99mdqis9067f172zq12alkz849n93")) "0mm1dcfa268rwsrgzqpbbgq4lwrvdzgp90h9dxsnkhai70l7gipq"))
(patches (search-patches "libvpx-CVE-2016-2818.patch")))) (patches (search-patches "libvpx-CVE-2016-2818.patch"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments

17
gnu/packages/virtualization.scm
View File

@ -287,7 +287,7 @@ server and embedded PowerPC, and S390 guests.")
(define-public libosinfo (define-public libosinfo
(package (package
(name "libosinfo") (name "libosinfo")
(version "1.0.0") (version "1.5.0")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -295,30 +295,21 @@ server and embedded PowerPC, and S390 guests.")
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0srrs2m6irqd4f867g8ls6jp2dq3ql0l9d0fh80d55sivvn2bd7p")))) "12b0xj9fz9q91d1pz9xm6aqap5k1ip0m9m3qvqmwjy1lk1kjasdz"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:configure-flags `(#:configure-flags
(list (string-append "--with-usb-ids-path=" (list (string-append "--with-usb-ids-path="
(assoc-ref %build-inputs "usb.ids")) (assoc-ref %build-inputs "usb.ids"))
(string-append "--with-pci-ids-path=" (string-append "--with-pci-ids-path="
(assoc-ref %build-inputs "pci.ids"))) (assoc-ref %build-inputs "pci.ids")))))
#:phases
(modify-phases %standard-phases
;; This odd test fails for unknown reasons.
(add-after 'unpack 'disable-broken-test
(lambda _
(substitute* "test/Makefile.in"
(("test-isodetect\\$\\(EXEEXT\\)") ""))
#t)))))
(inputs (inputs
`(("libsoup" ,libsoup) `(("libsoup" ,libsoup)
("libxml2" ,libxml2) ("libxml2" ,libxml2)
("libxslt" ,libxslt) ("libxslt" ,libxslt)
("gobject-introspection" ,gobject-introspection))) ("gobject-introspection" ,gobject-introspection)))
(native-inputs (native-inputs
`(("check" ,check) `(("glib" ,glib "bin") ; glib-mkenums, etc.
("glib" ,glib "bin") ; glib-mkenums, etc.
("gtk-doc" ,gtk-doc) ("gtk-doc" ,gtk-doc)
("vala" ,vala) ("vala" ,vala)
("intltool" ,intltool) ("intltool" ,intltool)

4
gnu/packages/web.scm
View File

@ -3336,7 +3336,7 @@ and retry a few times.")
(define-public perl-net-http (define-public perl-net-http
(package (package
(name "perl-net-http") (name "perl-net-http")
(version "6.18") (version "6.19")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -3344,7 +3344,7 @@ and retry a few times.")
"Net-HTTP-" version ".tar.gz")) "Net-HTTP-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"074mp9s37q1j290xa3qj1wwgalzla328i2zpnh73xkmdnwnxyhky")))) "1i1gbcwdzx74whn5vn6xbr2cp7frldfz2rfrcjp2qljr770nxdsj"))))
(build-system perl-build-system) (build-system perl-build-system)
(propagated-inputs (propagated-inputs
`(("perl-io-socket-ssl" ,perl-io-socket-ssl) `(("perl-io-socket-ssl" ,perl-io-socket-ssl)

4
gnu/system/file-systems.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -352,7 +352,7 @@ TARGET in the other system."
(mount-point (%store-prefix)) (mount-point (%store-prefix))
(type "none") (type "none")
(check? #f) (check? #f)
(flags '(read-only bind-mount)))) (flags '(read-only bind-mount no-atime))))
(define %control-groups (define %control-groups
(let ((parent (file-system (let ((parent (file-system

49
gnu/system/linux-container.scm
View File

@ -35,7 +35,8 @@
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:export (system-container #:export (system-container
containerized-operating-system containerized-operating-system
container-script)) container-script
eval/container))
(define* (container-essential-services os #:key shared-network?) (define* (container-essential-services os #:key shared-network?)
"Return a list of essential services corresponding to OS, a "Return a list of essential services corresponding to OS, a
@ -205,3 +206,49 @@ that will be shared with the host system."
%namespaces))))) %namespaces)))))
(gexp->script "run-container" script))) (gexp->script "run-container" script)))
(define* (eval/container exp
#:key
(mappings '())
(namespaces %namespaces))
"Evaluate EXP, a gexp, in a new process executing in separate namespaces as
listed in NAMESPACES. Add MAPPINGS, a list of <file-system-mapping>, to the
set of directories visible in the process's mount namespace. Return the
process' exit status as a monadic value.
This is useful to implement processes that, unlike derivations, are not
entirely pure and need to access the outside world or to perform side
effects."
(mlet %store-monad ((lowered (lower-gexp exp)))
(define inputs
(cons (lowered-gexp-guile lowered)
(lowered-gexp-inputs lowered)))
(define items
(append (append-map derivation-input-output-paths inputs)
(lowered-gexp-sources lowered)))
(mbegin %store-monad
(built-derivations inputs)
(mlet %store-monad ((closure ((store-lift requisites) items)))
(return (call-with-container (map file-system-mapping->bind-mount
(append (map (lambda (item)
(file-system-mapping
(source item)
(target source)))
closure)
mappings))
(lambda ()
(apply execl
(string-append (derivation-input-output-path
(lowered-gexp-guile lowered))
"/bin/guile")
"guile"
(append (map (lambda (directory) `("-L" ,directory))
(lowered-gexp-load-path lowered))
(map (lambda (directory) `("-C" ,directory))
(lowered-gexp-load-compiled-path
lowered))
(list "-c"
(object->string
(lowered-gexp-sexp lowered))))))))))))

72
guix/channels.scm
View File

@ -108,11 +108,10 @@
(checkout channel-instance-checkout)) (checkout channel-instance-checkout))
(define-record-type <channel-metadata> (define-record-type <channel-metadata>
(channel-metadata version directory dependencies) (channel-metadata directory dependencies)
channel-metadata? channel-metadata?
(version channel-metadata-version) (directory channel-metadata-directory) ;string with leading slash
(directory channel-metadata-directory) (dependencies channel-metadata-dependencies)) ;list of <channel>
(dependencies channel-metadata-dependencies))
(define (channel-reference channel) (define (channel-reference channel)
"Return the \"reference\" for CHANNEL, an sexp suitable for "Return the \"reference\" for CHANNEL, an sexp suitable for
@ -121,18 +120,18 @@
(#f `(branch . ,(channel-branch channel))) (#f `(branch . ,(channel-branch channel)))
(commit `(commit . ,(channel-commit channel))))) (commit `(commit . ,(channel-commit channel)))))
(define (read-channel-metadata-from-source source) (define (read-channel-metadata port)
"Return a channel-metadata record read from channel's SOURCE/.guix-channel "Read from PORT channel metadata in the format expected for the
description file, or return #F if SOURCE/.guix-channel does not exist." '.guix-channel' file. Return a <channel-metadata> record, or raise an error
(let ((meta-file (string-append source "/.guix-channel"))) if valid metadata could not be read from PORT."
(and (file-exists? meta-file) (match (read port)
(let* ((raw (call-with-input-file meta-file read)) (('channel ('version 0) properties ...)
(version (and=> (assoc-ref raw 'version) first)) (let ((directory (and=> (assoc-ref properties 'directory) first))
(directory (and=> (assoc-ref raw 'directory) first)) (dependencies (or (assoc-ref properties 'dependencies) '())))
(dependencies (or (assoc-ref raw 'dependencies) '())))
(channel-metadata (channel-metadata
version (cond ((not directory) "/")
directory ((string-prefix? "/" directory) directory)
(else (string-append "/" directory)))
(map (lambda (item) (map (lambda (item)
(let ((get (lambda* (key #:optional default) (let ((get (lambda* (key #:optional default)
(or (and=> (assoc-ref item key) first) default)))) (or (and=> (assoc-ref item key) first) default))))
@ -144,21 +143,42 @@ description file, or return #F if SOURCE/.guix-channel does not exist."
(branch branch) (branch branch)
(url url) (url url)
(commit (get 'commit)))))) (commit (get 'commit))))))
dependencies)))))) dependencies))))
((and ('channel ('version version) _ ...) sexp)
(raise (condition
(&message (message "unsupported '.guix-channel' version"))
(&error-location
(location (source-properties->location
(source-properties sexp)))))))
(sexp
(raise (condition
(&message (message "invalid '.guix-channel' file"))
(&error-location
(location (source-properties->location
(source-properties sexp)))))))))
(define (read-channel-metadata instance) (define (read-channel-metadata-from-source source)
"Return a channel-metadata record read from channel's SOURCE/.guix-channel
description file, or return the default channel-metadata record if that file
doesn't exist."
(catch 'system-error
(lambda ()
(call-with-input-file (string-append source "/.guix-channel")
read-channel-metadata))
(lambda args
(if (= ENOENT (system-error-errno args))
(channel-metadata "/" '())
(apply throw args)))))
(define (channel-instance-metadata instance)
"Return a channel-metadata record read from the channel INSTANCE's "Return a channel-metadata record read from the channel INSTANCE's
description file, or return #F if the channel instance does not include the description file or its default value."
file."
(read-channel-metadata-from-source (channel-instance-checkout instance))) (read-channel-metadata-from-source (channel-instance-checkout instance)))
(define (channel-instance-dependencies instance) (define (channel-instance-dependencies instance)
"Return the list of channels that are declared as dependencies for the given "Return the list of channels that are declared as dependencies for the given
channel INSTANCE." channel INSTANCE."
(match (read-channel-metadata instance) (channel-metadata-dependencies (channel-instance-metadata instance)))
(#f '())
(($ <channel-metadata> version directory dependencies)
dependencies)))
(define* (latest-channel-instances store channels #:optional (previous-channels '())) (define* (latest-channel-instances store channels #:optional (previous-channels '()))
"Return a list of channel instances corresponding to the latest checkouts of "Return a list of channel instances corresponding to the latest checkouts of
@ -240,7 +260,7 @@ objects. The assumption is that SOURCE contains package modules to be added
to '%package-module-path'." to '%package-module-path'."
(let* ((metadata (read-channel-metadata-from-source source)) (let* ((metadata (read-channel-metadata-from-source source))
(directory (and=> metadata channel-metadata-directory))) (directory (channel-metadata-directory metadata)))
(define build (define build
;; This is code that we'll run in CORE, a Guix instance, with its own ;; This is code that we'll run in CORE, a Guix instance, with its own
@ -260,9 +280,7 @@ to '%package-module-path'."
(string-append #$output "/share/guile/site/" (string-append #$output "/share/guile/site/"
(effective-version))) (effective-version)))
(let* ((subdir (if #$directory (let* ((subdir #$directory)
(string-append "/" #$directory)
""))
(source (string-append #$source subdir))) (source (string-append #$source subdir)))
(compile-files source go (find-files source "\\.scm$")) (compile-files source go (find-files source "\\.scm$"))
(mkdir-p (dirname scm)) (mkdir-p (dirname scm))

6
guix/discovery.scm
View File

@ -106,14 +106,14 @@ name and the exception key and arguments."
(string-length directory)) (string-length directory))
(filter-map (lambda (file) (filter-map (lambda (file)
(let* ((file (substring file prefix-len)) (let* ((relative (string-drop file prefix-len))
(module (file-name->module-name file))) (module (file-name->module-name relative)))
(catch #t (catch #t
(lambda () (lambda ()
(resolve-interface module)) (resolve-interface module))
(lambda args (lambda args
;; Report the error, but keep going. ;; Report the error, but keep going.
(warn module args) (warn file module args)
#f)))) #f))))
(scheme-files (if sub-directory (scheme-files (if sub-directory
(string-append directory "/" sub-directory) (string-append directory "/" sub-directory)

25
guix/lint.scm
View File

@ -43,9 +43,7 @@
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module ((guix ui) #:select (texi->plain-text fill-paragraph)) #:use-module ((guix ui) #:select (texi->plain-text fill-paragraph))
#:use-module (guix gnu-maintenance) #:use-module (guix gnu-maintenance)
#:use-module (guix monads)
#:use-module (guix cve) #:use-module (guix cve)
#:use-module (gnu packages)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 format) #:use-module (ice-9 format)
@ -742,21 +740,28 @@ descriptions maintained upstream."
"Emit a warning if PACKAGE has an invalid 'source' field, or if that "Emit a warning if PACKAGE has an invalid 'source' field, or if that
'source' is not reachable." 'source' is not reachable."
(define (warnings-for-uris uris) (define (warnings-for-uris uris)
(filter lint-warning? (let loop ((uris uris)
(map (warnings '()))
(lambda (uri) (match uris
(validate-uri uri package 'source)) (()
(append-map (cut maybe-expand-mirrors <> %mirrors) (reverse warnings))
uris)))) ((uri rest ...)
(match (validate-uri uri package 'source)
(#t
;; We found a working URL, so stop right away.
'())
((? lint-warning? warning)
(loop rest (cons warning warnings))))))))
(let ((origin (package-source package))) (let ((origin (package-source package)))
(if (and origin (if (and origin
(eqv? (origin-method origin) url-fetch)) (eqv? (origin-method origin) url-fetch))
(let* ((uris (map string->uri (origin-uris origin))) (let* ((uris (append-map (cut maybe-expand-mirrors <> %mirrors)
(map string->uri (origin-uris origin))))
(warnings (warnings-for-uris uris))) (warnings (warnings-for-uris uris)))
;; Just make sure that at least one of the URIs is valid. ;; Just make sure that at least one of the URIs is valid.
(if (eq? (length uris) (length warnings)) (if (= (length uris) (length warnings))
;; When everything fails, report all of WARNINGS, otherwise don't ;; When everything fails, report all of WARNINGS, otherwise don't
;; report anything. ;; report anything.
;; ;;

1
guix/scripts/archive.scm
View File

@ -30,6 +30,7 @@
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix pki) #:use-module (guix pki)
#:use-module (gcrypt common)
#:use-module (gcrypt pk-crypto) #:use-module (gcrypt pk-crypto)
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module (guix scripts build) #:use-module (guix scripts build)

3
guix/scripts/lint.scm
View File

@ -46,8 +46,7 @@
(lambda (lint-warning) (lambda (lint-warning)
(let ((package (lint-warning-package lint-warning)) (let ((package (lint-warning-package lint-warning))
(loc (lint-warning-location lint-warning))) (loc (lint-warning-location lint-warning)))
(format (guix-warning-port) "~a: ~a@~a: ~a~%" (warning loc (G_ "~a@~a: ~a~%")
(location->string loc)
(package-name package) (package-version package) (package-name package) (package-version package)
(lint-warning-message lint-warning)))) (lint-warning-message lint-warning))))
warnings)) warnings))

7
guix/scripts/pack.scm
View File

@ -509,9 +509,10 @@ the image."
#:database #+database #:database #+database
#:system (or #$target (utsname:machine (uname))) #:system (or #$target (utsname:machine (uname)))
#:environment environment #:environment environment
#:entry-point #$(and entry-point #:entry-point
#~(string-append #$profile "/" #$(and entry-point
#$entry-point)) #~(list (string-append #$profile "/"
#$entry-point)))
#:symlinks '#$symlinks #:symlinks '#$symlinks
#:compressor '#$(compressor-command compressor) #:compressor '#$(compressor-command compressor)
#:creation-time (make-time time-utc 0 1)))))) #:creation-time (make-time time-utc 0 1))))))

10
guix/swh.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -31,7 +31,9 @@
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 popen) #:use-module (ice-9 popen)
#:use-module ((ice-9 ftw) #:select (scandir)) #:use-module ((ice-9 ftw) #:select (scandir))
#:export (origin? #:export (%swh-base-url
origin?
origin-id origin-id
origin-type origin-type
origin-url origin-url
@ -115,11 +117,11 @@
(define %swh-base-url (define %swh-base-url
;; Presumably we won't need to change it. ;; Presumably we won't need to change it.
"https://archive.softwareheritage.org") (make-parameter "https://archive.softwareheritage.org"))
(define (swh-url path . rest) (define (swh-url path . rest)
(define url (define url
(string-append %swh-base-url path (string-append (%swh-base-url) path
(string-join rest "/" 'prefix))) (string-join rest "/" 'prefix)))
;; Ensure there's a trailing slash or we get a redirect. ;; Ensure there's a trailing slash or we get a redirect.

41
guix/ui.scm
View File

@ -311,6 +311,36 @@ arguments."
(display-hint (format #f (G_ "Did you forget @code{(use-modules ~a)}?") (display-hint (format #f (G_ "Did you forget @code{(use-modules ~a)}?")
(module-name module)))))))) (module-name module))))))))
(define (check-module-matches-file module file)
"Check whether FILE starts with 'define-module MODULE' and print a hint if
it doesn't."
;; This is a common mistake when people start writing their own package
;; definitions and try loading them with 'guix build -L …', so help them
;; diagnose the problem.
(define (hint)
(display-hint (format #f (G_ "File @file{~a} should probably start with:
@example\n(define-module ~a)\n@end example")
file module)))
(catch 'system-error
(lambda ()
(let* ((sexp (call-with-input-file file read))
(loc (and (pair? sexp)
(source-properties->location (source-properties sexp)))))
(match sexp
(('define-module (names ...) _ ...)
(unless (equal? module names)
(warning loc
(G_ "module name ~a does not match file name '~a'~%")
names (module->source-file-name module))
(hint)))
((? eof-object?)
(warning (G_ "~a: file is empty~%") file))
(else
(hint)))))
(const #f)))
(define* (report-load-error file args #:optional frame) (define* (report-load-error file args #:optional frame)
"Report the failure to load FILE, a user-provided Scheme file. "Report the failure to load FILE, a user-provided Scheme file.
ARGS is the list of arguments received by the 'throw' handler." ARGS is the list of arguments received by the 'throw' handler."
@ -352,16 +382,18 @@ ARGS is the list of arguments received by the 'throw' handler."
;; above and need to be printed with 'print-exception'. ;; above and need to be printed with 'print-exception'.
(print-exception (current-error-port) frame key args)))))) (print-exception (current-error-port) frame key args))))))
(define (warn-about-load-error file args) ;FIXME: factorize with ↑ (define (warn-about-load-error file module args) ;FIXME: factorize with ↑
"Report the failure to load FILE, a user-provided Scheme file, without "Report the failure to load FILE, a user-provided Scheme file, without
exiting. ARGS is the list of arguments received by the 'throw' handler." exiting. ARGS is the list of arguments received by the 'throw' handler."
(match args (match args
(('system-error . rest) (('system-error . rest)
(let ((err (system-error-errno args))) (let ((err (system-error-errno args)))
(warning (G_ "failed to load '~a': ~a~%") file (strerror err)))) (warning (G_ "failed to load '~a': ~a~%") module (strerror err))))
(('syntax-error proc message properties form . rest) (('syntax-error proc message properties form . rest)
(let ((loc (source-properties->location properties))) (let ((loc (source-properties->location properties)))
(warning loc (G_ "~a~%") message))) (warning loc (G_ "~a~%") message)))
(('unbound-variable _ ...)
(report-unbound-variable-error args))
(('srfi-34 obj) (('srfi-34 obj)
(if (message-condition? obj) (if (message-condition? obj)
(warning (G_ "failed to load '~a': ~a~%") (warning (G_ "failed to load '~a': ~a~%")
@ -370,8 +402,9 @@ exiting. ARGS is the list of arguments received by the 'throw' handler."
(warning (G_ "failed to load '~a': exception thrown: ~s~%") (warning (G_ "failed to load '~a': exception thrown: ~s~%")
file obj))) file obj)))
((error args ...) ((error args ...)
(warning (G_ "failed to load '~a':~%") file) (warning (G_ "failed to load '~a':~%") module)
(apply display-error #f (current-error-port) args)))) (apply display-error #f (current-error-port) args)
(check-module-matches-file module file))))
(define (call-with-unbound-variable-handling thunk) (define (call-with-unbound-variable-handling thunk)
(define tag (define tag

68
tests/channels.scm
View File

@ -26,8 +26,12 @@
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix sets) #:use-module (guix sets)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module ((guix utils)
#:select (error-location? error-location location-line))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (ice-9 match)) #:use-module (ice-9 match))
@ -38,22 +42,23 @@
(commit "cafebabe") (commit "cafebabe")
(spec #f)) (spec #f))
(define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX")) (define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
(and spec (when spec
(with-output-to-file (string-append instance-dir "/.guix-channel") (call-with-output-file (string-append instance-dir "/.guix-channel")
(lambda _ (format #t "~a" spec)))) (lambda (port) (write spec port))))
(checkout->channel-instance instance-dir (checkout->channel-instance instance-dir
#:commit commit #:commit commit
#:name name)) #:name name))
(define instance--boring (make-instance)) (define instance--boring (make-instance))
(define instance--unsupported-version
(make-instance #:spec
'(channel (version 42) (dependencies whatever))))
(define instance--no-deps (define instance--no-deps
(make-instance #:spec (make-instance #:spec
'(channel '(channel (version 0))))
(version 0) (define instance--sub-directory
(dependencies (make-instance #:spec
(channel '(channel (version 0) (directory "modules"))))
(name test-channel)
(url "https://example.com/test-channel"))))))
(define instance--simple (define instance--simple
(make-instance #:spec (make-instance #:spec
'(channel '(channel
@ -78,24 +83,45 @@
(name test-channel) (name test-channel)
(url "https://example.com/test-channel-elsewhere")))))) (url "https://example.com/test-channel-elsewhere"))))))
(define read-channel-metadata (define channel-instance-metadata
(@@ (guix channels) read-channel-metadata)) (@@ (guix channels) channel-instance-metadata))
(define channel-metadata-directory
(@@ (guix channels) channel-metadata-directory))
(define channel-metadata-dependencies
(@@ (guix channels) channel-metadata-dependencies))
(test-equal "read-channel-metadata returns #f if .guix-channel does not exist" (test-equal "channel-instance-metadata returns default if .guix-channel does not exist"
#f '("/" ())
(read-channel-metadata instance--boring)) (let ((metadata (channel-instance-metadata instance--boring)))
(list (channel-metadata-directory metadata)
(channel-metadata-dependencies metadata))))
(test-assert "read-channel-metadata returns <channel-metadata>" (test-equal "channel-instance-metadata and default dependencies"
'()
(channel-metadata-dependencies (channel-instance-metadata instance--no-deps)))
(test-equal "channel-instance-metadata and directory"
"/modules"
(channel-metadata-directory
(channel-instance-metadata instance--sub-directory)))
(test-equal "channel-instance-metadata rejects unsupported version"
1 ;line number in the generated '.guix-channel'
(guard (c ((and (message-condition? c) (error-location? c))
(location-line (error-location c))))
(channel-instance-metadata instance--unsupported-version)))
(test-assert "channel-instance-metadata returns <channel-metadata>"
(every (@@ (guix channels) channel-metadata?) (every (@@ (guix channels) channel-metadata?)
(map read-channel-metadata (map channel-instance-metadata
(list instance--no-deps (list instance--no-deps
instance--simple instance--simple
instance--with-dupes)))) instance--with-dupes))))
(test-assert "read-channel-metadata dependencies are channels" (test-assert "channel-instance-metadata dependencies are channels"
(let ((deps ((@@ (guix channels) channel-metadata-dependencies) (let ((deps ((@@ (guix channels) channel-metadata-dependencies)
(read-channel-metadata instance--simple)))) (channel-instance-metadata instance--simple))))
(match deps (match deps
(((? channel? dep)) #t) (((? channel? dep)) #t)
(_ #f)))) (_ #f))))
@ -128,7 +154,7 @@
("test" (values test-dir 'whatever)) ("test" (values test-dir 'whatever))
(_ (values "/not-important" 'not-important))))) (_ (values "/not-important" 'not-important)))))
(let ((instances (latest-channel-instances #f (list channel)))) (let ((instances (latest-channel-instances #f (list channel))))
(and (eq? 2 (length instances)) (and (= 2 (length instances))
(lset= eq? (lset= eq?
'(test test-channel) '(test test-channel)
(map (compose channel-name channel-instance-channel) (map (compose channel-name channel-instance-channel)
@ -139,9 +165,9 @@
(and (eq? (channel-name (and (eq? (channel-name
(channel-instance-channel instance)) (channel-instance-channel instance))
'test-channel) 'test-channel)
(eq? (channel-commit (string=? (channel-commit
(channel-instance-channel instance)) (channel-instance-channel instance))
'abc1234))) "abc1234")))
instances)))))) instances))))))
(test-assert "channel-instances->manifest" (test-assert "channel-instances->manifest"

50
tests/containers.scm
View File

@ -21,7 +21,15 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix build syscalls) #:use-module (guix build syscalls)
#:use-module (gnu build linux-container) #:use-module (gnu build linux-container)
#:use-module ((gnu system linux-container)
#:select (eval/container))
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix gexp)
#:use-module (guix derivations)
#:use-module (guix tests)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (ice-9 match)) #:use-module (ice-9 match))
@ -219,4 +227,46 @@
(lambda () (lambda ()
(* 6 7)))) (* 6 7))))
(skip-if-unsupported)
(test-equal "eval/container, exit status"
42
(let* ((store (open-connection-for-tests))
(status (run-with-store store
(eval/container #~(exit 42)))))
(close-connection store)
(status:exit-val status)))
(skip-if-unsupported)
(test-assert "eval/container, writable user mapping"
(call-with-temporary-directory
(lambda (directory)
(define store
(open-connection-for-tests))
(define result
(string-append directory "/r"))
(define requisites*
(store-lift requisites))
(call-with-output-file result (const #t))
(run-with-store store
(mlet %store-monad ((status (eval/container
#~(begin
(use-modules (ice-9 ftw))
(call-with-output-file "/result"
(lambda (port)
(write (scandir #$(%store-prefix))
port))))
#:mappings
(list (file-system-mapping
(source result)
(target "/result")
(writable? #t)))))
(reqs (requisites*
(list (derivation->output-path
(%guile-for-build))))))
(close-connection store)
(return (and (zero? (pk 'status status))
(lset= string=? (cons* "." ".." (map basename reqs))
(pk (call-with-input-file result read))))))))))
(test-end) (test-end)

31
tests/guix-build.sh
View File

@ -146,8 +146,8 @@ test `guix build -d --sources=transitive foo \
| wc -l` -eq 3 | wc -l` -eq 3
# Unbound variables. # Unbound variable in thunked field.
cat > "$module_dir/foo.scm"<<EOF cat > "$module_dir/foo.scm" <<EOF
(define-module (foo) (define-module (foo)
#:use-module (guix tests) #:use-module (guix tests)
#:use-module (guix build-system trivial)) #:use-module (guix build-system trivial))
@ -162,8 +162,34 @@ if guix build package-with-something-wrong -n; then false; else true; fi
guix build package-with-something-wrong -n 2> "$module_dir/err" || true guix build package-with-something-wrong -n 2> "$module_dir/err" || true
grep "unbound" "$module_dir/err" # actual error grep "unbound" "$module_dir/err" # actual error
grep "forget.*(gnu packages base)" "$module_dir/err" # hint grep "forget.*(gnu packages base)" "$module_dir/err" # hint
# Unbound variable at the top level.
cat > "$module_dir/foo.scm" <<EOF
(define-module (foo)
#:use-module (guix tests))
(define-public foo
(dummy-package "package-with-something-wrong"
(build-system gnu-build-system))) ;unbound variable
EOF
guix build sed -n 2> "$module_dir/err"
grep "unbound" "$module_dir/err" # actual error
grep "forget.*(guix build-system gnu)" "$module_dir/err" # hint
rm -f "$module_dir"/* rm -f "$module_dir"/*
# Wrong 'define-module' clause reported by 'warn-about-load-error'.
cat > "$module_dir/foo.scm" <<EOF
(define-module (something foo)
#:use-module (guix)
#:use-module (gnu))
EOF
guix build guile-bootstrap -n 2> "$module_dir/err"
grep "does not match file name" "$module_dir/err"
rm "$module_dir"/*
# Should all return valid log files. # Should all return valid log files.
drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
@ -265,6 +291,7 @@ cat > "$module_dir/gexp.scm"<<EOF
EOF EOF
guix build --file="$module_dir/gexp.scm" -d guix build --file="$module_dir/gexp.scm" -d
guix build --file="$module_dir/gexp.scm" -d | grep 'gexp\.drv' guix build --file="$module_dir/gexp.scm" -d | grep 'gexp\.drv'
rm "$module_dir"/*.scm
# Using 'GUIX_BUILD_OPTIONS'. # Using 'GUIX_BUILD_OPTIONS'.
GUIX_BUILD_OPTIONS="--dry-run --no-grafts" GUIX_BUILD_OPTIONS="--dry-run --no-grafts"

31
tests/lint.scm
View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@ -618,6 +618,23 @@
(and (? lint-warning?) second-warning)) (and (? lint-warning?) second-warning))
(lint-warning-message second-warning)))))) (lint-warning-message second-warning))))))
(test-skip (if (http-server-can-listen?) 0 1))
(test-equal "source: 404 and 200"
'()
(with-http-server 404 %long-string
(let ((bad-url (%local-url)))
(parameterize ((%http-server-port (+ 1 (%http-server-port))))
(with-http-server 200 %long-string
(let ((pkg (package
(inherit (dummy-package "x"))
(source (origin
(method url-fetch)
(uri (list bad-url (%local-url)))
(sha256 %null-sha256))))))
;; Since one of the two URLs is good, this should return the empty
;; list.
(check-source pkg)))))))
(test-skip (if (http-server-can-listen?) 0 1)) (test-skip (if (http-server-can-listen?) 0 1))
(test-equal "source: 301 -> 200" (test-equal "source: 301 -> 200"
"permanent redirect from http://localhost:10000/foo/bar to http://localhost:9999/foo/bar" "permanent redirect from http://localhost:10000/foo/bar to http://localhost:9999/foo/bar"
@ -710,12 +727,12 @@
(test-equal "cve" (test-equal "cve"
'() '()
(mock ((guix scripts lint) package-vulnerabilities (const '())) (mock ((guix lint) package-vulnerabilities (const '()))
(check-vulnerabilities (dummy-package "x")))) (check-vulnerabilities (dummy-package "x"))))
(test-equal "cve: one vulnerability" (test-equal "cve: one vulnerability"
"probably vulnerable to CVE-2015-1234" "probably vulnerable to CVE-2015-1234"
(mock ((guix scripts lint) package-vulnerabilities (mock ((guix lint) package-vulnerabilities
(lambda (package) (lambda (package)
(list (make-struct (@@ (guix cve) <vulnerability>) 0 (list (make-struct (@@ (guix cve) <vulnerability>) 0
"CVE-2015-1234" "CVE-2015-1234"
@ -726,7 +743,7 @@
(test-equal "cve: one patched vulnerability" (test-equal "cve: one patched vulnerability"
'() '()
(mock ((guix scripts lint) package-vulnerabilities (mock ((guix lint) package-vulnerabilities
(lambda (package) (lambda (package)
(list (make-struct (@@ (guix cve) <vulnerability>) 0 (list (make-struct (@@ (guix cve) <vulnerability>) 0
"CVE-2015-1234" "CVE-2015-1234"
@ -742,7 +759,7 @@
(test-equal "cve: known safe from vulnerability" (test-equal "cve: known safe from vulnerability"
'() '()
(mock ((guix scripts lint) package-vulnerabilities (mock ((guix lint) package-vulnerabilities
(lambda (package) (lambda (package)
(list (make-struct (@@ (guix cve) <vulnerability>) 0 (list (make-struct (@@ (guix cve) <vulnerability>) 0
"CVE-2015-1234" "CVE-2015-1234"
@ -755,7 +772,7 @@
(test-equal "cve: vulnerability fixed in replacement version" (test-equal "cve: vulnerability fixed in replacement version"
'() '()
(mock ((guix scripts lint) package-vulnerabilities (mock ((guix lint) package-vulnerabilities
(lambda (package) (lambda (package)
(match (package-version package) (match (package-version package)
("0" ("0"
@ -772,7 +789,7 @@
(test-equal "cve: patched vulnerability in replacement" (test-equal "cve: patched vulnerability in replacement"
'() '()
(mock ((guix scripts lint) package-vulnerabilities (mock ((guix lint) package-vulnerabilities
(lambda (package) (lambda (package)
(list (make-struct (@@ (guix cve) <vulnerability>) 0 (list (make-struct (@@ (guix cve) <vulnerability>) 0
"CVE-2015-1234" "CVE-2015-1234"

76
tests/swh.scm Normal file
View File

@ -0,0 +1,76 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-swh)
#:use-module (guix swh)
#:use-module (guix tests http)
#:use-module (srfi srfi-64))
;; Test the JSON mapping machinery used in (guix swh).
(define %origin
"{ \"id\": 42,
\"visits_url\": \"/visits/42\",
\"type\": \"git\",
\"url\": \"http://example.org/guix.git\" }")
(define %directory-entries
"[ { \"name\": \"one\",
\"type\": \"regular\",
\"length\": 123,
\"dir_id\": 1 }
{ \"name\": \"two\",
\"type\": \"regular\",
\"length\": 456,
\"dir_id\": 2 } ]")
(define-syntax-rule (with-json-result str exp ...)
(with-http-server 200 str
(parameterize ((%swh-base-url (%local-url)))
exp ...)))
(test-begin "swh")
(test-equal "lookup-origin"
(list 42 "git" "http://example.org/guix.git")
(with-json-result %origin
(let ((origin (lookup-origin "http://example.org/guix.git")))
(list (origin-id origin)
(origin-type origin)
(origin-url origin)))))
(test-equal "lookup-origin, not found"
#f
(with-http-server 404 "Nope."
(parameterize ((%swh-base-url (%local-url)))
(lookup-origin "http://example.org/whatever"))))
(test-equal "lookup-directory"
'(("one" 123) ("two" 456))
(with-json-result %directory-entries
(map (lambda (entry)
(list (directory-entry-name entry)
(directory-entry-length entry)))
(lookup-directory "123"))))
(test-end "swh")
;; Local Variables:
;; eval: (put 'with-json-result 'scheme-indent-function 1)
;; End: