summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi81
-rw-r--r--gnu/local.mk1
-rw-r--r--gnu/packages/audio.scm76
-rw-r--r--gnu/packages/dictionaries.scm34
-rw-r--r--gnu/packages/education.scm24
-rw-r--r--gnu/packages/file.scm9
-rw-r--r--gnu/packages/fonts.scm22
-rw-r--r--gnu/packages/gnupg.scm13
-rw-r--r--gnu/packages/kde-frameworks.scm30
-rw-r--r--gnu/packages/llvm.scm6
-rw-r--r--gnu/packages/ocaml.scm55
-rw-r--r--gnu/packages/package-management.scm6
-rw-r--r--gnu/packages/parallel.scm4
-rw-r--r--gnu/packages/patches/file-CVE-2018-10360.patch27
-rw-r--r--gnu/packages/photo.scm4
-rw-r--r--gnu/packages/python-web.scm11
-rw-r--r--gnu/packages/python.scm6
-rw-r--r--gnu/packages/wine.scm8
-rw-r--r--gnu/packages/wm.scm43
-rw-r--r--gnu/services/messaging.scm90
-rw-r--r--gnu/system/examples/vm-image.tmpl2
-rw-r--r--gnu/tests/messaging.scm54
-rw-r--r--guix/inferior.scm28
-rw-r--r--guix/scripts/lint.scm39
-rw-r--r--guix/scripts/offload.scm157
-rw-r--r--guix/scripts/refresh.scm55
-rw-r--r--guix/ssh.scm42
-rw-r--r--tests/lint.scm28
28 files changed, 753 insertions, 202 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index b14c8e0020..8a781f5ec7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1051,13 +1051,11 @@ name, and they will be scheduled on matching build machines.
@end table
@end deftp
-The @code{guile} command must be in the search path on the build
-machines. In addition, the Guix modules must be in
-@code{$GUILE_LOAD_PATH} on the build machine---you can check whether
-this is the case by running:
+The @command{guix} command must be in the search path on the build
+machines. You can check whether this is the case by running:
@example
-ssh build-machine guile -c "'(use-modules (guix config))'"
+ssh build-machine guix repl --version
@end example
There is one last thing to do once @file{machines.scm} is in place. As
@@ -7392,6 +7390,22 @@ are many packages, though, for which it lacks a method to determine
whether a new upstream release is available. However, the mechanism is
extensible, so feel free to get in touch with us to add a new method!
+@table @code
+
+@item --recursive
+Consider the packages specified, and all the packages upon which they depend.
+
+@example
+$ guix refresh --recursive coreutils
+gnu/packages/acl.scm:35:2: warning: no updater for acl
+gnu/packages/m4.scm:30:12: info: 1.4.18 is already the latest version of m4
+gnu/packages/xml.scm:68:2: warning: no updater for expat
+gnu/packages/multiprecision.scm:40:12: info: 6.1.2 is already the latest version of gmp
+@dots{}
+@end example
+
+@end table
+
Sometimes the upstream name differs from the package name used in Guix,
and @command{guix refresh} needs a little help. Most updaters honor the
@code{upstream-name} property in package definitions, which can be used
@@ -7565,6 +7579,22 @@ hop@@2.4.0 geiser@@0.4 notmuch@@0.18 mu@@0.9.9.5 cflow@@1.4 idutils@@4.6 @dots{}
The command above lists a set of packages that could be built to check
for compatibility with an upgraded @code{flex} package.
+@table @code
+
+@item --list-transitive
+List all the packages which one or more packages depend upon.
+
+@example
+$ guix refresh --list-transitive flex
+flex@@2.6.4 depends on the following 25 packages: perl@@5.28.0 help2man@@1.47.6
+bison@@3.0.5 indent@@2.2.10 tar@@1.30 gzip@@1.9 bzip2@@1.0.6 xz@@5.2.4 file@@5.33 @dots{}
+@end example
+
+@end table
+
+The command above lists a set of packages which, when changed, would cause
+@code{flex} to be rebuilt.
+
The following options can be used to customize GnuPG operation:
@table @code
@@ -7660,12 +7690,14 @@ Identify inputs that should most likely be native inputs.
@item source
@itemx home-page
@itemx mirror-url
+@itemx github-url
@itemx source-file-name
Probe @code{home-page} and @code{source} URLs and report those that are
-invalid. Suggest a @code{mirror://} URL when applicable. Check that
-the source file name is meaningful, e.g.@: is not
-just a version number or ``git-checkout'', without a declared
-@code{file-name} (@pxref{origin Reference}).
+invalid. Suggest a @code{mirror://} URL when applicable. If the
+@code{source} URL redirects to a GitHub URL, recommend usage of the GitHub
+URL. Check that the source file name is meaningful, e.g.@: is not just a
+version number or ``git-checkout'', without a declared @code{file-name}
+(@pxref{origin Reference}).
@item cve
@cindex security vulnerabilities
@@ -16332,6 +16364,37 @@ Configuration snippet added as-is to the BitlBee configuration file.
@end table
@end deftp
+@subsubheading Quassel Service
+
+@cindex IRC (Internet Relay Chat)
+@url{https://quassel-irc.org/,Quassel} is a distributed IRC client,
+meaning that one or more clients can attach to and detach from the
+central core.
+
+@defvr {Scheme Variable} quassel-service-type
+This is the service type for the @url{https://quassel-irc.org/,Quassel}
+IRC backend daemon. Its value is a @code{quassel-configuration}
+(see below).
+@end defvr
+
+@deftp {Data Type} quassel-configuration
+This is the configuration for Quassel, with the following fields:
+
+@table @asis
+@item @code{quassel} (default: @code{quassel})
+The Quassel package to use.
+
+@item @code{interface} (default: @code{"::,0.0.0.0"})
+@item @code{port} (default: @code{4242})
+Listen on the network interface(s) corresponding to the IPv4 or IPv6
+interfaces specified in the comma delimited @var{interface}, on
+@var{port}.
+
+@item @code{loglevel} (default: @code{"Info"})
+The level of logging desired. Accepted values are Debug, Info, Warning
+and Error.
+@end table
+@end deftp
@node Telephony Services
@subsubsection Telephony Services
diff --git a/gnu/local.mk b/gnu/local.mk
index 62407351a0..b55382cc5d 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -689,6 +689,7 @@ dist_patch_DATA = \
%D%/packages/patches/fcgi-2.4.0-poll.patch \
%D%/packages/patches/fifo-map-fix-flags-for-gcc.patch \
%D%/packages/patches/fifo-map-remove-catch.hpp.patch \
+ %D%/packages/patches/file-CVE-2018-10360.patch \
%D%/packages/patches/findutils-gnulib-libio.patch \
%D%/packages/patches/findutils-localstatedir.patch \
%D%/packages/patches/findutils-makedev.patch \
diff --git a/gnu/packages/audio.scm b/gnu/packages/audio.scm
index 7f72531664..0b24806d92 100644
--- a/gnu/packages/audio.scm
+++ b/gnu/packages/audio.scm
@@ -17,6 +17,7 @@
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018 Thorsten Wilms <t_w_@freenet.de>
;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2018 Brendan Tildesley <brendan.tildesley@openmailbox.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -74,6 +75,7 @@
#:use-module (gnu packages qt)
#:use-module (gnu packages libbsd)
#:use-module (gnu packages linux)
+ #:use-module (gnu packages libusb)
#:use-module (gnu packages llvm)
#:use-module (gnu packages mp3) ;taglib
#:use-module (gnu packages perl)
@@ -229,57 +231,79 @@ namespace ARDOUR { const char* revision = \"" version "\" ; }"))
(arguments
`(#:configure-flags '("--cxx11" ; required by gtkmm
"--no-phone-home" ; don't contact ardour.org
- "--freedesktop" ; install .desktop file
+ "--freedesktop" ; build .desktop file
"--test") ; build unit tests
#:phases
(modify-phases %standard-phases
- (add-after
- 'unpack 'set-rpath-in-LDFLAGS
- ,(ardour-rpath-phase (version-major version))))
+ (add-after 'unpack 'set-rpath-in-LDFLAGS
+ ,(ardour-rpath-phase (version-major version)))
+ (add-after 'install 'install-freedesktop-files
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (share (string-append out "/share"))
+ (ver ,(version-major version)))
+ (for-each
+ (lambda (size)
+ (let ((dir (string-append share "/icons/hicolor/"
+ size "x" size "/apps")))
+ (mkdir-p dir)
+ (copy-file
+ (string-append "gtk2_ardour/resources/Ardour-icon_"
+ size "px.png")
+ (string-append dir "/ardour" ver ".png"))))
+ '("16" "22" "32" "48" "256"))
+ (install-file (string-append "build/gtk2_ardour/ardour"
+ ver ".desktop")
+ (string-append share "/applications/"))
+ (install-file (string-append "build/gtk2_ardour/ardour"
+ ver ".appdata.xml")
+ (string-append share "/appdata/")))
+ #t)))
#:test-target "test"
#:python ,python-2))
(inputs
`(("alsa-lib" ,alsa-lib)
+ ("atkmm" ,atkmm)
("aubio" ,aubio)
- ("lrdf" ,lrdf)
("boost" ,boost)
- ("atkmm" ,atkmm)
("cairomm" ,cairomm)
+ ("curl" ,curl)
("eudev" ,eudev)
- ("gtkmm" ,gtkmm-2)
+ ("fftw" ,fftw)
+ ("fftwf" ,fftwf)
+ ("flac" ,flac)
("glibmm" ,glibmm)
+ ("gtkmm" ,gtkmm-2)
+ ("jack" ,jack-1)
+ ("libarchive" ,libarchive)
("libart-lgpl" ,libart-lgpl)
("libgnomecanvasmm" ,libgnomecanvasmm)
- ("pangomm" ,pangomm)
("liblo" ,liblo)
- ("libsndfile" ,libsndfile)
- ("libsamplerate" ,libsamplerate)
- ("libxml2" ,libxml2)
("libogg" ,libogg)
+ ("libsamplerate" ,libsamplerate)
+ ("libsndfile" ,libsndfile)
+ ("libusb" ,libusb)
("libvorbis" ,libvorbis)
- ("flac" ,flac)
+ ("libxml2" ,libxml2)
+ ("lilv" ,lilv)
+ ("lrdf" ,lrdf)
("lv2" ,lv2)
- ("vamp" ,vamp)
- ("curl" ,curl)
- ("fftw" ,fftw)
- ("fftwf" ,fftwf)
- ("jack" ,jack-1)
+ ("pangomm" ,pangomm)
+ ("python-rdflib" ,python-rdflib)
+ ("readline" ,readline)
+ ("redland" ,redland)
+ ("rubberband" ,rubberband)
("serd" ,serd)
("sord" ,sord)
("sratom" ,sratom)
("suil" ,suil)
- ("lilv" ,lilv)
- ("readline" ,readline)
- ("redland" ,redland)
- ("rubberband" ,rubberband)
- ("libarchive" ,libarchive)
("taglib" ,taglib)
- ("python-rdflib" ,python-rdflib)))
+ ("vamp" ,vamp)))
(native-inputs
- `(("perl" ,perl)
- ("cppunit" ,cppunit)
- ("itstool" ,itstool)
+ `(("cppunit" ,cppunit)
("gettext" ,gettext-minimal)
+ ("itstool" ,itstool)
+ ("perl" ,perl)
("pkg-config" ,pkg-config)))
(home-page "http://ardour.org")
(synopsis "Digital audio workstation")
diff --git a/gnu/packages/dictionaries.scm b/gnu/packages/dictionaries.scm
index 039ec45965..9e06ac7124 100644
--- a/gnu/packages/dictionaries.scm
+++ b/gnu/packages/dictionaries.scm
@@ -247,21 +247,41 @@ and a Python library.")
(define-public translate-shell
(package
(name "translate-shell")
- (version "0.9.6.8")
+ (version "0.9.6.9")
(source
(origin
- (method url-fetch)
- (uri (string-append "https://github.com/soimort/" name "/archive/v"
- version ".tar.gz"))
+ (method git-fetch)
+ (uri (git-reference
+ (url"https://github.com/soimort/translate-shell.git")
+ (commit (string-append "v" version))))
+ (file-name (git-file-name name version))
(sha256
(base32
- "17yc2kwk8957wwxyih0jmsai720ai2yqyvmrqrglcncqg6zdbz9w"))
- (file-name (string-append name "-" version ".tar.gz"))))
+ "1xyf0vdxmbgqcgsr1gvgwh1q4fh080h68radkim6pfcwzffliszm"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'configure) ; no configure phase
+ (add-after 'unpack 'remove-unnecessary-file
+ ;; This file gets generated during the build phase.
+ (lambda _
+ (delete-file "translate")
+ #t))
+ (add-after 'install 'wrap-binary
+ (lambda* (#:key inputs outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (bin (string-append out "/bin/trans"))
+ (curl (assoc-ref inputs "curl"))
+ (fribidi (assoc-ref inputs "fribidi"))
+ (rlwrap (assoc-ref inputs "rlwrap")))
+ (wrap-program bin
+ `("PATH" ":" prefix
+ (,(string-append out "/bin:"
+ curl "/bin:"
+ fribidi "/bin:"
+ rlwrap "/bin")))))
+ #t))
(add-after 'install 'emacs-install
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
@@ -277,7 +297,7 @@ and a Python library.")
(guix build emacs-utils)
(guix build utils))
#:test-target "test"))
- (propagated-inputs
+ (inputs
`(("curl" ,curl)
("fribidi" ,fribidi)
("rlwrap" ,rlwrap)))
diff --git a/gnu/packages/education.scm b/gnu/packages/education.scm
index 567dfce58d..ef97d58a84 100644
--- a/gnu/packages/education.scm
+++ b/gnu/packages/education.scm
@@ -41,6 +41,7 @@
#:use-module (gnu packages qt)
#:use-module (gnu packages sdl)
#:use-module (gnu packages texinfo)
+ #:use-module (gnu packages xorg)
#:use-module (gnu packages xml)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
@@ -115,7 +116,7 @@ of categories with some of the activities available in that category.
(define-public gcompris-qt
(package
(name "gcompris-qt")
- (version "0.91")
+ (version "0.95")
(source
(origin
(method url-fetch)
@@ -124,17 +125,17 @@ of categories with some of the activities available in that category.
version ".tar.xz"))
(sha256
(base32
- "09h098w9q79hnzla1pcpqlnnr6dbafm4q6zmdp7wlk11ym8n9kvg"))))
+ "1aaijjx2b7k1cyx59jhs64hlp1sppw1faa81qxl5lxc79vifrlrl"))))
(build-system cmake-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
- (add-after 'unpack 'patch-for-qt5.11
- (lambda _
- (substitute* "src/core/CMakeLists.txt"
- (("qt5_use_modules") "target_link_libraries")
- (("Qml Quick Gui Multimedia Network XmlPatterns Svg Xml Sensors Core")
- "Qt5::Qml Qt5::Quick Qt5::Gui Qt5::Multimedia Qt5::Core Qt5::Svg Qt5::Xml Qt5::XmlPatterns Qt5::Sensors"))
+ (add-before 'check 'start-xorg-server
+ (lambda* (#:key inputs #:allow-other-keys)
+ ;; The test suite requires a running X server.
+ (system (string-append (assoc-ref inputs "xorg-server")
+ "/bin/Xvfb :1 &"))
+ (setenv "DISPLAY" ":1")
#t))
(add-after 'install 'wrap-executable
(lambda* (#:key inputs outputs #:allow-other-keys)
@@ -152,13 +153,14 @@ of categories with some of the activities available in that category.
'("qtdeclarative" "qtgraphicaleffects"
"qtmultimedia" "qtquickcontrols"))))
#t))))
- #:configure-flags (list "-DQML_BOX2D_MODULE=disabled")
- #:tests? #f)) ; no test target
+ #:configure-flags (list "-DQML_BOX2D_MODULE=disabled"
+ "-DBUILD_TESTING=TRUE")))
(native-inputs
`(("extra-cmake-modules" ,extra-cmake-modules)
("gettext" ,gettext-minimal)
("perl" ,perl)
- ("qttools" ,qttools)))
+ ("qttools" ,qttools)
+ ("xorg-server" ,xorg-server)))
(inputs
`(("python-2" ,python-2)
("qtbase" ,qtbase)
diff --git a/gnu/packages/file.scm b/gnu/packages/file.scm
index 78f0360c2e..4518c8d3dc 100644
--- a/gnu/packages/file.scm
+++ b/gnu/packages/file.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -30,6 +31,7 @@
(package
(name "file")
(version "5.33")
+ (replacement file/fixed)
(source (origin
(method url-fetch)
(uri (string-append "ftp://ftp.astron.com/pub/file/file-"
@@ -51,3 +53,10 @@ extensions to tell you the type of a file, but looks at the actual contents
of the file. This package provides the libmagic library.")
(license bsd-2)
(home-page "https://www.darwinsys.com/file/")))
+
+(define file/fixed
+ (package
+ (inherit file)
+ (source
+ (origin (inherit (package-source file))
+ (patches (search-patches "file-CVE-2018-10360.patch"))))))
diff --git a/gnu/packages/fonts.scm b/gnu/packages/fonts.scm
index b0cb78c5cb..88315008bd 100644
--- a/gnu/packages/fonts.scm
+++ b/gnu/packages/fonts.scm
@@ -22,6 +22,7 @@
;;; Copyright © 2017, 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2017 Mohammed Sadiq <sadiq@sadiqpk.org>
;;; Copyright © 2018 Charlie Ritter <chewzerita@posteo.net>
+;;; Copyright © 2018 Gabriel Hondet <gabrielhondet@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -1351,3 +1352,24 @@ reproduction and display environments. This package provides only TrueType
files (TTF).")
(home-page "https://software.sil.org/charis/")
(license license:silofl1.1)))
+
+(define-public font-mononoki
+ (package
+ (name "font-mononoki")
+ (version "1.2")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/madmalik/mononoki/")
+ (commit version)))
+ (sha256
+ (base32
+ "1rkzyxn30rn8qv2h2xz324j7q15hzg2lci8790a7cdl1dfgic4xi"))
+ (file-name (git-file-name name version))))
+ (build-system font-build-system)
+ (synopsis "Font for programming and code review")
+ (description
+ "Mononoki is a typeface by Matthias Tellen, created to enhance code
+formatting.")
+ (home-page "https://madmalik.github.io/mononoki/")
+ (license license:silofl1.1)))
diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm
index 53fdc8200c..951fc05fa2 100644
--- a/gnu/packages/gnupg.scm
+++ b/gnu/packages/gnupg.scm
@@ -471,16 +471,23 @@ interface (FFI) of Guile.")
(define-public python-gpg
(package
(name "python-gpg")
- (version "1.8.0")
+ (version "1.10.0")
(source (origin
(method url-fetch)
(uri (pypi-uri "gpg" version))
(sha256
(base32
- "1x74i6q713c0bckls7rdm8kgsmllf9qvy9x62jghszlhgjkyh9nd"))))
+ "1ji3ynhp36m1ccx7bmaq75dhij9frpn19v9mpi4aajn8csl194il"))))
(build-system python-build-system)
(arguments
- '(#:tests? #f)) ; No test suite.
+ '(#:phases
+ (modify-phases %standard-phases
+ (add-before 'build 'set-environment
+ (lambda _
+ (substitute* "setup.py"
+ (("cc") (which "gcc")))
+ #t)))
+ #:tests? #f)) ; No test suite.
(inputs
`(("gpgme" ,gpgme)))
(native-inputs
diff --git a/gnu/packages/kde-frameworks.scm b/gnu/packages/kde-frameworks.scm
index f5a084a7e8..988bf44c3d 100644
--- a/gnu/packages/kde-frameworks.scm
+++ b/gnu/packages/kde-frameworks.scm
@@ -207,33 +207,6 @@ Phonon-GStreamer is a backend based on the GStreamer multimedia library.")
;; license: source files mention "either version 2.1 or 3"
(license (list license:lgpl2.1 license:lgpl3))))
-(define-public gpgmepp
- (package
- (name "gpgmepp")
- (version "16.08.2")
- (source (origin
- (method url-fetch)
- (uri (string-append
- "mirror://kde/stable/applications"
- "/" version "/src/"
- name "-" version ".tar.xz"))
- (sha256
- (base32
- "0828qlhdi1i26n2xgyb01c0q77m6jlppbxv6mprryxq0ma88940a"))))
- (build-system cmake-build-system)
- (native-inputs
- `(("extra-cmake-modules" ,extra-cmake-modules)))
- (propagated-inputs
- `(("boost" ,boost)
- ("gpgme" ,gpgme)))
- (inputs
- `(("qtbase" ,qtbase)))
- (home-page "https://community.kde.org/Frameworks")
- (synopsis "C++ bindings/wrapper for gpgme")
- (description "C++ bindings/wrapper for gpgme.")
- (license license:lgpl2.1+)
- (properties `((superseded . ,gpgme)))))
-
(define-public kpmcore
(package
(name "kpmcore")
@@ -2003,7 +1976,8 @@ gallons).")
;; This test fails on i686 and aarch64
(lambda _
(substitute* "autotests/unit/file/CMakeLists.txt"
- (("metadatamovertest") ""))
+ (("^\\s*ecm_add_test\\(.* TEST_NAME metadatamovertest .*" line)
+ (string-append "# " line)))
#t))
(replace 'check
(lambda _
diff --git a/gnu/packages/llvm.scm b/gnu/packages/llvm.scm
index ec79bcc95c..2a3754b931 100644
--- a/gnu/packages/llvm.scm
+++ b/gnu/packages/llvm.scm
@@ -97,10 +97,10 @@ of programming tools as well as libraries with equivalent functionality.")
;; TODO: Build Mesa with LLVM 7 in the next staging cycle.
;; TODO: Make LLVM 7 the default LLVM once Clang is also upgraded.
-(define-public llvm-7.0.0
+(define-public llvm-7.0.1
(package (inherit llvm)
(name "llvm")
- (version "7.0.0")
+ (version "7.0.1")
(source
(origin
(method url-fetch)
@@ -108,7 +108,7 @@ of programming tools as well as libraries with equivalent functionality.")
version "/llvm-" version ".src.tar.xz"))
(sha256
(base32
- "08p27wv1pr9ql2zc3f3qkkymci46q7myvh8r5ijippnbwr2gihcb"))))))
+ "16s196wqzdw4pmri15hadzqgdi926zln3an2viwyq0kini6zr3d3"))))))
(define* (clang-runtime-from-llvm llvm hash
#:optional (patches '()))
diff --git a/gnu/packages/ocaml.scm b/gnu/packages/ocaml.scm
index 3b1ddcb5b6..603db34dbd 100644
--- a/gnu/packages/ocaml.scm
+++ b/gnu/packages/ocaml.scm
@@ -10,6 +10,7 @@
;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Peter Kreye <kreyepr@gmail.com>
+;;; Copyright © 2018 Gabriel Hondet <gabrielhondet@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -4989,3 +4990,57 @@ provides BigN, BigZ, BigQ that used to be part of Coq standard library.")
simplifying the proofs of inequalities on expressions of real numbers for the
Coq proof assistant.")
(license license:cecill-c)))
+
+(define-public dedukti
+ (package
+ (name "dedukti")
+ (version "2.6.0")
+ (home-page "https://deducteam.github.io/")
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/deducteam/dedukti.git")
+ (commit (string-append "v" version))))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "0frl3diff033i4fmq304b8wbsdnc9mvlhmwd7a3zd699ng2lzbxb"))))
+ (inputs
+ `(("menhir" ,ocaml-menhir)))
+ (native-inputs
+ `(("ocamlbuild" ,ocamlbuild)))
+ (build-system ocaml-build-system)
+ (arguments
+ `(#:phases
+ (modify-phases %standard-phases
+ (delete 'configure)
+ (replace 'build
+ (lambda _
+ (invoke "make")
+ #t))
+ (replace 'check
+ (lambda _
+ (invoke "make" "tests")
+ #t))
+ (add-before 'install 'set-binpath
+ ;; Change binary path in the makefile
+ (lambda _
+ (let ((out (assoc-ref %outputs "out")))
+ (substitute* "GNUmakefile"
+ (("BINDIR = (.*)$")
+ (string-append "BINDIR = " out "/bin"))))
+ #t))
+ (replace 'install
+ (lambda _
+ (invoke "make" "install")
+ #t)))))
+ (synopsis "Proof-checker for the λΠ-calculus modulo theory, an extension of
+the λ-calculus")
+ (description "Dedukti is a proof-checker for the λΠ-calculus modulo
+theory. The λΠ-calculus is an extension of the simply typed λ-calculus with
+dependent types. The λΠ-calculus modulo theory is itself an extension of the
+λΠ-calculus where the context contains variable declaration as well as rewrite
+rules. This system is not designed to develop proofs, but to check proofs
+developed in other systems. In particular, it enjoys a minimalistic syntax.")
+ (license license:cecill-c)))
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 3598ac4e67..9bb71dc80f 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -105,8 +105,8 @@
;; Note: the 'update-guix-package.scm' script expects this definition to
;; start precisely like this.
(let ((version "0.16.0")
- (commit "bdf860c2e99077d431da0cc1db4fc14db2a35d31")
- (revision 6))
+ (commit "6f1e0bb79266f34b50b09200b9280a641b8aa7c8")
+ (revision 7))
(package
(name "guix")
@@ -122,7 +122,7 @@
(commit commit)))
(sha256
(base32
- "0876y2pjcrwb3ynxqlpkn3pxx2iil8hrzdadh23jd6jbhvm087q1"))
+ "0xk4ki5zsliwknxc9a3lvpjzpckz8nx4dz55xmw9sydq5z5mmy50"))
(file-name (string-append "guix-" version "-checkout"))))
(build-system gnu-build-system)
(arguments
diff --git a/gnu/packages/parallel.scm b/gnu/packages/parallel.scm
index df8ac180b3..25d3c0737c 100644
--- a/gnu/packages/parallel.scm
+++ b/gnu/packages/parallel.scm
@@ -48,7 +48,7 @@
(define-public parallel
(package
(name "parallel")
- (version "20181122")
+ (version "20181222")
(source
(origin
(method url-fetch)
@@ -56,7 +56,7 @@
version ".tar.bz2"))
(sha256
(base32
- "1mcqymf6vg8jhnjv71sswcz5xrwpq2h2ishi8m1hz8rwhc65h1ig"))))
+ "0sd39nzgff3rpyzfwkffb5yxbdm5r6amrkslbgpjlrcrymy9z305"))))
(build-system gnu-build-system)
(arguments
`(#:phases
diff --git a/gnu/packages/patches/file-CVE-2018-10360.patch b/gnu/packages/patches/file-CVE-2018-10360.patch
new file mode 100644
index 0000000000..9285611c04
--- /dev/null
+++ b/gnu/packages/patches/file-CVE-2018-10360.patch
@@ -0,0 +1,27 @@
+https://github.com/file/file/commit/a642587a9c9e2dd7feacdf513c3643ce26ad3c22.patch
+The leading part of the patch starting at line 27 was trimmed off.
+This patch should be OK to drop with file@5.35.
+
+From a642587a9c9e2dd7feacdf513c3643ce26ad3c22 Mon Sep 17 00:00:00 2001
+From: Christos Zoulas <christos@zoulas.com>
+Date: Sat, 9 Jun 2018 16:00:06 +0000
+Subject: [PATCH] Avoid reading past the end of buffer (Rui Reis)
+
+---
+ src/readelf.c | 5 +++--
+ 1 file changed, 3 insertions(+), 2 deletions(-)
+
+diff --git a/src/readelf.c b/src/readelf.c
+index 79c83f9f5..1f41b4611 100644
+--- a/src/readelf.c
++++ b/src/readelf.c
+@@ -842,7 +842,8 @@ do_core_note(struct magic_set *ms, unsigned char *nbuf, uint32_t type,
+
+ cname = (unsigned char *)
+ &nbuf[doff + prpsoffsets(i)];
+- for (cp = cname; *cp && isprint(*cp); cp++)
++ for (cp = cname; cp < nbuf + size && *cp
++ && isprint(*cp); cp++)
+ continue;
+ /*
+ * Linux apparently appends a space at the end
diff --git a/gnu/packages/photo.scm b/gnu/packages/photo.scm
index 7b40c2361c..07047f4cf3 100644
--- a/gnu/packages/photo.scm
+++ b/gnu/packages/photo.scm
@@ -353,7 +353,7 @@ photographic equipment.")
(define-public darktable
(package
(name "darktable")
- (version "2.4.4")
+ (version "2.6.0")
(source (origin
(method url-fetch)
(uri (string-append
@@ -362,7 +362,7 @@ photographic equipment.")
version "/darktable-" version ".tar.xz"))
(sha256
(base32
- "0kdhmiw4wxk2w9v2hms9yk8nl4ymdshnqyj0l07nivzzr6w20hwn"))))
+ "0y04cx0a0rwdclmn16f5y0z2vnm7yxly291gzjgdhcn59a77sga8"))))
(build-system cmake-build-system)
(arguments
`(#:tests? #f ; There are no tests.
diff --git a/gnu/packages/python-web.scm b/gnu/packages/python-web.scm
index a5b4b7578d..8412325377 100644
--- a/gnu/packages/python-web.scm
+++ b/gnu/packages/python-web.scm
@@ -509,27 +509,28 @@ is Python’s.")
(define-public python-openid
(package
(name "python-openid")
- (version "3.0.10")
+ (version "3.1.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "python3-openid" version))
(sha256
(base32
- "1x3nh3fycqfn43jp5j5pb4q4y2jxp4mdka4absaa3bc0078qd758"))))
+ "00l5hrjh19740w00b3fnsqldnla41wbr2rics09dl4kyd1fkd3b2"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
- (invoke "./admin/runtests")
- #t)))))
+ (invoke "coverage" "run" "-m"
+ "unittest" "openid.test.test_suite"))))))
(properties `((python2-variant . ,(delay python2-openid))))
(propagated-inputs
`(("python-defusedxml" ,python-defusedxml)))
(native-inputs
- `(("python-psycopg2" ,python-psycopg2)
+ `(("python-coverage" ,python-coverage)
+ ("python-psycopg2" ,python-psycopg2)
("python-django" ,python-django)))
(home-page "https://github.com/necaris/python3-openid")
(synopsis "OpenID support for servers and consumers")
diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm
index bb4c5ab760..9ef0654cb8 100644
--- a/gnu/packages/python.scm
+++ b/gnu/packages/python.scm
@@ -12637,14 +12637,14 @@ validating Swagger API specifications.")
(define-public python-apache-libcloud
(package
(name "python-apache-libcloud")
- (version "2.3.0")
+ (version "2.4.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "apache-libcloud" version))
(sha256
- (base32
- "15xg79ad4g2xrk081ylvj41k5hmg9hl1xvbmb5hd0fqn08wfwbhf"))))
+ (base32
+ "0daj3mkzw79v5zin2r1s2wkrz1hplfc16bwj4ss68i5qjq4l2p0j"))))
(build-system python-build-system)
(arguments
`(#:phases
diff --git a/gnu/packages/wine.scm b/gnu/packages/wine.scm
index 802b3dd38f..f56699f8c9 100644
--- a/gnu/packages/wine.scm
+++ b/gnu/packages/wine.scm
@@ -225,7 +225,7 @@ integrate Windows applications into your desktop.")
(define-public wine-staging-patchset-data
(package
(name "wine-staging-patchset-data")
- (version "3.21")
+ (version "4.0-rc3")
(source
(origin
(method git-fetch)
@@ -235,7 +235,7 @@ integrate Windows applications into your desktop.")
(file-name (git-file-name name version))
(sha256
(base32
- "1bxryvqw5rvhcx8vjl714jaj0rjsrh95kh3sn499rrljc3c8qsbl"))))
+ "1yx758mv605w2g7f9aj4xf09p8q5dvbf6b9h1kdvsyhm8bkrgx66"))))
(build-system trivial-build-system)
(native-inputs
`(("bash" ,bash)
@@ -276,12 +276,12 @@ integrate Windows applications into your desktop.")
(method url-fetch)
(uri (string-append
"https://dl.winehq.org/wine/source/"
- (version-major version) ".x"
+ (version-major version) ".0"
"/wine-" version ".tar.xz"))
(file-name (string-append name "-" version ".tar.xz"))
(sha256
(base32
- "1h70wb7kysbzv36i3fblyiihvalwhy6sj4s2a8nf21nz2mhc0k58"))))
+ "176cdnznbk3pikh87j5q4cjb7rky5dxikf1nr0mp8a9cycycxr7w"))))
(inputs `(("autoconf" ,autoconf) ; for autoreconf
("gtk+" ,gtk+)
("libva" ,libva)
diff --git a/gnu/packages/wm.scm b/gnu/packages/wm.scm
index 2e211e3892..a761bce235 100644
--- a/gnu/packages/wm.scm
+++ b/gnu/packages/wm.scm
@@ -76,6 +76,7 @@
#:use-module (gnu packages lua)
#:use-module (gnu packages linux)
#:use-module (gnu packages suckless)
+ #:use-module (gnu packages mpd)
#:use-module (guix download)
#:use-module (guix git-download))
@@ -1051,3 +1052,45 @@ its size
@item Display preview images in a tiled icon layout
@end itemize")
(license license:gpl2+)))
+
+(define-public polybar
+ (package
+ (name "polybar")
+ (version "3.3.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://github.com/jaagr/polybar/releases/"
+ "download/" version "/polybar.tar"))
+ (sha256
+ (base32 "0sjh3xmf11g09spi88zj7xsc3a3vv78kixab6n5i7436py7xwzb4"))
+ (file-name (string-append name "-" version ".tar"))))
+ (build-system cmake-build-system)
+ (arguments
+ ;; Test is disabled because it requires downloading googletest from the
+ ;; Internet.
+ '(#:tests? #f))
+ (inputs
+ `(("alsa-lib" ,alsa-lib)
+ ("cairo" ,cairo)
+ ("i3-wm" ,i3-wm)
+ ("libmpdclient" ,libmpdclient)
+ ("libnl" ,libnl)
+ ("libxcb" ,libxcb)
+ ("pulseaudio" ,pulseaudio)
+ ("xcb-proto" ,xcb-proto)
+ ("xcb-util" ,xcb-util)
+ ("xcb-util-cursor" ,xcb-util-cursor)
+ ("xcb-util-image" ,xcb-util-image)
+ ("xcb-util-wm" ,xcb-util-wm)
+ ("xcb-util-xrm" ,xcb-util-xrm)))
+ (native-inputs
+ `(("pkg-config" ,pkg-config)
+ ("python-2" ,python-2) ; lib/xpp depends on python 2
+ ("python" ,python))) ; xcb-proto depends on python 3
+ (home-page "https://polybar.github.io/")
+ (synopsis "Fast and easy-to-use status bar")
+ (description "Polybar aims to help users build beautiful and highly
+customizable status bars for their desktop environment. It has built-in
+functionality to display information about the most commonly used services.")
+ (license license:expat)))
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 1108006411..92f86a1b83 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -22,6 +22,8 @@
(define-module (gnu services messaging)
#:use-module (gnu packages messaging)
#:use-module (gnu packages admin)
+ #:use-module (gnu packages irc)
+ #:use-module (gnu packages tls)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu services configuration)
@@ -50,7 +52,10 @@
bitlbee-configuration
bitlbee-configuration?
bitlbee-service
- bitlbee-service-type))
+ bitlbee-service-type
+
+ quassel-configuration
+ quassel-service-type))
;;; Commentary:
;;;
@@ -895,3 +900,86 @@ configuration file."
(bitlbee bitlbee)
(interface interface) (port port)
(extra-settings extra-settings))))
+
+
+;;;
+;;; Quassel.
+;;;
+
+(define-record-type* <quassel-configuration>
+ quassel-configuration make-quassel-configuration
+ quassel-configuration?
+ (quassel quassel-configuration-quassel
+ (default quassel))
+ (interface quassel-configuration-interface
+ (default "::,0.0.0.0"))
+ (port quassel-configuration-port
+ (default 4242))
+ (loglevel quassel-configuration-loglevel
+ (default "Info")))
+
+(define quassel-shepherd-service
+ (match-lambda
+ (($ <quassel-configuration> quassel interface port loglevel)
+ (with-imported-modules (source-module-closure
+ '((gnu build shepherd)
+ (gnu system file-systems)))
+ (list (shepherd-service
+ (provision '(quassel))
+ (requirement '(user-processes networking))
+ (modules '((gnu build shepherd)
+ (gnu system file-systems)))
+ (start #~(make-forkexec-constructor/container
+ (list #$(file-append quassel "/bin/quasselcore")
+ "--configdir=/var/lib/quassel"
+ "--logfile=/var/log/quassel/core.log"
+ (string-append "--loglevel=" #$loglevel)
+ (string-append "--port=" (number->string #$port))
+ (string-append "--listen=" #$interface))
+ #:mappings (list (file-system-mapping
+ (source "/var/lib/quassel")
+ (target source)
+ (writable? #t))
+ (file-system-mapping
+ (source "/var/log/quassel")
+ (target source)
+ (writable? #t)))))
+ (stop #~(make-kill-destructor))))))))
+
+(define %quassel-account
+ (list (user-group (name "quassel") (system? #t))
+ (user-account
+ (name "quasselcore")
+ (group "quassel")
+ (system? #t)
+ (comment "Quassel daemon user")
+ (home-directory "/var/lib/quassel")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define %quassel-activation
+ #~(begin
+ (use-modules (guix build utils))
+ (mkdir-p "/var/lib/quassel")
+ (mkdir-p "/var/log/quassel")
+ (let ((cert "/var/lib/quassel/quasselCert.pem"))
+ (unless (file-exists? cert)
+ (invoke #$(file-append openssl "/bin/openssl")
+ "req" "-x509" "-nodes" "-batch" "-days" "680" "-newkey"
+ "rsa" "-keyout" cert "-out" cert)))))
+
+(define quassel-service-type
+ (service-type (name 'quassel)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ quassel-shepherd-service)
+ (service-extension profile-service-type
+ (compose list quassel-configuration-quassel))
+ (service-extension account-service-type
+ (const %quassel-account))
+ (service-extension activation-service-type
+ (const %quassel-activation))))
+ (default-value (quassel-configuration))
+ (description
+ "Run @url{https://quassel-irc.org/,quasselcore}, the backend
+for the distributed IRC client quassel, which allows you to connect from
+multiple machines simultaneously.")))
diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl
index 36e272722d..f149f67113 100644
--- a/gnu/system/examples/vm-image.tmpl
+++ b/gnu/system/examples/vm-image.tmpl
@@ -24,6 +24,8 @@ partprobe, and then 2) resizing the filesystem with resize2fs.\n"))
(timezone "Etc/UTC")
(locale "en_US.utf8")
+(firmware '())
+
;; Assuming /dev/sdX is the target hard disk, and "my-root" is
;; the label of the target root file system.
(bootloader (bootloader-configuration
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
index 36afb987af..176e3d08cb 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,7 +30,8 @@
#:use-module (guix store)
#:use-module (guix modules)
#:export (%test-prosody
- %test-bitlbee))
+ %test-bitlbee
+ %test-quassel))
(define (run-xmpp-test name xmpp-service pid-file create-account)
"Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE."
@@ -239,3 +241,53 @@
(name "bitlbee")
(description "Connect to a BitlBee IRC server.")
(value (run-bitlbee-test))))
+
+(define (run-quassel-test)
+ (define os
+ (marionette-operating-system
+ (simple-operating-system (service dhcp-client-service-type)
+ (service quassel-service-type))
+ #:imported-modules (source-module-closure
+ '((gnu services herd)))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings `((4242 . 4242)))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (srfi srfi-64)
+ (gnu build marionette))
+
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "quassel")
+
+ (test-assert "service started"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'quassel))
+ marionette))
+
+ (test-assert "certificate file"
+ (marionette-eval
+ '(file-exists? "/var/lib/quassel/quasselCert.pem")
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "quassel-test" test))
+
+(define %test-quassel
+ (system-test
+ (name "quassel")
+ (description "Connect to a quassel IRC server.")
+ (value (run-quassel-test))))
diff --git a/guix/inferior.scm b/guix/inferior.scm
index ccc1c27cb2..973bd5264e 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -54,6 +54,7 @@
#:use-module ((rnrs bytevectors) #:select (string->utf8))
#:export (inferior?
open-inferior
+ port->inferior
close-inferior
inferior-eval
inferior-eval-with-store
@@ -93,10 +94,11 @@
;; Inferior Guix process.
(define-record-type <inferior>
- (inferior pid socket version packages table)
+ (inferior pid socket close version packages table)
inferior?
(pid inferior-pid)
(socket inferior-socket)
+ (close inferior-close-socket) ;procedure
(version inferior-version) ;REPL protocol version
(packages inferior-package-promise) ;promise of inferior packages
(table inferior-package-table)) ;promise of vhash
@@ -131,19 +133,17 @@ it's an old Guix."
((@ (guix scripts repl) machine-repl))))))
pipe)))
-(define* (open-inferior directory #:key (command "bin/guix"))
- "Open the inferior Guix in DIRECTORY, running 'DIRECTORY/COMMAND repl' or
-equivalent. Return #f if the inferior could not be launched."
- (define pipe
- (inferior-pipe directory command))
-
+(define* (port->inferior pipe #:optional (close close-port))
+ "Given PIPE, an input/output port, return an inferior that talks over PIPE.
+PIPE is closed with CLOSE when 'close-inferior' is called on the returned
+inferior."
(cond-expand
((and guile-2 (not guile-2.2)) #t)
(else (setvbuf pipe 'line)))
(match (read pipe)
(('repl-version 0 rest ...)
- (letrec ((result (inferior 'pipe pipe (cons 0 rest)
+ (letrec ((result (inferior 'pipe pipe close (cons 0 rest)
(delay (%inferior-packages result))
(delay (%inferior-package-table result)))))
(inferior-eval '(use-modules (guix)) result)
@@ -155,9 +155,18 @@ equivalent. Return #f if the inferior could not be launched."
(_
#f)))
+(define* (open-inferior directory #:key (command "bin/guix"))
+ "Open the inferior Guix in DIRECTORY, running 'DIRECTORY/COMMAND repl' or
+equivalent. Return #f if the inferior could not be launched."
+ (define pipe
+ (inferior-pipe directory command))
+
+ (port->inferior pipe close-pipe))
+
(define (close-inferior inferior)
"Close INFERIOR."
- (close-pipe (inferior-socket inferior)))
+ (let ((close (inferior-close-socket inferior)))
+ (close (inferior-socket inferior))))
;; Non-self-quoting object of the inferior.
(define-record-type <inferior-object>
@@ -409,6 +418,7 @@ thus be the code of a one-argument procedure that accepts a store."
;; Create a named socket in /tmp and let INFERIOR connect to it and use it
;; as its store. This ensures the inferior uses the same store, with the
;; same options, the same per-session GC roots, etc.
+ ;; FIXME: This strategy doesn't work for remote inferiors (SSH).
(call-with-temporary-directory
(lambda (directory)
(chmod directory #o700)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 2314f3b28c..354f6f7031 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -8,6 +8,7 @@
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -44,8 +45,10 @@
#:use-module (guix cve)
#:use-module (gnu packages)
#:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
#:use-module (ice-9 regex)
#:use-module (ice-9 format)
+ #:use-module (web client)
#:use-module (web uri)
#:use-module ((guix build download)
#:select (maybe-expand-mirrors
@@ -74,6 +77,7 @@
check-source
check-source-file-name
check-mirror-url
+ check-github-url
check-license
check-vulnerabilities
check-for-updates
@@ -773,6 +777,37 @@ descriptions maintained upstream."
(let ((uris (origin-uris origin)))
(for-each check-mirror-uri uris)))))
+(define (check-github-url package)
+ "Check whether PACKAGE uses source URLs that redirect to GitHub."
+ (define (follow-redirect uri)
+ (receive (response body) (http-head uri)
+ (case (response-code response)
+ ((301 302)
+ (uri->string (assoc-ref (response-headers response) 'location)))
+ (else #f))))
+
+ (define (follow-redirects-to-github uri)
+ (cond
+ ((string-prefix? "https://github.com/" uri) uri)
+ ((string-prefix? "http" uri)
+ (and=> (follow-redirect uri) follow-redirects-to-github))
+ ;; Do not attempt to follow redirects on URIs other than http and https
+ ;; (such as mirror, file)
+ (else #f)))
+
+ (let ((origin (package-source package)))
+ (when (and (origin? origin)
+ (eqv? (origin-method origin) url-fetch))
+ (for-each
+ (lambda (uri)
+ (and=> (follow-redirects-to-github uri)
+ (lambda (github-uri)
+ (emit-warning
+ package
+ (format #f (G_ "URL should be '~a'") github-uri)
+ 'source))))
+ (origin-uris origin)))))
+
(define (check-derivation package)
"Emit a warning if we fail to compile PACKAGE to a derivation."
(define (try system)
@@ -1056,6 +1091,10 @@ or a list thereof")
(description "Suggest 'mirror://' URLs")
(check check-mirror-url))
(lint-checker
+ (name 'github-uri)
+ (description "Suggest GitHub URIs")
+ (check check-github-url))
+ (lint-checker
(name 'source-file-name)
(description "Validate file names of sources")
(check check-source-file-name))
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index bfdaa3c011..dcdccc80e0 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -23,13 +23,12 @@
#:use-module (ssh session)
#:use-module (ssh channel)
#:use-module (ssh popen)
- #:use-module (ssh dist)
- #:use-module (ssh dist node)
#:use-module (ssh version)
#:use-module (guix config)
#:use-module (guix records)
#:use-module (guix ssh)
#:use-module (guix store)
+ #:use-module (guix inferior)
#:use-module (guix derivations)
#:use-module ((guix serialization)
#:select (nar-error? nar-error-file))
@@ -321,12 +320,15 @@ hook."
(set-port-revealed! port 1)
port))
+(define (node-guile-version node)
+ (inferior-eval '(version) node))
+
(define (node-free-disk-space node)
"Return the free disk space, in bytes, in NODE's store."
- (node-eval node
- `(begin
- (use-modules (guix build syscalls))
- (free-disk-space ,(%store-prefix)))))
+ (inferior-eval `(begin
+ (use-modules (guix build syscalls))
+ (free-disk-space ,(%store-prefix)))
+ node))
(define* (transfer-and-offload drv machine
#:key
@@ -367,8 +369,12 @@ MACHINE."
(derivation-file-name drv)
(build-machine-name machine)
(nix-protocol-error-message c))
- (let* ((space (false-if-exception
- (node-free-disk-space (make-node session)))))
+ (let* ((inferior (false-if-exception (remote-inferior session)))
+ (space (false-if-exception
+ (node-free-disk-space inferior))))
+
+ (when inferior
+ (close-inferior inferior))
;; Use exit code 100 for a permanent build failure. The daemon
;; interprets other non-zero codes as transient build failures.
@@ -417,11 +423,11 @@ of free disk space on '~a'~%")
(define (node-load node)
"Return the load on NODE. Return +∞ if NODE is misbehaving."
- (let ((line (node-eval node
- '(begin
- (use-modules (ice-9 rdelim))
- (call-with-input-file "/proc/loadavg"
- read-string)))))
+ (let ((line (inferior-eval '(begin
+ (use-modules (ice-9 rdelim))
+ (call-with-input-file "/proc/loadavg"
+ read-string))
+ node)))
(if (eof-object? line)
+inf.0 ;MACHINE does not respond, so assume it is infinitely loaded
(match (string-tokenize line)
@@ -508,9 +514,10 @@ slot (which must later be released with 'release-build-slot'), or #f and #f."
;; Note: We call 'node-load' only as a last resort because it is
;; too costly to call it once for every machine.
(let* ((session (false-if-exception (open-ssh-session best)))
- (node (and session (make-node session)))
+ (node (and session (remote-inferior session)))
(load (and node (normalized-load best (node-load node))))
(space (and node (node-free-disk-space node))))
+ (when node (close-inferior node))
(when session (disconnect! session))
(if (and node (< load 2.) (>= space %minimum-disk-space))
(match others
@@ -613,40 +620,34 @@ If TIMEOUT is #f, simply evaluate EXP..."
(#f
(report-guile-error name))
((? string? version)
- ;; Note: The version string already contains the word "Guile".
- (info (G_ "'~a' is running ~a~%")
+ (info (G_ "'~a' is running GNU Guile ~a~%")
name (node-guile-version node)))))
(define (assert-node-has-guix node name)
- "Bail out if NODE lacks the (guix) module, or if its daemon is not running."
- (catch 'node-repl-error
- (lambda ()
- (match (node-eval node
- '(begin
+ "Bail out if NODE if #f or if we fail to use the (guix) module, or if its
+daemon is not running."
+ (unless (inferior? node)
+ (leave (G_ "failed to run 'guix repl' on '~a'~%") name))
+
+ (match (inferior-eval '(begin
(use-modules (guix))
- (and add-text-to-store 'alright)))
- ('alright #t)
- (_ (report-module-error name))))
- (lambda (key . args)
- (report-module-error name)))
+ (and add-text-to-store 'alright))
+ node)
+ ('alright #t)
+ (_ (report-module-error name)))
- (catch 'node-repl-error
- (lambda ()
- (match (node-eval node
- '(begin
+ (match (inferior-eval '(begin
(use-modules (guix))
(with-store store
(add-text-to-store store "test"
- "Hello, build machine!"))))
- ((? string? str)
- (info (G_ "Guix is usable on '~a' (test returned ~s)~%")
- name str))
- (x
- (leave (G_ "failed to talk to guix-daemon on '~a' (test returned ~s)~%")
- name x))))
- (lambda (key . args)
- (leave (G_ "remote evaluation on '~a' failed:~{ ~s~}~%")
- name args))))
+ "Hello, build machine!")))
+ node)
+ ((? string? str)
+ (info (G_ "Guix is usable on '~a' (test returned ~s)~%")
+ name str))
+ (x
+ (leave (G_ "failed to talk to guix-daemon on '~a' (test returned ~s)~%")
+ name x))))
(define %random-state
(delay
@@ -656,25 +657,23 @@ If TIMEOUT is #f, simply evaluate EXP..."
(string-append name "-"
(number->string (random 1000000 (force %random-state)))))
-(define (assert-node-can-import node name daemon-socket)
+(define (assert-node-can-import session node name daemon-socket)
"Bail out if NODE refuses to import our archives."
- (let ((session (node-session node)))
- (with-store store
- (let* ((item (add-text-to-store store "export-test" (nonce)))
- (remote (connect-to-remote-daemon session daemon-socket)))
- (with-store local
- (send-files local (list item) remote))
-
- (if (valid-path? remote item)
- (info (G_ "'~a' successfully imported '~a'~%")
- name item)
- (leave (G_ "'~a' was not properly imported on '~a'~%")
- item name))))))
-
-(define (assert-node-can-export node name daemon-socket)
+ (with-store store
+ (let* ((item (add-text-to-store store "export-test" (nonce)))
+ (remote (connect-to-remote-daemon session daemon-socket)))
+ (with-store local
+ (send-files local (list item) remote))
+
+ (if (valid-path? remote item)
+ (info (G_ "'~a' successfully imported '~a'~%")
+ name item)
+ (leave (G_ "'~a' was not properly imported on '~a'~%")
+ item name)))))
+
+(define (assert-node-can-export session node name daemon-socket)
"Bail out if we cannot import signed archives from NODE."
- (let* ((session (node-session node))
- (remote (connect-to-remote-daemon session daemon-socket))
+ (let* ((remote (connect-to-remote-daemon session daemon-socket))
(item (add-text-to-store remote "import-test" (nonce name))))
(with-store store
(if (and (retrieve-files store (list item) remote)
@@ -701,11 +700,13 @@ machine."
(let* ((names (map build-machine-name machines))
(sockets (map build-machine-daemon-socket machines))
(sessions (map open-ssh-session machines))
- (nodes (map make-node sessions)))
- (for-each assert-node-repl nodes names)
+ (nodes (map remote-inferior sessions)))
(for-each assert-node-has-guix nodes names)
- (for-each assert-node-can-import nodes names sockets)
- (for-each assert-node-can-export nodes names sockets))))
+ (for-each assert-node-repl nodes names)
+ (for-each assert-node-can-import sessions nodes names sockets)
+ (for-each assert-node-can-export sessions nodes names sockets)
+ (for-each close-inferior nodes)
+ (for-each disconnect! sessions))))
(define (check-machine-status machine-file pred)
"Print the load of each machine matching PRED in MACHINE-FILE."
@@ -721,20 +722,28 @@ machine."
(info (G_ "getting status of ~a build machines defined in '~a'...~%")
(length machines) machine-file)
(for-each (lambda (machine)
- (let* ((session (open-ssh-session machine))
- (node (make-node session))
- (uts (node-eval node '(uname)))
- (load (node-load node))
- (free (node-free-disk-space node)))
- (disconnect! session)
- (format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\
+ (define session
+ (open-ssh-session machine))
+
+ (match (remote-inferior session)
+ (#f
+ (warning (G_ "failed to run 'guix repl' on machine '~a'~%")
+ (build-machine-name machine)))
+ ((? inferior? inferior)
+ (let ((uts (inferior-eval '(uname) inferior))
+ (load (node-load inferior))
+ (free (node-free-disk-space inferior)))
+ (close-inferior inferior)
+ (format #t "~a~% kernel: ~a ~a~% architecture: ~a~%\
host name: ~a~% normalized load: ~a~% free disk space: ~,2f MiB~%"
- (build-machine-name machine)
- (utsname:sysname uts) (utsname:release uts)
- (utsname:machine uts)
- (utsname:nodename uts)
- (normalized-load machine load)
- (/ free (expt 2 20) 1.))))
+ (build-machine-name machine)
+ (utsname:sysname uts) (utsname:release uts)
+ (utsname:machine uts)
+ (utsname:nodename uts)
+ (normalized-load machine load)
+ (/ free (expt 2 20) 1.)))))
+
+ (disconnect! session))
machines)))
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 1d86f949c8..003c915da3 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -40,6 +41,7 @@
#:use-module (ice-9 regex)
#:use-module (ice-9 vlist)
#:use-module (ice-9 format)
+ #:use-module (ice-9 threads) ; par-for-each
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
@@ -88,6 +90,12 @@
(option '(#\l "list-dependent") #f #f
(lambda (opt name arg result)
(alist-cons 'list-dependent? #t result)))
+ (option '(#\r "recursive") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'recursive? #t result)))
+ (option '("list-transitive") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'list-transitive? #t result)))
(option '("keyring") #t #f
(lambda (opt name arg result)
@@ -140,6 +148,10 @@ specified with `--select'.\n"))
(display (G_ "
-l, --list-dependent list top-level dependent packages that would need to
be rebuilt as a result of upgrading PACKAGE..."))
+ (display (G_ "
+ -r, --recursive check the PACKAGE and its inputs for upgrades"))
+ (display (G_ "
+ --list-transitive list all the packages that PACKAGE depends on"))
(newline)
(display (G_ "
--keyring=FILE use FILE as the keyring of upstream OpenPGP keys"))
@@ -323,6 +335,43 @@ dependent packages are rebuilt: ~{~a~^ ~}~%"
(map full-name covering))))
(return #t))))
+(define (refresh-recursive packages)
+ "Check all of the package inputs of PACKAGES for newer upstream versions."
+ (mlet %store-monad ((edges (node-edges %bag-node-type
+ ;; Here we don't want the -boot0 packages.
+ (fold-packages cons '()))))
+ (let ((dependent (node-transitive-edges packages edges)))
+ ;; par-for-each has an undefined return value, so packages which cause
+ ;; errors can be ignored.
+ (par-for-each (lambda (package)
+ (guix-refresh package))
+ (map package-name dependent)))
+ (return #t)))
+
+(define (list-transitive packages)
+ "List all the packages that would cause PACKAGES to be rebuilt if they are changed."
+ ;; Using %BAG-NODE-TYPE is more accurate than using %PACKAGE-NODE-TYPE
+ ;; because it includes implicit dependencies.
+ (define (full-name package)
+ (string-append (package-name package) "@"
+ (package-version package)))
+
+ (mlet %store-monad ((edges (node-edges %bag-node-type
+ ;; Here we don't want the -boot0 packages.
+ (fold-packages cons '()))))
+ (let ((dependent (node-transitive-edges packages edges)))
+ (match packages
+ ((x)
+ (format (current-output-port)
+ (G_ "~a depends on the following ~d packages: ~{~a~^ ~}~%.")
+ (full-name x) (length dependent) (map full-name dependent)))
+ (lst
+ (format (current-output-port)
+ (G_ "The following ~d packages \
+all are dependent packages: ~{~a~^ ~}~%")
+ (length dependent) (map full-name dependent))))
+ (return #t))))
+
;;;
;;; Manifest.
@@ -402,7 +451,9 @@ update would trigger a complete rebuild."
(let* ((opts (parse-options))
(update? (assoc-ref opts 'update?))
(updaters (options->updaters opts))
+ (recursive? (assoc-ref opts 'recursive?))
(list-dependent? (assoc-ref opts 'list-dependent?))
+ (list-transitive? (assoc-ref opts 'list-transitive?))
(key-download (assoc-ref opts 'key-download))
;; Warn about missing updaters when a package is explicitly given on
@@ -441,6 +492,10 @@ update would trigger a complete rebuild."
(cond
(list-dependent?
(list-dependents packages))
+ (list-transitive?
+ (list-transitive packages))
+ (recursive?
+ (refresh-recursive packages))
(update?
(parameterize ((%openpgp-key-server
(or (assoc-ref opts 'key-server)
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 104f4f52d6..1ed8406633 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -18,6 +18,7 @@
(define-module (guix ssh)
#:use-module (guix store)
+ #:use-module (guix inferior)
#:use-module (guix i18n)
#:use-module ((guix utils) #:select (&fix-hint))
#:use-module (ssh session)
@@ -26,8 +27,6 @@
#:use-module (ssh channel)
#:use-module (ssh popen)
#:use-module (ssh session)
- #:use-module (ssh dist)
- #:use-module (ssh dist node)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
@@ -36,6 +35,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 binary-ports)
#:export (open-ssh-session
+ remote-inferior
remote-daemon-channel
connect-to-remote-daemon
send-files
@@ -94,6 +94,26 @@ Throw an error on failure."
(message (format #f (G_ "SSH connection to '~a' failed: ~a~%")
host (get-error session))))))))))
+(define (remote-inferior session)
+ "Return a remote inferior for the given SESSION."
+ (let ((pipe (open-remote-pipe* session OPEN_BOTH
+ "guix" "repl" "-t" "machine")))
+ (port->inferior pipe)))
+
+(define (inferior-remote-eval exp session)
+ "Evaluate EXP in a new inferior running in SESSION, and close the inferior
+right away."
+ (let ((inferior (remote-inferior session)))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (inferior-eval exp inferior))
+ (lambda ()
+ ;; Close INFERIOR right away to prevent finalization from happening in
+ ;; another thread at the wrong time (see
+ ;; <https://bugs.gnu.org/26976>.)
+ (close-inferior inferior)))))
+
(define* (remote-daemon-channel session
#:optional
(socket-name
@@ -269,15 +289,15 @@ Return the list of store items actually sent."
;; Compute the subset of FILES missing on SESSION and send them.
(let* ((files (if recursive? (requisites local files) files))
(session (channel-get-session (nix-server-socket remote)))
- (node (make-node session))
- (missing (node-eval node
- `(begin
- (use-modules (guix)
- (srfi srfi-1) (srfi srfi-26))
-
- (with-store store
- (remove (cut valid-path? store <>)
- ',files)))))
+ (missing (inferior-remote-eval
+ `(begin
+ (use-modules (guix)
+ (srfi srfi-1) (srfi srfi-26))
+
+ (with-store store
+ (remove (cut valid-path? store <>)
+ ',files)))
+ session))
(count (length missing))
(sizes (map (lambda (item)
(path-info-nar-size (query-path-info local item)))
diff --git a/tests/lint.scm b/tests/lint.scm
index 300153e24e..d4aa7c0e8e 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -669,6 +670,33 @@
(check-mirror-url (dummy-package "x" (source source)))))
"mirror://gnu/foo/foo.tar.gz"))
+(test-assert "github-url"
+ (string-null?
+ (with-warnings
+ (with-http-server 200 %long-string
+ (check-github-url
+ (dummy-package "x" (source
+ (origin
+ (method url-fetch)
+ (uri (%local-url))
+ (sha256 %null-sha256)))))))))
+
+(let ((github-url "https://github.com/foo/bar/bar-1.0.tar.gz"))
+ (test-assert "github-url: one suggestion"
+ (string-contains
+ (with-warnings
+ (with-http-server (301 `((location . ,(string->uri github-url)))) ""
+ (let ((initial-uri (%local-url)))
+ (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+ (with-http-server (302 `((location . ,(string->uri initial-uri)))) ""
+ (check-github-url
+ (dummy-package "x" (source
+ (origin
+ (method url-fetch)
+ (uri (%local-url))
+ (sha256 %null-sha256))))))))))
+ github-url)))
+
(test-assert "cve"
(mock ((guix scripts lint) package-vulnerabilities (const '()))
(string-null?