Merge branch 'master' into staging
This commit is contained in:
Marius Bakke
commit
2bfcdbce51
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
("aubio" ,aubio)
|
||||
("lrdf" ,lrdf)
|
||||
("boost" ,boost)
|
||||
("atkmm" ,atkmm)
|
||||
("aubio" ,aubio)
|
||||
("boost" ,boost)
|
||||
("cairomm" ,cairomm)
|
||||
("eudev" ,eudev)
|
||||
("gtkmm" ,gtkmm-2)
|
||||
("glibmm" ,glibmm)
|
||||
("libart-lgpl" ,libart-lgpl)
|
||||
("libgnomecanvasmm" ,libgnomecanvasmm)
|
||||
("pangomm" ,pangomm)
|
||||
("liblo" ,liblo)
|
||||
("libsndfile" ,libsndfile)
|
||||
("libsamplerate" ,libsamplerate)
|
||||
("libxml2" ,libxml2)
|
||||
("libogg" ,libogg)
|
||||
("libvorbis" ,libvorbis)
|
||||
("flac" ,flac)
|
||||
("lv2" ,lv2)
|
||||
("vamp" ,vamp)
|
||||
("curl" ,curl)
|
||||
("eudev" ,eudev)
|
||||
("fftw" ,fftw)
|
||||
("fftwf" ,fftwf)
|
||||
("flac" ,flac)
|
||||
("glibmm" ,glibmm)
|
||||
("gtkmm" ,gtkmm-2)
|
||||
("jack" ,jack-1)
|
||||
("libarchive" ,libarchive)
|
||||
("libart-lgpl" ,libart-lgpl)
|
||||
("libgnomecanvasmm" ,libgnomecanvasmm)
|
||||
("liblo" ,liblo)
|
||||
("libogg" ,libogg)
|
||||
("libsamplerate" ,libsamplerate)
|
||||
("libsndfile" ,libsndfile)
|
||||
("libusb" ,libusb)
|
||||
("libvorbis" ,libvorbis)
|
||||
("libxml2" ,libxml2)
|
||||
("lilv" ,lilv)
|
||||
("lrdf" ,lrdf)
|
||||
("lv2" ,lv2)
|
||||
("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")
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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"))))))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 _
|
||||
|
|
|
|||
|
|
@ -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 '()))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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.")))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
@ -1055,6 +1090,10 @@ or a list thereof")
|
|||
(name 'mirror-url)
|
||||
(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")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
(use-modules (guix))
|
||||
(and add-text-to-store 'alright)))
|
||||
('alright #t)
|
||||
(_ (report-module-error name))))
|
||||
(lambda (key . args)
|
||||
(report-module-error name)))
|
||||
"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))
|
||||
|
||||
(catch 'node-repl-error
|
||||
(lambda ()
|
||||
(match (node-eval node
|
||||
'(begin
|
||||
(match (inferior-eval '(begin
|
||||
(use-modules (guix))
|
||||
(and add-text-to-store 'alright))
|
||||
node)
|
||||
('alright #t)
|
||||
(_ (report-module-error name)))
|
||||
|
||||
(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))
|
||||
(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))))))
|
||||
(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)
|
||||
(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)))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
40
guix/ssh.scm
40
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))
|
||||
(missing (inferior-remote-eval
|
||||
`(begin
|
||||
(use-modules (guix)
|
||||
(srfi srfi-1) (srfi srfi-26))
|
||||
|
||||
(with-store store
|
||||
(remove (cut valid-path? store <>)
|
||||
',files)))))
|
||||
(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)))
|
||||
|
|
|
|||
|
|
@ -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?
|
||||
|
|
|
|||
Loading…
Reference in New Issue